00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013
00014
00015
00016
00017
00018
00019
00020
00021
00022
00023
00024 program UsesCase_MEDmesh_10
00025
00026 implicit none
00027 include 'med.hf77'
00028
00029
00030 integer cret
00031 integer fid
00032
00033 integer sdim, mdim
00034
00035 character*16 axname(2), unname(2)
00036
00037 character*64 mname, fyname, dtunit, finame
00038
00039 integer mtype, stype, grtype
00040
00041 integer fnum, ngro
00042
00043 character*80 gname
00044
00045 real*8 coords(30), dt
00046 integer nnodes, ntria3, nquad4
00047
00048 integer tricon(24), quacon(16)
00049
00050 integer fanbrs(15)
00051
00052 character*200 cmt1, mdesc
00053
00054 parameter (sdim = 2, mdim = 2)
00055 parameter (mname = "2D unstructured mesh")
00056 parameter (fyname = "BOUNDARY_VERTICES")
00057 parameter (dtunit = " ")
00058 parameter (dt = 0.0d0)
00059 parameter (finame = "UsesCase_MEDmesh_10.med")
00060 parameter (gname = "MESH_BOUNDARY_VERTICES")
00061 parameter (nnodes = 15, ntria3 = 8, nquad4 = 4)
00062 parameter (cmt1 ="A 2D unstructured mesh : 15 nodes, 12 cells")
00063 parameter (mtype=MED_UNSTRUCTURED_MESH, stype=MED_SORT_DTIT )
00064 parameter (mdesc = "A 2D unstructured mesh")
00065 parameter (grtype=MED_CARTESIAN_GRID)
00066
00067 data axname /"x" ,"y" /
00068 data unname /"cm","cm"/
00069 data coords /2.,1., 7.,1., 12.,1., 17.,1., 22.,1.,
00070 & 2.,6., 7.,6., 12.,6., 17.,6., 22.,6.,
00071 & 2.,11., 7.,11., 12.,11., 17.,11., 22.,11./
00072 data tricon /1,7,6, 2,7,1, 3,7,2, 8,7,3,
00073 & 13,7,8, 12,7,13, 11,7,12, 6,7,11/
00074 data quacon /3,4,9,8, 4,5,10,9,
00075 & 15,14,9,10, 13,8,9,14/
00076 data fanbrs /1, 1, 1, 1, 1, 1, 0, 0, 0, 1, 1, 1, 1, 1, 1/
00077
00078
00079
00080 call mfiope(fid,finame,MED_ACC_CREAT,cret)
00081 if (cret .ne. 0 ) then
00082 print *,'ERROR : file creation'
00083 call efexit(-1)
00084 endif
00085
00086
00087
00088 call mficow(fid,cmt1,cret)
00089 if (cret .ne. 0 ) then
00090 print *,'ERROR : write file description'
00091 call efexit(-1)
00092 endif
00093
00094
00095
00096 call mmhcre(fid, mname, sdim, mdim, mtype, mdesc, dtunit,
00097 & stype, grtype, axname, unname, cret)
00098 if (cret .ne. 0 ) then
00099 print *,'ERROR : mesh creation'
00100 call efexit(-1)
00101 endif
00102
00103
00104
00105
00106 call mmhcow(fid,mname,MED_NO_DT,MED_NO_IT,dt,
00107 & MED_FULL_INTERLACE,nnodes,coords,cret)
00108 if (cret .ne. 0 ) then
00109 print *,'ERROR : write nodes coordinates description'
00110 call efexit(-1)
00111 endif
00112
00113
00114
00115 call mmhcyw(fid,mname,MED_NO_DT,MED_NO_IT,dt,MED_CELL,
00116 & MED_TRIA3,MED_NODAL,MED_FULL_INTERLACE,
00117 & ntria3,tricon,cret)
00118 if (cret .ne. 0 ) then
00119 print *,'ERROR : triangular cells connectivity'
00120 call efexit(-1)
00121 endif
00122 call mmhcyw(fid,mname,MED_NO_DT,MED_NO_IT,dt,MED_CELL,
00123 & MED_QUAD4,MED_NODAL,MED_FULL_INTERLACE,
00124 & nquad4,quacon,cret)
00125 if (cret .ne. 0 ) then
00126 print *,'ERROR : quadrangular cells connectivity'
00127 call efexit(-1)
00128 endif
00129
00130
00131
00132 call mfacre(fid,mname,MED_NO_NAME,0,0,MED_NO_GROUP,cret)
00133 if (cret .ne. 0 ) then
00134 print *,'ERROR : create family 0'
00135 call efexit(-1)
00136 endif
00137
00138
00139
00140
00141 fnum = 1
00142 ngro = 1
00143 call mfacre(fid, mname, fyname, fnum, ngro, gname, cret)
00144 if (cret .ne. 0 ) then
00145 print *,'ERROR : create family 0'
00146 call efexit(-1)
00147 endif
00148
00149
00150
00151 call mmhfnw(fid, mname, MED_NO_DT, MED_NO_IT, MED_NODE, MED_NONE,
00152 & nnodes, fanbrs, cret)
00153 if (cret .ne. 0 ) then
00154 print *,'ERROR : nodes family numbers ...'
00155 call efexit(-1)
00156 endif
00157
00158
00159
00160 call mficlo(fid,cret)
00161 if (cret .ne. 0 ) then
00162 print *,'ERROR : close file'
00163 call efexit(-1)
00164 endif
00165
00166
00167
00168 end
00169