00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013
00014
00015
00016
00017
00018
00019
00020
00021
00022
00023 program UsesCase_MEDmesh_12
00024
00025 implicit none
00026 include 'med.hf90'
00027
00028 integer cret
00029 integer fid
00030
00031 integer nmesh
00032
00033 character(MED_NAME_SIZE) :: mname = ""
00034
00035 character(MED_COMMENT_SIZE) :: mdesc = ""
00036
00037 integer mdim, sdim
00038
00039 integer stype
00040 integer nstep
00041
00042 integer mtype, atype
00043
00044 character(MED_SNAME_SIZE), dimension(:), allocatable :: aname
00045 character(MED_SNAME_SIZE), dimension(:), allocatable :: aunit
00046 character(MED_SNAME_SIZE) :: dtunit = ""
00047
00048 real*8, dimension(:), allocatable :: coords
00049 integer ngeo
00050 integer nnodes
00051
00052 integer , dimension(:), allocatable :: conity
00053
00054
00055 integer coocha, geotra, matran
00056
00057
00058 integer matsiz
00059
00060 real*8 :: matrix(7) = 0.0
00061
00062 integer i, it, j
00063
00064
00065 integer profsz
00066
00067 character(MED_NAME_SIZE) :: profna = ""
00068
00069 integer numdt, numit
00070 real*8 dt
00071
00072
00073 integer geotyp
00074 integer, dimension(MED_N_CELL_FIXED_GEO) :: geotps
00075
00076 geotps = MED_GET_CELL_GEOMETRY_TYPE
00077
00078
00079 call mfiope(fid, "UsesCase_MEDmesh_9.med", MED_ACC_RDONLY, cret)
00080 if (cret .ne. 0 ) then
00081 print *, "ERROR : open file"
00082 call efexit(-1)
00083 endif
00084
00085
00086 call mmhnmh(fid, nmesh, cret)
00087 if (cret .ne. 0 ) then
00088 print *, "ERROR : read how many mesh"
00089 call efexit(-1)
00090 endif
00091
00092 print *, "nmesh :", nmesh
00093
00094 do i=1, nmesh
00095
00096
00097 call mmhnax(fid, i, sdim, cret)
00098 if (cret .ne. 0 ) then
00099 print *, "ERROR : read computation space dimension"
00100 call efexit(-1)
00101 endif
00102
00103
00104 allocate ( aname(sdim), aunit(sdim) ,STAT=cret )
00105 if (cret > 0) then
00106 print *, "ERROR : memory allocation"
00107 call efexit(-1)
00108 endif
00109
00110
00111 call mmhmii(fid, i, mname, sdim, mdim, mtype, mdesc, dtunit, stype, nstep, &
00112 atype, aname, aunit, cret)
00113 if (cret .ne. 0 ) then
00114 print *, "ERROR : read mesh informations"
00115 call efexit(-1)
00116 endif
00117 print *,"mesh name =", mname
00118 print *,"space dim =", sdim
00119 print *,"mesh dim =", mdim
00120 print *,"mesh type =", mtype
00121 print *,"mesh description =", mdesc
00122 print *,"dt unit = ", dtunit
00123 print *,"sorting type =", stype
00124 print *,"number of computing step =", nstep
00125 print *,"coordinates axis type =", atype
00126 print *,"coordinates axis name =", aname
00127 print *,"coordinates axis units =", aunit
00128 deallocate(aname, aunit)
00129
00130
00131 call mmhnme(fid, mname, MED_NO_DT, MED_NO_IT, MED_NODE, MED_NO_GEOTYPE, &
00132 MED_COORDINATE, MED_NO_CMODE, coocha, geotra, nnodes, cret)
00133 if (cret .ne. 0 ) then
00134 print *, "ERROR : read how many nodes in the mesh"
00135 call efexit(-1)
00136 endif
00137 print *, "number of nodes in the mesh =", nnodes
00138
00139
00140 allocate (coords(nnodes*sdim),STAT=cret)
00141 if (cret > 0) then
00142 print *,"ERROR : memory allocation"
00143 call efexit(-1)
00144 endif
00145
00146 call mmhcor(fid, mname, MED_NO_DT, MED_NO_IT, MED_FULL_INTERLACE, coords, cret)
00147 if (cret .ne. 0 ) then
00148 print *,"ERROR : nodes coordinates"
00149 call efexit(-1)
00150 endif
00151 print *,"Nodes coordinates =", coords
00152 deallocate(coords)
00153
00154
00155 do it=1, MED_N_CELL_FIXED_GEO
00156
00157 geotyp = geotps(it)
00158
00159 print *, "geotps(it) :", geotps(it)
00160
00161 call mmhnme(fid, mname, MED_NO_DT, MED_NO_IT, MED_CELL, geotyp, &
00162 MED_CONNECTIVITY, MED_NODAL, coocha, &
00163 geotra, ngeo, cret)
00164 if (cret .ne. 0 ) then
00165 print *,"ERROR : number of cells"
00166 call efexit(-1)
00167 endif
00168 print *,"Number of cells =", ngeo
00169
00170
00171
00172 if (ngeo .ne. 0) then
00173 allocate (conity(ngeo*mod(geotyp,100)), STAT=cret)
00174 if (cret > 0) then
00175 print *,"ERROR : memory allocation"
00176 call efexit(-1)
00177 endif
00178
00179 call mmhcyr(fid, mname, MED_NO_DT, MED_NO_IT, MED_CELL, &
00180 geotyp, MED_NODAL, MED_FULL_INTERLACE, &
00181 conity, cret)
00182 if (cret > 0) then
00183 print *,"ERROR : cellconnectivity", conity
00184 call efexit(-1)
00185 endif
00186 deallocate(conity)
00187
00188 endif
00189 end do
00190
00191
00192 do it=1, nstep-1
00193
00194 call mmhcsi(fid, mname, it+1, numdt, numit, dt, cret)
00195 if (cret .ne. 0 ) then
00196 print *,"ERROR : computing step info"
00197 call efexit(-1)
00198 endif
00199 print *,"numdt =", numdt
00200 print *,"numit =", numit
00201 print *,"dt =", dt
00202
00203
00204 call mmhnep(fid, mname, numdt, numit, MED_NODE, MED_NO_GEOTYPE, &
00205 MED_COORDINATE, MED_NO_CMODE, MED_GLOBAL_PFLMODE, &
00206 profna, profsz, coocha, geotra, nnodes, cret)
00207 if (cret .ne. 0 ) then
00208 print *,"ERROR : nodes coordinates"
00209 call efexit(-1)
00210 endif
00211 print *, "profna =", profna
00212 print *, "coocha =", coocha
00213 print *, "geotra =", geotra
00214
00215
00216
00217 if (coocha == 1 .and. geotra == 1) then
00218
00219 allocate (coords(nnodes*2),STAT=cret)
00220 if (cret > 0) then
00221 print *,"ERROR : memory allocation"
00222 call efexit(-1)
00223 endif
00224
00225 call mmhcpr(fid, mname, numdt, numit,MED_GLOBAL_PFLMODE,profna, &
00226 MED_FULL_INTERLACE,MED_ALL_CONSTITUENT, coords, cret)
00227 if (cret .ne. 0 ) then
00228 print *,"ERROR : nodes coordinates"
00229 call efexit(-1)
00230 endif
00231 print *,"Nodes coordinates =", coords
00232 deallocate(coords)
00233
00234 end if
00235
00236 if (coocha == 1 .and. .not. geotra == 1) then
00237
00238 call mmhnme(fid,mname,numdt,numit, &
00239 MED_NODE,MED_NONE,MED_COORDINATE_TRSF,MED_NODAL,coocha, &
00240 matran, matsiz, cret)
00241 if (cret .ne. 0 ) then
00242 print *,"ERROR : transformation matrix"
00243 call efexit(-1)
00244 endif
00245 print *,"Transformation matrix flag =", matran
00246 print *,"Matrix size = ", matsiz
00247
00248 if (matran == 1) then
00249 call mmhtfr(fid, mname, numdt, numit, matrix, cret)
00250 if (cret .ne. 0 ) then
00251 print *,"ERROR : transformation matrix"
00252 call efexit(-1)
00253 endif
00254 print *,"Transformation matrix =", matrix
00255
00256 end if
00257 end if
00258 end do
00259 end do
00260
00261
00262 call mficlo(fid,cret)
00263 if (cret .ne. 0 ) then
00264 print *,"ERROR : close file"
00265 call efexit(-1)
00266 endif
00267
00268 end program UsesCase_MEDmesh_12
00269
00270