30 character(MED_NAME_SIZE) :: mname =
"2D unstructured mesh" 32 character(MED_COMMENT_SIZE) :: mdesc
41 character(MED_SNAME_SIZE),
dimension(:),
allocatable :: aname
42 character(MED_SNAME_SIZE),
dimension(:),
allocatable :: aunit
43 character(MED_SNAME_SIZE) :: dtunit =
"" 45 real*8,
dimension(:),
allocatable :: coords
47 integer,
dimension(:),
allocatable :: tricon
49 integer,
dimension(:),
allocatable :: quacon
53 integer coocha, geotra
60 character(MED_NAME_SIZE) :: profna =
"" 66 call mfiope(fid,
"UsesCase_MEDmesh_6.med", med_acc_rdonly, cret)
67 if (cret .ne. 0 )
then 68 print *,
"ERROR : open file" 76 allocate ( aname(2), aunit(2) ,stat=cret )
78 print *,
"ERROR : memory allocation" 82 call mmhmin(fid, mname, sdim, mdim, mtype, mdesc, dtunit, stype, nstep, atype, aname, aunit, cret)
83 if (cret .ne. 0 )
then 84 print *,
"ERROR : read mesh informations" 87 print *,
"mesh name =", mname
88 print *,
"space dim =", sdim
89 print *,
"mesh dim =", mdim
90 print *,
"mesh type =", mtype
91 print *,
"mesh description =", mdesc
92 print *,
"dt unit = ", dtunit
93 print *,
"sorting type =", stype
94 print *,
"number of computing step =", nstep
95 print *,
"coordinates axis type =", atype
96 print *,
"coordinates axis name =", aname
97 print *,
"coordinates axis units =", aunit
98 deallocate(aname, aunit)
101 call mmhnme(fid, mname, med_no_dt, med_no_it, med_node, med_no_geotype, &
102 med_coordinate, med_no_cmode, coocha, geotra, nnodes, cret)
103 if (cret .ne. 0 )
then 104 print *,
"ERROR : read how many nodes in the mesh" 107 print *,
"number of nodes in the mesh =", nnodes
113 call mmhnme(fid, mname, med_no_dt, med_no_it, med_cell, med_tria3, med_connectivity, &
114 med_nodal, coocha, geotra, ntria3, cret)
115 if (cret .ne. 0 )
then 116 print *,
"ERROR : read how many nodes in the mesh" 119 print *,
"number of triangular cells in the mesh =", ntria3
122 call mmhnme(fid, mname, med_no_dt, med_no_it, med_cell, med_quad4, med_connectivity, &
123 med_nodal, coocha, geotra, nquad4, cret)
124 if (cret .ne. 0 )
then 125 print *,
"ERROR : read how many nodes in the mesh" 128 print *,
"number of quadrangular cells in the mesh =", nquad4
131 allocate (coords(nnodes*2),stat=cret)
133 print *,
"ERROR : memory allocation" 137 call mmhcor(fid, mname, med_no_dt, med_no_it, med_full_interlace, coords, cret)
138 if (cret .ne. 0 )
then 139 print *,
"ERROR : nodes coordinates" 142 print *,
"Nodes coordinates =", coords
146 allocate ( tricon(ntria3 * 3) ,stat=cret )
148 print *,
"ERROR : memory allocation" 152 call mmhcyr(fid, mname, med_no_dt, med_no_it, med_cell, med_tria3, &
153 med_nodal,med_full_interlace,tricon,cret)
154 if (cret .ne. 0 )
then 155 print *,
"ERROR : MED_TRIA3 connectivity" 158 print *,
"MED_TRIA3 connectivity =", tricon
161 allocate ( quacon(nquad4*4) ,stat=cret )
163 print *,
"ERROR : memory allocation" 167 call mmhcyr(fid, mname, med_no_dt, med_no_it, med_cell, med_quad4, &
168 med_nodal, med_full_interlace, quacon, cret)
169 if (cret .ne. 0 )
then 170 print *,
"ERROR : MED_QUAD4 connectivity" 173 print *,
"MED_QUAD4 connectivity =", quacon
181 call mmhcsi(fid, mname, it+1, numdt, numit, dt, cret)
182 if (cret .ne. 0 )
then 183 print *,
"ERROR : computing step info" 186 print *,
"numdt =", numdt
187 print *,
"numit =", numit
191 call mmhnep(fid, mname, numdt, numit, med_node, med_no_geotype, &
192 med_coordinate, med_no_cmode, med_global_stmode, &
193 profna, profsz, coocha, geotra, nnodes, cret)
194 if (cret .ne. 0 )
then 195 print *,
"ERROR : nodes coordinates" 198 print *,
"profna = ", profna
199 print *,
"coocha =", coocha
202 if (coocha == 1)
then 204 allocate (coords(nnodes*2),stat=cret)
206 print *,
"ERROR : memory allocation" 210 call mmhcpr(fid, mname, numdt, numit,med_global_stmode,profna, &
211 med_full_interlace,med_all_constituent, coords, cret)
212 if (cret .ne. 0 )
then 213 print *,
"ERROR : nodes coordinates" 216 print *,
"Nodes coordinates =", coords
225 if (cret .ne. 0 )
then 226 print *,
"ERROR : close file" subroutine mficlo(fid, cret)
subroutine mmhcor(fid, name, numdt, numit, swm, coo, cret)
subroutine mmhmin(fid, name, sdim, mdim, mtype, desc, dtunit, stype, nstep, atype, aname, aunit, cret)
subroutine mmhcyr(fid, name, numdt, numit, entype, geotype, cmode, swm, con, cret)
subroutine mmhcsi(fid, name, csit, numdt, numit, dt, 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)
subroutine mmhcpr(fid, name, numdt, numit, stm, pname, swm, dim, coo, cret)
program usescase_medmesh_7