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
63 character(MED_NAME_SIZE) :: profna =
"" 70 integer,
dimension(MED_N_CELL_FIXED_GEO) :: geotps
75 geotps = med_get_cell_geometry_type
83 call mfiope(fid,
"UsesCase_MEDmesh_6.med", med_acc_rdonly, cret)
84 if (cret .ne. 0 )
then 85 print *,
"ERROR : open file" 90 call mmhnmh(fid, nmesh, cret)
91 if (cret .ne. 0 )
then 92 print *,
"ERROR : read how many mesh" 96 print *,
"nmesh :", nmesh
101 call mmhnax(fid, i, sdim, cret)
102 if (cret .ne. 0 )
then 103 print *,
"ERROR : read computation space dimension" 108 allocate ( aname(sdim), aunit(sdim) ,stat=cret )
110 print *,
"ERROR : memory allocation" 115 call mmhmii(fid, i, mname, sdim, mdim, mtype, mdesc, dtunit, stype, nstep, &
116 atype, aname, aunit, cret)
117 if (cret .ne. 0 )
then 118 print *,
"ERROR : read mesh informations" 121 print *,
"mesh name =", mname
122 print *,
"space dim =", sdim
123 print *,
"mesh dim =", mdim
124 print *,
"mesh type =", mtype
125 print *,
"mesh description =", mdesc
126 print *,
"dt unit = ", dtunit
127 print *,
"sorting type =", stype
128 print *,
"number of computing step =", nstep
129 print *,
"coordinates axis type =", atype
130 print *,
"coordinates axis name =", aname
131 print *,
"coordinates axis units =", aunit
132 deallocate(aname, aunit)
135 call mmhnme(fid, mname, med_no_dt, med_no_it, med_node, med_no_geotype, &
136 med_coordinate, med_no_cmode, coocha, geotra, nnodes, cret)
137 if (cret .ne. 0 )
then 138 print *,
"ERROR : read how many nodes in the mesh" 141 print *,
"number of nodes in the mesh =", nnodes
144 allocate (coords(nnodes*sdim),stat=cret)
146 print *,
"ERROR : memory allocation" 150 call mmhcor(fid, mname, med_no_dt, med_no_it, med_full_interlace, coords, cret)
151 if (cret .ne. 0 )
then 152 print *,
"ERROR : nodes coordinates" 155 print *,
"Nodes coordinates =", coords
159 do it=1, med_n_cell_fixed_geo
163 print *,
"geotps(it) :", geotps(it)
165 call mmhnme(fid, mname, med_no_dt, med_no_it, med_cell, geotyp, &
166 med_connectivity, med_nodal, coocha, &
168 if (cret .ne. 0 )
then 169 print *,
"ERROR : number of cells" 172 print *,
"Number of cells =", ngeo
176 if (ngeo .ne. 0)
then 177 allocate (conity(ngeo*mod(geotyp,100)), stat=cret)
179 print *,
"ERROR : memory allocation" 183 call mmhcyr(fid, mname, med_no_dt, med_no_it, med_cell, &
184 geotyp, med_nodal, med_full_interlace, &
187 print *,
"ERROR : cellconnectivity", conity
198 call mmhcsi(fid, mname, it+1, numdt, numit, dt, cret)
199 if (cret .ne. 0 )
then 200 print *,
"ERROR : computing step info" 203 print *,
"numdt =", numdt
204 print *,
"numit =", numit
208 call mmhnep(fid, mname, numdt, numit, med_node, med_no_geotype, &
209 med_coordinate, med_no_cmode, med_global_stmode, &
210 profna, profsz, coocha, geotra, nnodes, cret)
211 if (cret .ne. 0 )
then 212 print *,
"ERROR : nodes coordinates" 215 print *,
"profna =", profna
216 print *,
"coocha =", coocha
217 print *,
"geotra =", geotra
221 if (coocha == 1 .and. geotra == 1)
then 223 allocate (coords(nnodes*2),stat=cret)
225 print *,
"ERROR : memory allocation" 229 call mmhcpr(fid, mname, numdt, numit,med_global_stmode,profna, &
230 med_full_interlace,med_all_constituent, coords, cret)
231 if (cret .ne. 0 )
then 232 print *,
"ERROR : nodes coordinates" 235 print *,
"Nodes coordinates =", coords
246 if (cret .ne. 0 )
then 247 print *,
"ERROR : close file" subroutine mmhcpr(fid, name, numdt, numit, stm, pname, swm, dim, coo, cret)
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)
program usescase_medmesh_8
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)