UsesCase_MEDmesh_12.f90

Aller à la documentation de ce fichier.
00001 !*  This file is part of MED.
00002 !*
00003 !*  COPYRIGHT (C) 1999 - 2015  EDF R&D, CEA/DEN
00004 !*  MED is free software: you can redistribute it and/or modify
00005 !*  it under the terms of the GNU Lesser General Public License as published by
00006 !*  the Free Software Foundation, either version 3 of the License, or
00007 !*  (at your option) any later version.
00008 !*
00009 !*  MED is distributed in the hope that it will be useful,
00010 !*  but WITHOUT ANY WARRANTY; without even the implied warranty of
00011 !*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
00012 !*  GNU Lesser General Public License for more details.
00013 !*
00014 !*  You should have received a copy of the GNU Lesser General Public License
00015 !*  along with MED.  If not, see <http://www.gnu.org/licenses/>.
00016 !*
00017 !*
00018 !*
00019 !*  Use case 12 : read a 2D unstructured mesh with moving grid (generic approach)
00020 !*
00021 !*
00022 
00023 program UsesCase_MEDmesh_12
00024 
00025   implicit none
00026   include 'med.hf90'
00027 
00028   integer cret
00029   integer fid
00030   ! mesh number
00031   integer nmesh
00032   ! mesh name
00033   character(MED_NAME_SIZE)  :: mname = ""
00034   ! mesh description
00035   character(MED_COMMENT_SIZE) :: mdesc = ""
00036   ! mesh dimension, space dimension
00037   integer mdim, sdim
00038   ! mesh sorting type
00039   integer stype
00040   integer nstep
00041   ! mesh type, axis type
00042   integer mtype, atype
00043   ! axis name, axis unit
00044   character(MED_SNAME_SIZE), dimension(:), allocatable :: aname
00045   character(MED_SNAME_SIZE), dimension(:), allocatable :: aunit
00046   character(MED_SNAME_SIZE)  :: dtunit = ""
00047   ! coordinates
00048   real*8, dimension(:), allocatable :: coords
00049   integer ngeo
00050   integer nnodes
00051   ! connectivity
00052   integer , dimension(:), allocatable :: conity
00053 
00054   ! coordinate changement, geometry transformation, matrix transformation
00055   integer coocha, geotra, matran
00056 
00057   ! matrix size
00058   integer matsiz
00059 
00060   real*8 :: matrix(7) = 0.0
00061 
00062   integer i, it, j
00063 
00064   ! profil size
00065   integer profsz
00066   ! profil name
00067    character(MED_NAME_SIZE) :: profna = ""
00068 
00069   integer numdt, numit
00070   real*8 dt
00071 
00072   ! geometry type
00073   integer geotyp
00074   integer, dimension(MED_N_CELL_FIXED_GEO) :: geotps 
00075 
00076   geotps = MED_GET_CELL_GEOMETRY_TYPE
00077 
00078   ! open MED file with READ ONLY access mode
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   ! read how many mesh in the file 
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      ! read computation space dimension
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      ! memory allocation
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      ! read mesh informations
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      ! read how many nodes in the mesh **
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      ! read mesh nodes coordinates
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      ! read all MED geometry cell types
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         ! print *, "mod(ngeo, 100) : ", mod(geotyp,100)
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 !ngeo .ne. 0
00189      end do ! read all MED geometry cell types
00190 
00191   ! read nodes coordinates changements step by step
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      ! test for nodes coordinates change
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      ! if only coordinates have changed, then read the new coordinates
00216      ! to verify if there is a matrix transformation => UsesCase_MEDmesh12 
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 ! it=1, nstep-1
00259 end do ! i=0, nmesh-1
00260 
00261   ! close file
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 

Généré le Thu Oct 8 14:26:17 2015 pour MED fichier par  doxygen 1.6.1