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 mmhcor(fid, name, numdt, numit, swm, coo, cret)
program usescase_medmesh_11
subroutine mmhnme(fid, name, numdt, numit, entype, geotype, datype, cmode, chgt, tsf, n, cret)
subroutine mmhcyr(fid, name, numdt, numit, entype, geotype, cmode, swm, con, cret)
subroutine mfanfg(fid, maa, it, n, cret)
subroutine mmhfnr(fid, name, numdt, numit, entype, geotype, num, cret)
subroutine mfiope(fid, name, access, cret)
subroutine mfafai(fid, maa, ind, fam, num, gro, cret)
subroutine mmhmin(fid, name, sdim, mdim, mtype, desc, dtunit, stype, nstep, atype, aname, aunit, cret)
subroutine mfanfa(fid, maa, n, cret)
subroutine mficlo(fid, cret)