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'
program usescase_medmesh_11
subroutine mmhmin(fid, name, sdim, mdim, mtype, desc, dtunit, stype, nstep, atype, aname, aunit, cret)
Cette routine permet de lire les informations relatives à un maillage en précisant son nom...
subroutine mficlo(fid, cret)
Fermeture d'un fichier MED.
subroutine mmhcor(fid, name, numdt, numit, swm, coo, cret)
Cette routine permet de lire dans un maillage le tableau des coordonnées des noeuds, selon une séquence de calcul donnée.
subroutine mfanfa(fid, maa, n, cret)
Cette routine permet de lire le nombre de famille dans un maillage.
subroutine mmhnme(fid, name, numdt, numit, entype, geotype, datype, cmode, chgt, tsf, n, cret)
Cette routine permet de lire le nombre d'entités dans un maillage pour une séquence de calcul donnée...
subroutine mmhfnr(fid, name, numdt, numit, entype, geotype, num, cret)
Cette routine permet la lecture des numéros de famille d'un type d'entité d'un maillage.
subroutine mmhcyr(fid, name, numdt, numit, entype, geotype, cmode, swm, con, cret)
Cette routine permet de lire dans un maillage le tableau des connectivités pour un type géométrique d...
subroutine mfanfg(fid, maa, it, n, cret)
Cette routine permet de lire le nombre de groupe dans une famille.
subroutine mfafai(fid, maa, ind, fam, num, gro, cret)
Cette routine permet de lire les informations relatives à une famille d'un maillage.
subroutine mfiope(fid, name, access, cret)
Ouverture d'un fichier MED.