33 character*16 axname(2), unname(2)
37 character*64 mname, fyname, finame
39 integer mtype, stype, atype
41 integer nfam, ngro, fnum
45 integer coocha, geotra
47 real*8,
dimension(:),
allocatable :: coords
48 integer nnodes, ntria3, nquad4
51 integer,
dimension(:),
allocatable :: tricon, quacon
55 integer,
dimension (:),
allocatable :: fanbrs
57 character*200 cmt1, mdesc
59 character*80,
dimension (:),
allocatable :: gname
61 parameter(mname =
"2D unstructured mesh")
62 parameter(finame =
"UsesCase_MEDmesh_10.med")
65 call mfiope(fid, finame, med_acc_rdonly, cret)
66 if (cret .ne. 0 )
then 67 print *,
'ERROR : open file' 75 call mmhmin(fid, mname, sdim, mdim, mtype, mdesc, dtunit, stype, nstep, atype, axname, unname, cret)
76 if (cret .ne. 0 )
then 77 print *,
'Read mesh informations' 80 print *,
"mesh name =", mname
81 print *,
"space dim =", sdim
82 print *,
"mesh dim =", mdim
83 print *,
"mesh type =", mtype
84 print *,
"mesh description =", mdesc
85 print *,
"dt unit = ", dtunit
86 print *,
"sorting type =", stype
87 print *,
"number of computing step =", nstep
88 print *,
"coordinates axis type =", atype
89 print *,
"coordinates axis name =", axname
90 print *,
"coordinates axis units =", unname
93 call mmhnme(fid,mname,med_no_dt,med_no_it,med_node,med_no_geotype,med_coordinate,med_no_cmode,coocha,geotra,nnodes,cret)
94 if (cret .ne. 0 )
then 95 print *,
'Read number of nodes ...' 98 print *,
"Number of nodes =", nnodes
104 call mmhnme(fid,mname,med_no_dt,med_no_it,med_cell,med_tria3,med_connectivity,med_nodal,coocha,geotra,ntria3,cret)
105 if (cret .ne. 0 )
then 106 print *,
'Read number of MED_TRIA3 ...' 109 print *,
"Number of MED_TRIA3 =", ntria3
112 call mmhnme(fid,mname,med_no_dt,med_no_it,med_cell,med_quad4,med_connectivity,med_nodal,coocha,geotra,nquad4,cret)
113 if (cret .ne. 0 )
then 114 print *,
'Read number of MED_QUAD4 ...' 117 print *,
"Number of MED_QUAD4 =", nquad4
120 allocate ( coords(nnodes*sdim),stat=cret )
121 if (cret .ne. 0)
then 122 print *,
'Memory allocation' 126 call mmhcor(fid,mname,med_no_dt,med_no_it,med_full_interlace,coords,cret)
128 if (cret .ne. 0 )
then 129 print *,
'Read nodes coordinates' 132 print *,
"Nodes coordinates =", coords
136 allocate ( tricon(ntria3*3),stat=cret )
137 if (cret .ne. 0)
then 138 print *,
'Memory allocation' 142 call mmhcyr(fid,mname,med_no_dt,med_no_it,med_cell,med_tria3,med_nodal,med_full_interlace,tricon,cret)
143 if (cret .ne. 0 )
then 144 print *,
'Read MED_TRIA3 connectivity' 147 print *,
"MED_TRIA3 connectivity =", tricon
151 allocate ( quacon(nquad4*4),stat=cret )
152 if (cret .ne. 0)
then 153 print *,
'Memory allocation' 157 call mmhcyr(fid,mname,med_no_dt,med_no_it,med_cell,med_quad4,med_nodal,med_full_interlace,quacon,cret)
158 if (cret .ne. 0 )
then 159 print *,
'Read MED_QUAD4 connectivity' 162 print *,
"MED_QUAD4 connectivity =", quacon
166 call mfanfa(fid,mname,nfam,cret)
167 if (cret .ne. 0 )
then 168 print *,
'Read number of family' 171 print *,
"Number of family =", nfam
175 call mfanfg(fid,mname,n,ngro,cret)
176 if (cret .ne. 0 )
then 177 print *,
'Read number of group in a family' 180 print *,
"Number of group in family =", ngro
182 if (ngro .gt. 0)
then 183 allocate ( gname((ngro)),stat=cret )
184 if (cret .ne. 0)
then 185 print *,
'Memory allocation' 188 call mfafai(fid,mname,n,fyname,fnum,gname,cret)
189 if (cret .ne. 0)
then 190 print *,
'Read group names' 193 print *,
"Group name =", gname
202 allocate ( fanbrs(nnodes),stat=cret )
203 if (cret .ne. 0)
then 204 print *,
'Memory allocation' 207 call mmhfnr(fid,mname,med_no_dt,med_no_it,med_node, med_none,fanbrs,cret)
208 if (cret .ne. 0)
then 213 print *,
'Family numbers for nodes :', fanbrs
217 allocate ( fanbrs(ntria3),stat=cret )
218 if (cret .ne. 0)
then 219 print *,
'Memory allocation' 226 call mmhfnr(fid,mname,med_no_dt,med_no_it,med_cell,med_tria3,fanbrs,cret)
227 if (cret .ne. 0)
then 232 print *,
'Family numbers for tria cells :', fanbrs
235 allocate ( fanbrs(nquad4),stat=cret )
236 if (cret .ne. 0)
then 237 print *,
'Memory allocation' 243 call mmhfnr(fid,mname,med_no_dt,med_no_it,med_cell,med_quad4,fanbrs,cret)
244 if (cret .ne. 0)
then 249 print *,
'Family numbers for quad cells :', fanbrs
254 if (cret .ne. 0 )
then 255 print *,
'ERROR : close file' subroutine mficlo(fid, cret)
subroutine mmhcor(fid, name, numdt, numit, swm, coo, cret)
subroutine mmhfnr(fid, name, numdt, numit, entype, geotype, num, cret)
subroutine mfafai(fid, maa, ind, fam, num, gro, cret)
subroutine mfanfg(fid, maa, it, n, cret)
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)
program usescase_medmesh_11
subroutine mfanfa(fid, maa, n, cret)
subroutine mmhnme(fid, name, numdt, numit, entype, geotype, datype, cmode, chgt, tsf, n, cret)
subroutine mfiope(fid, name, access, cret)