UsesCase_MEDmesh_7.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 7 : read a 2D unstructured mesh with nodes coordinates modifications
00020 !*
00021 
00022 program UsesCase_MEDmesh_7
00023 
00024   implicit none
00025   include 'med.hf90'
00026 
00027   integer cret
00028   integer fid
00029   ! mesh name
00030   character(MED_NAME_SIZE)  :: mname = "2D unstructured mesh"
00031   ! mesh description
00032   character(MED_COMMENT_SIZE) :: mdesc
00033   ! mesh dimension, space dimension
00034   integer mdim, sdim
00035   ! mesh sorting type
00036   integer stype
00037   integer nstep
00038   ! mesh type, axis type
00039   integer mtype, atype
00040   ! axis name, axis unit
00041   character(MED_SNAME_SIZE), dimension(:), allocatable :: aname
00042   character(MED_SNAME_SIZE), dimension(:), allocatable :: aunit
00043   character(MED_SNAME_SIZE)  :: dtunit =""
00044   ! coordinates
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   ! coordinate changement, geometry transformation
00053   integer coocha, geotra
00054 
00055   integer it
00056 
00057   ! profil size
00058   integer profsz
00059   ! profil name
00060    character(MED_NAME_SIZE) :: profna = ""
00061 
00062   integer numdt, numit
00063   real*8 dt
00064 
00065   ! open MED file with READ ONLY access mode
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   ! ... we know that the MED file has only one mesh, 
00073   ! a real code working would check ... 
00074 
00075   ! read mesh informations
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   ! read how many nodes in the mesh **
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   ! we know that we only have MED_TRIA3 and MED_QUAD4 in the mesh
00110   ! a real code working would check all MED geometry cell types
00111 
00112   ! read how many triangular cells in the mesh
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   ! read how many quadrangular cells in the mesh
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   ! read mesh nodes coordinates in the initial mesh
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   ! read cells connectivity in the mesh
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   ! we know that the family number of nodes and elements is 0, a real working would check ...
00177 
00178   ! read nodes coordinates changements step by step
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      ! test for nodes coordinates change
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      ! if coordinates have changed, then read the new coordinates
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   ! close file
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 

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