00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013
00014
00015
00016
00017
00018
00019
00020
00021
00022 program UsesCase_MEDmesh_7
00023
00024 implicit none
00025 include 'med.hf90'
00026
00027 integer cret
00028 integer fid
00029
00030 character(MED_NAME_SIZE) :: mname = "2D unstructured mesh"
00031
00032 character(MED_COMMENT_SIZE) :: mdesc
00033
00034 integer mdim, sdim
00035
00036 integer stype
00037 integer nstep
00038
00039 integer mtype, atype
00040
00041 character(MED_SNAME_SIZE), dimension(:), allocatable :: aname
00042 character(MED_SNAME_SIZE), dimension(:), allocatable :: aunit
00043 character(MED_SNAME_SIZE) :: dtunit =""
00044
00045 real*8, dimension(:), allocatable :: coords
00046 integer nnodes
00047 integer, dimension(:), allocatable :: tricon
00048 integer ntria3
00049 integer, dimension(:), allocatable :: quacon
00050 integer nquad4
00051
00052
00053 integer coocha, geotra
00054
00055 integer it
00056
00057
00058 integer profsz
00059
00060 character(MED_NAME_SIZE) :: profna = ""
00061
00062 integer numdt, numit
00063 real*8 dt
00064
00065
00066 call mfiope(fid, "UsesCase_MEDmesh_6.med", MED_ACC_RDONLY, cret)
00067 if (cret .ne. 0 ) then
00068 print *, "ERROR : open file"
00069 call efexit(-1)
00070 endif
00071
00072
00073
00074
00075
00076 allocate ( aname(2), aunit(2) ,STAT=cret )
00077 if (cret > 0) then
00078 print *, "ERROR : memory allocation"
00079 call efexit(-1)
00080 endif
00081
00082 call mmhmin(fid, mname, sdim, mdim, mtype, mdesc, dtunit, stype, nstep, atype, aname, aunit, cret)
00083 if (cret .ne. 0 ) then
00084 print *, "ERROR : read mesh informations"
00085 call efexit(-1)
00086 endif
00087 print *,"mesh name =", mname
00088 print *,"space dim =", sdim
00089 print *,"mesh dim =", mdim
00090 print *,"mesh type =", mtype
00091 print *,"mesh description =", mdesc
00092 print *,"dt unit = ", dtunit
00093 print *,"sorting type =", stype
00094 print *,"number of computing step =", nstep
00095 print *,"coordinates axis type =", atype
00096 print *,"coordinates axis name =", aname
00097 print *,"coordinates axis units =", aunit
00098 deallocate(aname, aunit)
00099
00100
00101 call mmhnme(fid, mname, MED_NO_DT, MED_NO_IT, MED_NODE, MED_NO_GEOTYPE, &
00102 MED_COORDINATE, MED_NO_CMODE, coocha, geotra, nnodes, cret)
00103 if (cret .ne. 0 ) then
00104 print *, "ERROR : read how many nodes in the mesh"
00105 call efexit(-1)
00106 endif
00107 print *, "number of nodes in the mesh =", nnodes
00108
00109
00110
00111
00112
00113 call mmhnme(fid, mname, MED_NO_DT, MED_NO_IT, MED_CELL, MED_TRIA3, MED_CONNECTIVITY, &
00114 MED_NODAL, coocha, geotra, ntria3, cret)
00115 if (cret .ne. 0 ) then
00116 print *, "ERROR : read how many nodes in the mesh"
00117 call efexit(-1)
00118 endif
00119 print *,"number of triangular cells in the mesh =", ntria3
00120
00121
00122 call mmhnme(fid, mname, MED_NO_DT, MED_NO_IT, MED_CELL, MED_QUAD4, MED_CONNECTIVITY, &
00123 MED_NODAL, coocha, geotra, nquad4, cret)
00124 if (cret .ne. 0 ) then
00125 print *, "ERROR : read how many nodes in the mesh"
00126 call efexit(-1)
00127 endif
00128 print *,"number of quadrangular cells in the mesh =", nquad4
00129
00130
00131 allocate (coords(nnodes*2),STAT=cret)
00132 if (cret > 0) then
00133 print *,"ERROR : memory allocation"
00134 call efexit(-1)
00135 endif
00136
00137 call mmhcor(fid, mname, MED_NO_DT, MED_NO_IT, MED_FULL_INTERLACE, coords, cret)
00138 if (cret .ne. 0 ) then
00139 print *,"ERROR : nodes coordinates"
00140 call efexit(-1)
00141 endif
00142 print *,"Nodes coordinates =", coords
00143 deallocate(coords)
00144
00145
00146 allocate ( tricon(ntria3 * 3) ,STAT=cret )
00147 if (cret > 0) then
00148 print *,"ERROR : memory allocation"
00149 call efexit(-1)
00150 endif
00151
00152 call mmhcyr(fid, mname, MED_NO_DT, MED_NO_IT, MED_CELL, MED_TRIA3, &
00153 MED_NODAL,MED_FULL_INTERLACE,tricon,cret)
00154 if (cret .ne. 0 ) then
00155 print *,"ERROR : MED_TRIA3 connectivity"
00156 call efexit(-1)
00157 endif
00158 print *,"MED_TRIA3 connectivity =", tricon
00159 deallocate(tricon)
00160
00161 allocate ( quacon(nquad4*4) ,STAT=cret )
00162 if (cret > 0) then
00163 print *,"ERROR : memory allocation"
00164 call efexit(-1)
00165 endif
00166
00167 call mmhcyr(fid, mname, MED_NO_DT, MED_NO_IT, MED_CELL, MED_QUAD4, &
00168 MED_NODAL, MED_FULL_INTERLACE, quacon, cret)
00169 if (cret .ne. 0 ) then
00170 print *,"ERROR : MED_QUAD4 connectivity"
00171 call efexit(-1)
00172 endif
00173 print *,"MED_QUAD4 connectivity =", quacon
00174 deallocate(quacon)
00175
00176
00177
00178
00179 do it=1, nstep-1
00180
00181 call mmhcsi(fid, mname, it+1, numdt, numit, dt, cret)
00182 if (cret .ne. 0 ) then
00183 print *,"ERROR : computing step info"
00184 call efexit(-1)
00185 endif
00186 print *,"numdt =", numdt
00187 print *,"numit =", numit
00188 print *,"dt =", dt
00189
00190
00191 call mmhnep(fid, mname, numdt, numit, MED_NODE, MED_NO_GEOTYPE, &
00192 MED_COORDINATE, MED_NO_CMODE, MED_GLOBAL_PFLMODE, &
00193 profna, profsz, coocha, geotra, nnodes, cret)
00194 if (cret .ne. 0 ) then
00195 print *,"ERROR : nodes coordinates"
00196 call efexit(-1)
00197 endif
00198 print *, "profna = ", profna
00199 print *, "coocha =", coocha
00200
00201
00202 if (coocha == 1) then
00203
00204 allocate (coords(nnodes*2),STAT=cret)
00205 if (cret > 0) then
00206 print *,"ERROR : memory allocation"
00207 call efexit(-1)
00208 endif
00209
00210 call mmhcpr(fid, mname, numdt, numit,MED_GLOBAL_PFLMODE,profna, &
00211 MED_FULL_INTERLACE,MED_ALL_CONSTITUENT, coords, cret)
00212 if (cret .ne. 0 ) then
00213 print *,"ERROR : nodes coordinates"
00214 call efexit(-1)
00215 endif
00216 print *,"Nodes coordinates =", coords
00217 deallocate(coords)
00218
00219 end if
00220
00221 end do
00222
00223
00224 call mficlo(fid,cret)
00225 if (cret .ne. 0 ) then
00226 print *,"ERROR : close file"
00227 call efexit(-1)
00228 endif
00229
00230 end program UsesCase_MEDmesh_7
00231
00232