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" subroutine mmhcpr(fid, name, numdt, numit, stm, pname, swm, dim, coo, cret)
program usescase_medmesh_12
subroutine mmhnmh(fid, n, cret)
subroutine mmhcyr(fid, name, numdt, numit, entype, geotype, cmode, swm, con, cret)
subroutine mfiope(fid, name, access, cret)
subroutine mmhnax(fid, it, naxis, cret)
subroutine mmhcor(fid, name, numdt, numit, swm, coo, cret)
subroutine mmhtfr(fid, name, numdt, numit, tsf, cret)
subroutine mmhcsi(fid, name, csit, numdt, numit, dt, cret)
subroutine mmhnep(fid, name, numdt, numit, entype, geotype, datype, cmode, stmode, pname, psize, chgt, tsf, n, cret)
subroutine mmhmii(fid, it, name, sdim, mdim, mtype, desc, dtunit, stype, nstep, atype, aname, aunit, cret)
subroutine mmhnme(fid, name, numdt, numit, entype, geotype, datype, cmode, chgt, tsf, n, cret)
subroutine mficlo(fid, cret)