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'