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_8
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
00056
00057 integer i, it, j
00058
00059
00060 integer profsz
00061
00062 character(MED_NAME_SIZE) :: profna = ""
00063
00064 integer numdt, numit
00065 real*8 dt
00066
00067
00068 integer geotyp
00069 integer, dimension(MED_N_CELL_FIXED_GEO) :: geotps
00070
00071
00072
00073
00074 geotps = MED_GET_CELL_GEOMETRY_TYPE
00075
00076
00077
00078
00079
00080
00081
00082 call mfiope(fid, "UsesCase_MEDmesh_6.med", MED_ACC_RDONLY, cret)
00083 if (cret .ne. 0 ) then
00084 print *, "ERROR : open file"
00085 call efexit(-1)
00086 endif
00087
00088
00089 call mmhnmh(fid, nmesh, cret)
00090 if (cret .ne. 0 ) then
00091 print *, "ERROR : read how many mesh"
00092 call efexit(-1)
00093 endif
00094
00095 print *, "nmesh :", nmesh
00096
00097 do i=1, nmesh
00098
00099
00100 call mmhnax(fid, i, sdim, cret)
00101 if (cret .ne. 0 ) then
00102 print *, "ERROR : read computation space dimension"
00103 call efexit(-1)
00104 endif
00105
00106
00107 allocate ( aname(sdim), aunit(sdim) ,STAT=cret )
00108 if (cret > 0) then
00109 print *, "ERROR : memory allocation"
00110 call efexit(-1)
00111 endif
00112
00113
00114 call mmhmii(fid, i, mname, sdim, mdim, mtype, mdesc, dtunit, stype, nstep, &
00115 atype, aname, aunit, cret)
00116 if (cret .ne. 0 ) then
00117 print *, "ERROR : read mesh informations"
00118 call efexit(-1)
00119 endif
00120 print *,"mesh name =", mname
00121 print *,"space dim =", sdim
00122 print *,"mesh dim =", mdim
00123 print *,"mesh type =", mtype
00124 print *,"mesh description =", mdesc
00125 print *,"dt unit = ", dtunit
00126 print *,"sorting type =", stype
00127 print *,"number of computing step =", nstep
00128 print *,"coordinates axis type =", atype
00129 print *,"coordinates axis name =", aname
00130 print *,"coordinates axis units =", aunit
00131 deallocate(aname, aunit)
00132
00133
00134 call mmhnme(fid, mname, MED_NO_DT, MED_NO_IT, MED_NODE, MED_NO_GEOTYPE, &
00135 MED_COORDINATE, MED_NO_CMODE, coocha, geotra, nnodes, cret)
00136 if (cret .ne. 0 ) then
00137 print *, "ERROR : read how many nodes in the mesh"
00138 call efexit(-1)
00139 endif
00140 print *, "number of nodes in the mesh =", nnodes
00141
00142
00143 allocate (coords(nnodes*sdim),STAT=cret)
00144 if (cret > 0) then
00145 print *,"ERROR : memory allocation"
00146 call efexit(-1)
00147 endif
00148
00149 call mmhcor(fid, mname, MED_NO_DT, MED_NO_IT, MED_FULL_INTERLACE, coords, cret)
00150 if (cret .ne. 0 ) then
00151 print *,"ERROR : nodes coordinates"
00152 call efexit(-1)
00153 endif
00154 print *,"Nodes coordinates =", coords
00155 deallocate(coords)
00156
00157
00158 do it=1, MED_N_CELL_FIXED_GEO
00159
00160 geotyp = geotps(it)
00161
00162 print *, "geotps(it) :", geotps(it)
00163
00164 call mmhnme(fid, mname, MED_NO_DT, MED_NO_IT, MED_CELL, geotyp, &
00165 MED_CONNECTIVITY, MED_NODAL, coocha, &
00166 geotra, ngeo, cret)
00167 if (cret .ne. 0 ) then
00168 print *,"ERROR : number of cells"
00169 call efexit(-1)
00170 endif
00171 print *,"Number of cells =", ngeo
00172
00173
00174
00175 if (ngeo .ne. 0) then
00176 allocate (conity(ngeo*mod(geotyp,100)), STAT=cret)
00177 if (cret > 0) then
00178 print *,"ERROR : memory allocation"
00179 call efexit(-1)
00180 endif
00181
00182 call mmhcyr(fid, mname, MED_NO_DT, MED_NO_IT, MED_CELL, &
00183 geotyp, MED_NODAL, MED_FULL_INTERLACE, &
00184 conity, cret)
00185 if (cret > 0) then
00186 print *,"ERROR : cellconnectivity", conity
00187 call efexit(-1)
00188 endif
00189 deallocate(conity)
00190
00191 endif
00192 end do
00193
00194
00195 do it=1, nstep-1
00196
00197 call mmhcsi(fid, mname, it+1, numdt, numit, dt, cret)
00198 if (cret .ne. 0 ) then
00199 print *,"ERROR : computing step info"
00200 call efexit(-1)
00201 endif
00202 print *,"numdt =", numdt
00203 print *,"numit =", numit
00204 print *,"dt =", dt
00205
00206
00207 call mmhnep(fid, mname, numdt, numit, MED_NODE, MED_NO_GEOTYPE, &
00208 MED_COORDINATE, MED_NO_CMODE, MED_GLOBAL_PFLMODE, &
00209 profna, profsz, coocha, geotra, nnodes, cret)
00210 if (cret .ne. 0 ) then
00211 print *,"ERROR : nodes coordinates"
00212 call efexit(-1)
00213 endif
00214 print *, "profna =", profna
00215 print *, "coocha =", coocha
00216 print *, "geotra =", geotra
00217
00218
00219
00220 if (coocha == 1 .and. geotra == 1) then
00221
00222 allocate (coords(nnodes*2),STAT=cret)
00223 if (cret > 0) then
00224 print *,"ERROR : memory allocation"
00225 call efexit(-1)
00226 endif
00227
00228 call mmhcpr(fid, mname, numdt, numit,MED_GLOBAL_PFLMODE,profna, &
00229 MED_FULL_INTERLACE,MED_ALL_CONSTITUENT, coords, cret)
00230 if (cret .ne. 0 ) then
00231 print *,"ERROR : nodes coordinates"
00232 call efexit(-1)
00233 endif
00234 print *,"Nodes coordinates =", coords
00235 deallocate(coords)
00236
00237 end if
00238
00239 end do
00240
00241 end do
00242
00243
00244 call mficlo(fid,cret)
00245 if (cret .ne. 0 ) then
00246 print *,"ERROR : close file"
00247 call efexit(-1)
00248 endif
00249
00250 end program UsesCase_MEDmesh_8
00251
00252