33 character(MED_NAME_SIZE) :: mname =
""
35 character(MED_COMMENT_SIZE) :: mdesc =
""
44 character(MED_SNAME_SIZE),
dimension(:),
allocatable :: aname
45 character(MED_SNAME_SIZE),
dimension(:),
allocatable :: aunit
46 character(MED_SNAME_SIZE) :: dtunit =
""
48 real*8,
dimension(:),
allocatable :: coords
52 integer ,
dimension(:),
allocatable :: conity
55 integer coocha, geotra, matran
60 real*8 :: matrix(7) = 0.0
67 character(MED_NAME_SIZE) :: profna =
""
74 integer,
dimension(MED_N_CELL_FIXED_GEO) :: geotps
76 geotps = med_get_cell_geometry_type
79 call mfiope(fid,
"UsesCase_MEDmesh_9.med", med_acc_rdonly, cret)
80 if (cret .ne. 0 )
then
81 print *,
"ERROR : open file"
86 call mmhnmh(fid, nmesh, cret)
87 if (cret .ne. 0 )
then
88 print *,
"ERROR : read how many mesh"
92 print *,
"nmesh :", nmesh
97 call mmhnax(fid, i, sdim, cret)
98 if (cret .ne. 0 )
then
99 print *,
"ERROR : read computation space dimension"
104 allocate ( aname(sdim), aunit(sdim) ,stat=cret )
106 print *,
"ERROR : memory allocation"
111 call mmhmii(fid, i, mname, sdim, mdim, mtype, mdesc, dtunit, stype, nstep, &
112 atype, aname, aunit, cret)
113 if (cret .ne. 0 )
then
114 print *,
"ERROR : read mesh informations"
117 print *,
"mesh name =", mname
118 print *,
"space dim =", sdim
119 print *,
"mesh dim =", mdim
120 print *,
"mesh type =", mtype
121 print *,
"mesh description =", mdesc
122 print *,
"dt unit = ", dtunit
123 print *,
"sorting type =", stype
124 print *,
"number of computing step =", nstep
125 print *,
"coordinates axis type =", atype
126 print *,
"coordinates axis name =", aname
127 print *,
"coordinates axis units =", aunit
128 deallocate(aname, aunit)
131 call mmhnme(fid, mname, med_no_dt, med_no_it, med_node, med_no_geotype, &
132 med_coordinate, med_no_cmode, coocha, geotra, nnodes, cret)
133 if (cret .ne. 0 )
then
134 print *,
"ERROR : read how many nodes in the mesh"
137 print *,
"number of nodes in the mesh =", nnodes
140 allocate (coords(nnodes*sdim),stat=cret)
142 print *,
"ERROR : memory allocation"
146 call mmhcor(fid, mname, med_no_dt, med_no_it, med_full_interlace, coords, cret)
147 if (cret .ne. 0 )
then
148 print *,
"ERROR : nodes coordinates"
151 print *,
"Nodes coordinates =", coords
155 do it=1, med_n_cell_fixed_geo
159 print *,
"geotps(it) :", geotps(it)
161 call mmhnme(fid, mname, med_no_dt, med_no_it, med_cell, geotyp, &
162 med_connectivity, med_nodal, coocha, &
164 if (cret .ne. 0 )
then
165 print *,
"ERROR : number of cells"
168 print *,
"Number of cells =", ngeo
172 if (ngeo .ne. 0)
then
173 allocate (conity(ngeo*mod(geotyp,100)), stat=cret)
175 print *,
"ERROR : memory allocation"
179 call mmhcyr(fid, mname, med_no_dt, med_no_it, med_cell, &
180 geotyp, med_nodal, med_full_interlace, &
183 print *,
"ERROR : cellconnectivity", conity
194 call mmhcsi(fid, mname, it+1, numdt, numit, dt, cret)
195 if (cret .ne. 0 )
then
196 print *,
"ERROR : computing step info"
199 print *,
"numdt =", numdt
200 print *,
"numit =", numit
204 call mmhnep(fid, mname, numdt, numit, med_node, med_no_geotype, &
205 med_coordinate, med_no_cmode, med_global_stmode, &
206 profna, profsz, coocha, geotra, nnodes, cret)
207 if (cret .ne. 0 )
then
208 print *,
"ERROR : nodes coordinates"
211 print *,
"profna =", profna
212 print *,
"coocha =", coocha
213 print *,
"geotra =", geotra
217 if (coocha == 1 .and. geotra == 1)
then
219 allocate (coords(nnodes*2),stat=cret)
221 print *,
"ERROR : memory allocation"
225 call mmhcpr(fid, mname, numdt, numit,med_global_stmode,profna, &
226 med_full_interlace,med_all_constituent, coords, cret)
227 if (cret .ne. 0 )
then
228 print *,
"ERROR : nodes coordinates"
231 print *,
"Nodes coordinates =", coords
236 if (coocha == 1 .and. .not. geotra == 1)
then
238 call mmhnme(fid,mname,numdt,numit, &
239 med_node,med_none,med_coordinate_trsf,med_nodal,coocha, &
240 matran, matsiz, cret)
241 if (cret .ne. 0 )
then
242 print *,
"ERROR : transformation matrix"
245 print *,
"Transformation matrix flag =", matran
246 print *,
"Matrix size = ", matsiz
248 if (matran == 1)
then
249 call mmhtfr(fid, mname, numdt, numit, matrix, cret)
250 if (cret .ne. 0 )
then
251 print *,
"ERROR : transformation matrix"
254 print *,
"Transformation matrix =", matrix
263 if (cret .ne. 0 )
then
264 print *,
"ERROR : close file"
subroutine mmhnmh(fid, n, cret)
Cette routine permet de lire le nombre de maillages dans un fichier.
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 séquence de calcul et un p...
subroutine mficlo(fid, cret)
Fermeture d'un fichier MED.
subroutine mmhcsi(fid, name, csit, numdt, numit, dt, cret)
Cette routine permet de lire les informations relatives à une séquence de calcul d'un maillage...
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 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 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 mmhtfr(fid, name, numdt, numit, tsf, cret)
Cette routine lit les paramètres de translation rotation à appliquer aux noeuds de la séquence de cal...
subroutine mmhcpr(fid, name, numdt, numit, stm, pname, swm, dim, 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 et un profil donnés.
program usescase_medmesh_12
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 mfiope(fid, name, access, cret)
Ouverture d'un fichier MED.
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...