# UsesCase_MEDmesh_5.f90

Aller à la documentation de ce fichier.

    00001 !*  This file is part of MED.
    00002 !*
    00003 !*  COPYRIGHT (C) 1999 - 2012  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 !*
    00020 !*  Use case 5 : read a 2D structured mesh
    00021 !*
    00022
    00023 program UsesCase_MEDmesh_5
    00024
    00025   implicit none
    00026   include 'med.hf90'
    00027
    00028   integer cret
    00029   integer fid, nmesh, it, naxis, axis
    00030   integer coocha, geotra
    00031   character(64)  :: mname = "2D structured mesh"
    00032   character(200) :: desc
    00033   character(16)  :: dtunit
    00034   integer nstep, mdim, sdim, stype, mtype, atype, asize
    00035   integer gtype, ncell
    00036   character(16), dimension(:), allocatable :: aname
    00037   character(16), dimension (:), allocatable :: aunit
    00038   real*8, dimension (:), allocatable :: cooXaxis
    00039   real*8, dimension (:), allocatable :: cooYaxis
    00040   character*16, dimension (:), allocatable ::  cnames
    00041
    00042   ! open MED file
    00043   call mfiope(fid,'UsesCase_MEDmesh_4.med',MED_ACC_RDONLY, cret)
    00044   if (cret .ne. 0 ) then
    00045      print *,'ERROR : open file'
    00046      call efexit(-1)
    00047   endif
    00048
    00049   ! ... we know that the MED file has only one mesh,
    00050   ! a real code working would check ...
    00051
    00052   ! read computation space dimension
    00053   call mmhnan(fid,mname,naxis,cret)
    00054   if (cret .ne. 0 ) then
    00055      print *,'Read number of axis in the mesh'
    00056      call efexit(-1)
    00057   endif
    00058   print *,'Number of axis in the mesh  = ',naxis
    00059
    00060   ! read mesh informations
    00061   allocate ( aname(naxis), aunit(naxis) ,STAT=cret )
    00062   if (cret > 0) then
    00063      print *,'Memory allocation'
    00064      call efexit(-1)
    00065   endif
    00066
    00067   call  mmhmin(fid, mname, sdim, mdim, mtype, desc, dtunit, stype, nstep, atype, aname, aunit, cret)
    00068   if (cret .ne. 0 ) then
    00069      print *,'Read mesh informations'
    00070      call efexit(-1)
    00071   endif
    00072   print *,"mesh name =", mname
    00073   print *,"space dim =", sdim
    00074   print *,"mesh dim =", mdim
    00075   print *,"mesh type =", mtype
    00076   print *,"mesh description =", desc
    00077   print *,"dt unit = ", dtunit
    00078   print *,"sorting type =", stype
    00079   print *,"number of computing step =", nstep
    00080   print *,"coordinates axis type =", atype
    00081   print *,"coordinates axis name =", aname
    00082   print *,"coordinates axis units =", aunit
    00083   deallocate(aname, aunit)
    00084
    00085   ! read grid type
    00086   call mmhgtr(fid,mname,gtype,cret)
    00087   if (cret .ne. 0 ) then
    00088      print *,'Read grid type'
    00089      call efexit(-1)
    00090   endif
    00091   print *,"grid type =", gtype
    00092
    00093   ! ... we know that we the mesh is a cartesian grid,
    00094   ! a real code working would check  ...
    00095
    00096   ! read the axis coordinates (MED_CARTESIAN coordinates system)
    00097   ! X
    00098   axis = 1
    00099   call mmhnme(fid,mname,MED_NO_DT,MED_NO_IT,MED_NODE,MED_NONE,MED_COORDINATE_AXIS1,MED_NO_CMODE,coocha,geotra,asize,cret)
    00100   if (cret .ne. 0 ) then
    00101      print *,'Read number of coordinates on X axis '
    00102      call efexit(-1)
    00103   endif
    00104   print *,"Number of coordinates on X axis  =", asize
    00105   ncell = asize-1
    00106
    00107   allocate ( cooXaxis(asize),STAT=cret )
    00108   if (cret > 0) then
    00109      print *,'Memory allocation'
    00110      call efexit(-1)
    00111   endif
    00112
    00113   call mmhgcr(fid,mname,MED_NO_DT,MED_NO_IT,axis,cooXaxis,cret)
    00114   if (cret .ne. 0 ) then
    00115      print *,'Read axis X coordinates'
    00116      call efexit(-1)
    00117   endif
    00118   print *,"Axis X coordinates  =", cooXaxis
    00119   deallocate(cooXaxis)
    00120
    00121   ! Y
    00122   axis = 2
    00123   call mmhnme(fid,mname,MED_NO_DT,MED_NO_IT,MED_NODE,MED_NONE,MED_COORDINATE_AXIS2,MED_NO_CMODE,coocha,geotra,asize,cret)
    00124   if (cret .ne. 0 ) then
    00125      print *,'Read number of coordinates on Y axis '
    00126      call efexit(-1)
    00127   endif
    00128   print *,"Number of coordinates on Y axis  =", asize
    00129   ncell = ncell * (asize-1)
    00130
    00131   allocate ( cooYaxis(asize),STAT=cret )
    00132   if (cret > 0) then
    00133      print *,'Memory allocation'
    00134      call efexit(-1)
    00135   endif
    00136
    00137   call mmhgcr(fid,mname,MED_NO_DT,MED_NO_IT,axis,cooYaxis,cret)
    00138   if (cret .ne. 0 ) then
    00139      print *,'Read axis Y coordinates'
    00140      call efexit(-1)
    00141   endif
    00142   print *,"Axis Y coordinates  =", cooYaxis
    00143   deallocate(cooYaxis)
    00144
    00145   ! optionnal : read names for nodes or elements
    00146   print *,'ncell :', ncell
    00147   allocate ( cnames(ncell),STAT=cret )
    00148   if (cret > 0) then
    00149      print *,'Memory allocation'
    00150      call efexit(-1)
    00151   endif
    00152
    00153   call mmhear(fid,mname,MED_NO_DT,MED_NO_IT,MED_CELL,MED_QUAD4,cnames,cret)
    00154   if (cret .ne. 0 ) then
    00155      print *,'Read names for elements'
    00156      call efexit(-1)
    00157   endif
    00158   print *,'Cells names =', cnames
    00159   deallocate(cnames)
    00160
    00161   ! close file
    00162   call mficlo(fid,cret)
    00163   if (cret .ne. 0 ) then
    00164      print *,'ERROR :  close file'
    00165      call efexit(-1)
    00166   endif
    00167
    00168 end program UsesCase_MEDmesh_5
    00169