UsesCase_MEDmesh_8.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 8 : read a 2D unstructured mesh with nodes coordinates modifications
00020 !*  (generic approach)
00021 !*
00022 
00023 program UsesCase_MEDmesh_8
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
00055   integer coocha, geotra
00056 
00057   integer i, it, j
00058 
00059   ! profil size
00060   integer profsz
00061   ! profil name
00062    character(MED_NAME_SIZE) :: profna = ""
00063 
00064   integer numdt, numit
00065   real*8 dt
00066 
00067   ! geometry type
00068   integer geotyp
00069   integer, dimension(MED_N_CELL_FIXED_GEO) :: geotps 
00070 
00071   ! print *, "MED_N_CELL_FIXED_GEO :", MED_N_CELL_FIXED_GEO
00072   ! print *, "MED_GET_CELL_GEOMETRY_TYPE :", MED_GET_CELL_GEOMETRY_TYPE
00073 
00074   geotps = MED_GET_CELL_GEOMETRY_TYPE
00075   ! do it=1, MED_N_CELL_FIXED_GEO
00076   !   print *, it, " : ", MED_GET_CELL_GEOMETRY_TYPE(it)
00077   !   geotps(it) = MED_GET_CELL_GEOMETRY_TYPE(it)
00078   !   print *, "geotps(",it,") =",geotps(it)
00079   !end do
00080 
00081   ! open MED file with READ ONLY access mode
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   ! read how many mesh in the file 
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      ! read computation space dimension
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      ! memory allocation
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      ! read mesh informations
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      ! read how many nodes in the mesh **
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      ! read mesh nodes coordinates
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      ! read all MED geometry cell types
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         ! print *, "mod(ngeo, 100) : ", mod(geotyp,100)
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 !ngeo .ne. 0
00192      end do ! read all MED geometry cell types
00193 
00194   ! read nodes coordinates changements step by step
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      ! test for nodes coordinates change
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      ! if only coordinates have changed, then read the new coordinates
00219      ! to verify if there is a matrix transformation => UsesCase_MEDmesh12 
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 ! coocha == 1
00238 
00239   end do ! it=1, nstep-1
00240 
00241 end do ! i=0, nmesh-1
00242 
00243   ! close file
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 

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