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