34 character*16 axname(2), unname(2)
38 character*64 mname, fyname, finame
40 integer mtype, stype, atype
42 integer nfam, ngro, fnum
46 integer coocha, geotra
50 real*8,
dimension(:),
allocatable :: coords
51 integer nnodes, ntria3, nquad4
54 integer,
dimension(:),
allocatable :: tricon, quacon
58 integer,
dimension (:),
allocatable :: fanbrs
60 character*200 cmt1, mdesc
62 character*80,
dimension (:),
allocatable :: gname
64 parameter(mname =
"2D unstructured mesh")
65 parameter(finame =
"UsesCase_MEDmesh_10.med")
68 call mfiope(fid, finame, med_acc_rdonly, cret)
69 if (cret .ne. 0 )
then 70 print *,
'ERROR : open file' 78 call mmhmin(fid, mname, sdim, mdim, mtype, mdesc, dtunit, stype, nstep, atype, axname, unname, cret)
79 if (cret .ne. 0 )
then 80 print *,
'Read mesh informations' 83 print *,
"mesh name =", mname
84 print *,
"space dim =", sdim
85 print *,
"mesh dim =", mdim
86 print *,
"mesh type =", mtype
87 print *,
"mesh description =", mdesc
88 print *,
"dt unit = ", dtunit
89 print *,
"sorting type =", stype
90 print *,
"number of computing step =", nstep
91 print *,
"coordinates axis type =", atype
92 print *,
"coordinates axis name =", axname
93 print *,
"coordinates axis units =", unname
96 call mmhnme(fid,mname,med_no_dt,med_no_it,med_node,med_no_geotype,med_coordinate,med_no_cmode,coocha,geotra,nnodes,cret)
97 if (cret .ne. 0 )
then 98 print *,
'Read number of nodes ...' 101 print *,
"Number of nodes =", nnodes
107 call mmhnme(fid,mname,med_no_dt,med_no_it,med_cell,med_tria3,med_connectivity,med_nodal,coocha,geotra,ntria3,cret)
108 if (cret .ne. 0 )
then 109 print *,
'Read number of MED_TRIA3 ...' 112 print *,
"Number of MED_TRIA3 =", ntria3
115 call mmhnme(fid,mname,med_no_dt,med_no_it,med_cell,med_quad4,med_connectivity,med_nodal,coocha,geotra,nquad4,cret)
116 if (cret .ne. 0 )
then 117 print *,
'Read number of MED_QUAD4 ...' 120 print *,
"Number of MED_QUAD4 =", nquad4
123 allocate ( coords(nnodes*sdim),stat=cret )
124 if (cret .ne. 0)
then 125 print *,
'Memory allocation' 129 call mmhcor(fid,mname,med_no_dt,med_no_it,med_full_interlace,coords,cret)
131 if (cret .ne. 0 )
then 132 print *,
'Read nodes coordinates' 135 print *,
"Nodes coordinates =", coords
139 allocate ( tricon(ntria3*3),stat=cret )
140 if (cret .ne. 0)
then 141 print *,
'Memory allocation' 145 call mmhcyr(fid,mname,med_no_dt,med_no_it,med_cell,med_tria3,med_nodal,med_full_interlace,tricon,cret)
146 if (cret .ne. 0 )
then 147 print *,
'Read MED_TRIA3 connectivity' 150 print *,
"MED_TRIA3 connectivity =", tricon
154 allocate ( quacon(nquad4*4),stat=cret )
155 if (cret .ne. 0)
then 156 print *,
'Memory allocation' 160 call mmhcyr(fid,mname,med_no_dt,med_no_it,med_cell,med_quad4,med_nodal,med_full_interlace,quacon,cret)
161 if (cret .ne. 0 )
then 162 print *,
'Read MED_QUAD4 connectivity' 165 print *,
"MED_QUAD4 connectivity =", quacon
169 call mfanfa(fid,mname,nfam,cret)
170 if (cret .ne. 0 )
then 171 print *,
'Read number of family' 174 print *,
"Number of family =", nfam
178 call mfanfg(fid,mname,n,ngro,cret)
179 if (cret .ne. 0 )
then 180 print *,
'Read number of group in a family' 183 print *,
"Number of group in family =", ngro
185 if (ngro .gt. 0)
then 186 allocate ( gname((ngro)),stat=cret )
187 if (cret .ne. 0)
then 188 print *,
'Memory allocation' 191 call mfafai(fid,mname,n,fyname,fnum,gname,cret)
192 if (cret .ne. 0)
then 193 print *,
'Read group names' 196 print *,
"Group name =", gname
205 call mmhnme(fid,mname,med_no_dt,med_no_it,med_node,med_none,med_family_number,med_no_cmode,coocha,geotra,nfanbrs,cret)
206 if (cret .ne. 0)
then 207 print *,
'Check family numbers nodes' 210 allocate ( fanbrs(nnodes),stat=cret )
211 if (cret .ne. 0)
then 212 print *,
'Memory allocation' 215 if (nfanbrs .ne. 0)
then 216 call mmhfnr(fid,mname,med_no_dt,med_no_it,med_node, med_none,fanbrs,cret)
217 if (cret .ne. 0)
then 218 print *,
'Read family numbers nodes' 226 print *,
'Family numbers for nodes :', fanbrs
230 call mmhnme(fid,mname,med_no_dt,med_no_it,med_cell,med_tria3,med_family_number,med_nodal,coocha,geotra,nfanbrs,cret)
231 if (cret .ne. 0)
then 232 print *,
'Check family numbers tria3' 235 allocate ( fanbrs(ntria3),stat=cret )
236 if (cret .ne. 0)
then 237 print *,
'Memory allocation' 241 if (nfanbrs .ne. 0)
then 242 call mmhfnr(fid,mname,med_no_dt,med_no_it,med_cell,med_tria3,fanbrs,cret)
243 if (cret .ne. 0)
then 244 print *,
'Read family numbers tria3' 252 print *,
'Family numbers for tria cells :', fanbrs
255 call mmhnme(fid,mname,med_no_dt,med_no_it,med_cell,med_quad4,med_family_number,med_nodal,coocha,geotra,nfanbrs,cret)
256 if (cret .ne. 0)
then 257 print *,
'Check family numbers quad4' 260 allocate ( fanbrs(nquad4),stat=cret )
261 if (cret .ne. 0)
then 262 print *,
'Memory allocation' 265 if (nfanbrs .ne. 0)
then 266 call mmhfnr(fid,mname,med_no_dt,med_no_it,med_cell,med_quad4,fanbrs,cret)
267 if (cret .ne. 0)
then 268 print *,
'Read family numbers quad4' 276 print *,
'Family numbers for quad cells :', fanbrs
281 if (cret .ne. 0 )
then 282 print *,
'ERROR : close file' subroutine mmhmin(fid, name, sdim, mdim, mtype, desc, dtunit, stype, nstep, atype, aname, aunit, cret)
subroutine mmhcyr(fid, name, numdt, numit, entype, geotype, cmode, swm, con, cret)
subroutine mfiope(fid, name, access, cret)
subroutine mmhcor(fid, name, numdt, numit, swm, coo, cret)
subroutine mfafai(fid, maa, ind, fam, num, gro, cret)
subroutine mfanfg(fid, maa, it, n, cret)
subroutine mmhnme(fid, name, numdt, numit, entype, geotype, datype, cmode, chgt, tsf, n, cret)
subroutine mmhfnr(fid, name, numdt, numit, entype, geotype, num, cret)
subroutine mfanfa(fid, maa, n, cret)
subroutine mficlo(fid, cret)
program usescase_medmesh_11