UsesCase_MEDmesh_2.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 2 read a 2D unstructured mesh with 15 nodes,
00020 !*               8 triangular cells, 4 triangular cells
00021 !*  - Computation step : NO
00022 !*
00023 
00024 program UsesCase_MEDmesh_2
00025 
00026   implicit none
00027   include 'med.hf90'
00028 
00029   integer cret
00030   integer fid, nmesh, it, naxis
00031   character(64)  :: mname = "2D unstructured mesh"
00032   character(200) :: desc
00033   character(16)  :: dtunit
00034   integer nstep, mdim, sdim, stype, mtype, atype
00035   character(16), dimension(:), allocatable :: aname
00036   character(16), dimension (:), allocatable :: aunit
00037   real*8, dimension(:), allocatable :: ncoord
00038   integer coocha, geotra, nnodes, ntria3, nquad4
00039   integer, dimension(:), allocatable :: tricon
00040   integer, dimension(:), allocatable :: quacon
00041 
00042   ! open MED file with READ ONLY access mode **
00043   call mfiope(fid,'UsesCase_MEDmesh_1.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 mesh informations : 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 how many nodes in the mesh **
00086   call mmhnme(fid,mname,MED_NO_DT,MED_NO_IT,MED_NODE,MED_NO_GEOTYPE,MED_COORDINATE,MED_NO_CMODE,coocha,geotra,nnodes,cret)
00087   if (cret .ne. 0 ) then
00088      print *,'Read how many nodes in the mesh'
00089      call efexit(-1)
00090   endif
00091   print *,"number of nodes in the mesh =", nnodes
00092 
00093   ! we know that we only have MED_TRIA3 and MED_QUAD4 in the mesh
00094   ! a real code working would check all MED geometry cell types
00095 
00096   ! read how many triangular cells in the mesh
00097   call mmhnme(fid,mname,MED_NO_DT,MED_NO_IT,MED_CELL,MED_TRIA3,MED_CONNECTIVITY,MED_NODAL,coocha,geotra,ntria3,cret)
00098   if (cret .ne. 0 ) then
00099      print *,'Read how many nodes in the mesh'
00100      call efexit(-1)
00101   endif
00102   print *,"number of triangular cells in the mesh =", ntria3
00103 
00104   ! read how many quadrangular cells in the mesh
00105   call mmhnme(fid,mname,MED_NO_DT,MED_NO_IT,MED_CELL,MED_QUAD4,MED_CONNECTIVITY,MED_NODAL,coocha,geotra,nquad4,cret)
00106   if (cret .ne. 0 ) then
00107      print *,'Read how many nodes in the mesh'
00108      call efexit(-1)
00109   endif
00110   print *,"number of quadrangular cells in the mesh =", nquad4
00111 
00112   ! read mesh nodes coordinates
00113   allocate (ncoord(nnodes*2),STAT=cret)
00114   if (cret > 0) then
00115      print *,'Memory allocation'
00116      call efexit(-1)
00117   endif
00118 
00119   call mmhcor(fid,mname,MED_NO_DT,MED_NO_IT,MED_FULL_INTERLACE,ncoord,cret)
00120   if (cret .ne. 0 ) then
00121      print *,'Nodes coordinates'
00122      call efexit(-1)
00123   endif
00124   print *,"Nodes coordinates =", ncoord
00125   deallocate(ncoord)
00126 
00127   ! read cells connectivity in the mesh
00128   allocate ( tricon(ntria3 * 3) ,STAT=cret )
00129   if (cret > 0) then
00130      print *,'Memory allocation'
00131      call efexit(-1)
00132   endif
00133 
00134   call mmhcyr(fid,mname,MED_NO_DT,MED_NO_IT,MED_CELL,MED_TRIA3,MED_NODAL,MED_FULL_INTERLACE,tricon,cret)
00135   if (cret .ne. 0 ) then
00136      print *,'MED_TRIA3 connectivity'
00137      call efexit(-1)
00138   endif
00139   print *,"MED_TRIA3 connectivity =", tricon
00140   deallocate(tricon)
00141 
00142   allocate ( quacon(nquad4*4) ,STAT=cret )
00143   if (cret > 0) then
00144      print *,'Memory allocation'
00145      call efexit(-1)
00146   endif
00147 
00148   call mmhcyr(fid,mname,MED_NO_DT,MED_NO_IT,MED_CELL,MED_QUAD4,MED_NODAL,MED_FULL_INTERLACE,quacon,cret)
00149   if (cret .ne. 0 ) then
00150      print *,'MED_QUAD4 connectivity'
00151      call efexit(-1)
00152   endif
00153   print *,"MED_QUAD4 connectivity =", quacon
00154   deallocate(quacon)
00155 
00156   ! we know that the family number of nodes and elements is 0, a real working would check ...
00157 
00158   ! close file **
00159   call mficlo(fid,cret)
00160   if (cret .ne. 0 ) then
00161      print *,'ERROR :  close file'
00162      call efexit(-1)
00163   endif
00164 
00165 end program UsesCase_MEDmesh_2
00166 

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