34 character(MED_NAME_SIZE) :: mname =
""
36 character(MED_COMMENT_SIZE) :: mdesc =
""
45 character(MED_SNAME_SIZE),
dimension(:),
allocatable :: aname
46 character(MED_SNAME_SIZE),
dimension(:),
allocatable :: aunit
47 character(MED_SNAME_SIZE) :: dtunit =
""
49 real*8,
dimension(:),
allocatable :: coords
53 integer ,
dimension(:),
allocatable :: conity
56 integer coocha, geotra, matran
61 real*8 :: matrix(7) = 0.0
68 character(MED_NAME_SIZE) :: profna =
""
75 integer,
dimension(MED_N_CELL_FIXED_GEO) :: geotps
77 geotps = med_get_cell_geometry_type
80 call mfiope(fid,
"UsesCase_MEDmesh_9.med", med_acc_rdonly, cret)
81 if (cret .ne. 0 )
then
82 print *,
"ERROR : open file"
87 call mmhnmh(fid, nmesh, cret)
88 if (cret .ne. 0 )
then
89 print *,
"ERROR : read how many mesh"
93 print *,
"nmesh :", nmesh
98 call mmhnax(fid, i, sdim, cret)
99 if (cret .ne. 0 )
then
100 print *,
"ERROR : read computation space dimension"
105 allocate ( aname(sdim), aunit(sdim) ,stat=cret )
107 print *,
"ERROR : memory allocation"
112 call mmhmii(fid, i, mname, sdim, mdim, mtype, mdesc, dtunit, stype, nstep, &
113 atype, aname, aunit, cret)
114 if (cret .ne. 0 )
then
115 print *,
"ERROR : read mesh informations"
118 print *,
"mesh name =", mname
119 print *,
"space dim =", sdim
120 print *,
"mesh dim =", mdim
121 print *,
"mesh type =", mtype
122 print *,
"mesh description =", mdesc
123 print *,
"dt unit = ", dtunit
124 print *,
"sorting type =", stype
125 print *,
"number of computing step =", nstep
126 print *,
"coordinates axis type =", atype
127 print *,
"coordinates axis name =", aname
128 print *,
"coordinates axis units =", aunit
129 deallocate(aname, aunit)
132 call mmhnme(fid, mname, med_no_dt, med_no_it, med_node, med_no_geotype, &
133 med_coordinate, med_no_cmode, coocha, geotra, nnodes, cret)
134 if (cret .ne. 0 )
then
135 print *,
"ERROR : read how many nodes in the mesh"
138 print *,
"number of nodes in the mesh =", nnodes
141 allocate (coords(nnodes*sdim),stat=cret)
143 print *,
"ERROR : memory allocation"
147 call mmhcor(fid, mname, med_no_dt, med_no_it, med_full_interlace, coords, cret)
148 if (cret .ne. 0 )
then
149 print *,
"ERROR : nodes coordinates"
152 print *,
"Nodes coordinates =", coords
156 do it=1, med_n_cell_fixed_geo
160 print *,
"geotps(it) :", geotps(it)
162 call mmhnme(fid, mname, med_no_dt, med_no_it, med_cell, geotyp, &
163 med_connectivity, med_nodal, coocha, &
165 if (cret .ne. 0 )
then
166 print *,
"ERROR : number of cells"
169 print *,
"Number of cells =", ngeo
173 if (ngeo .ne. 0)
then
174 allocate (conity(ngeo*mod(geotyp,100)), stat=cret)
176 print *,
"ERROR : memory allocation"
180 call mmhcyr(fid, mname, med_no_dt, med_no_it, med_cell, &
181 geotyp, med_nodal, med_full_interlace, &
184 print *,
"ERROR : cellconnectivity", conity
195 call mmhcsi(fid, mname, it+1, numdt, numit, dt, cret)
196 if (cret .ne. 0 )
then
197 print *,
"ERROR : computing step info"
200 print *,
"numdt =", numdt
201 print *,
"numit =", numit
205 call mmhnep(fid, mname, numdt, numit, med_node, med_no_geotype, &
206 med_coordinate, med_no_cmode, med_global_stmode, &
207 profna, profsz, coocha, geotra, nnodes, cret)
208 if (cret .ne. 0 )
then
209 print *,
"ERROR : nodes coordinates"
212 print *,
"profna =", profna
213 print *,
"coocha =", coocha
214 print *,
"geotra =", geotra
218 if (coocha == 1 .and. geotra == 1)
then
220 allocate (coords(nnodes*2),stat=cret)
222 print *,
"ERROR : memory allocation"
226 call mmhcpr(fid, mname, numdt, numit,med_global_stmode,profna, &
227 med_full_interlace,med_all_constituent, coords, cret)
228 if (cret .ne. 0 )
then
229 print *,
"ERROR : nodes coordinates"
232 print *,
"Nodes coordinates =", coords
237 if (coocha == 1 .and. .not. geotra == 1)
then
239 call mmhnme(fid,mname,numdt,numit, &
240 med_node,med_none,med_coordinate_trsf,med_nodal,coocha, &
241 matran, matsiz, cret)
242 if (cret .ne. 0 )
then
243 print *,
"ERROR : transformation matrix"
246 print *,
"Transformation matrix flag =", matran
247 print *,
"Matrix size = ", matsiz
249 if (matran == 1)
then
250 call mmhtfr(fid, mname, numdt, numit, matrix, cret)
251 if (cret .ne. 0 )
then
252 print *,
"ERROR : transformation matrix"
255 print *,
"Transformation matrix =", matrix
264 if (cret .ne. 0 )
then
265 print *,
"ERROR : close file"
program usescase_medmesh_12
subroutine mfiope(fid, name, access, cret)
Ouverture d'un fichier MED.
subroutine mficlo(fid, cret)
Fermeture d'un fichier MED.
subroutine mmhnmh(fid, n, cret)
Cette routine permet de lire le nombre de maillages dans un fichier.
subroutine mmhcsi(fid, name, csit, numdt, numit, dt, cret)
Cette routine permet de lire les informations relatives à une étape de calcul d'un maillage.
subroutine mmhnax(fid, it, naxis, cret)
Cette routine permet de lire dans un maillage le nombre d'axes du repère des coordonnées des noeuds.
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 étape de calcul donnée.
subroutine mmhnep(fid, name, numdt, numit, entype, geotype, datype, cmode, stmode, pname, psize, chgt, tsf, n, cret)
Cette routine permet de lire le nombre d'entités dans un maillage pour une étape de calcul et un prof...
subroutine mmhmii(fid, it, name, sdim, mdim, mtype, desc, dtunit, stype, nstep, atype, aname, aunit, cret)
Cette routine permet de lire les informations relatives à un maillage dans un fichier.
subroutine mmhcor(fid, name, numdt, numit, swm, coo, cret)
subroutine mmhtfr(fid, name, numdt, numit, tsf, cret)
subroutine mmhcyr(fid, name, numdt, numit, entype, geotype, cmode, swm, con, cret)
subroutine mmhcpr(fid, name, numdt, numit, stm, pname, swm, dim, coo, cret)