UsesCase_MEDmesh_11.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 11 : read a 2D unstructured mesh with 15 nodes, 8 triangular cells, 4 quadragular cells with
00020 !*  nodes families
00021 !*
00022 
00023 program UsesCase_MEDmesh_11
00024 
00025   implicit none
00026   include 'med.hf90'
00027 
00028   integer cret
00029   integer fid
00030   ! space dim, mesh dim      
00031   integer sdim, mdim
00032   ! axis name, unit name
00033   character*16 axname(2), unname(2)
00034   ! time step unit
00035   character*16 dtunit
00036   ! mesh name, family name, file name
00037   character*64 mname, fyname, finame
00038   ! mesh type, sorting type, coordinate axis type
00039   integer mtype, stype, atype
00040   ! number of family, number of group, family number
00041   integer nfam, ngro, fnum
00042   ! number of computing step
00043   integer nstep
00044   ! coordinate changement, geotransformation
00045   integer coocha, geotra
00046   ! coordinates
00047   real*8, dimension(:), allocatable :: coords
00048   integer nnodes, ntria3, nquad4
00049   ! triangular and quadrangular cells connectivity
00050   ! integer tricon(24), quacon(16)
00051   integer, dimension(:), allocatable :: tricon, quacon
00052   integer n
00053   ! family numbers
00054   ! integer fanbrs(15)
00055   integer, dimension (:), allocatable :: fanbrs
00056   ! comment 1, mesh description
00057   character*200 cmt1, mdesc
00058   ! group name
00059   character*80, dimension (:), allocatable ::  gname  
00060 
00061   parameter (mname = "2D unstructured mesh")
00062   parameter (finame = "UsesCase_MEDmesh_10.med")
00063 
00064   ! open MED file with READ ONLY access mode
00065   call mfiope(fid, finame, MED_ACC_RDONLY, cret)
00066   if (cret .ne. 0 ) then
00067      print *,'ERROR : open file'
00068      call efexit(-1)
00069   endif
00070 
00071   ! ... we know that the MED file has only one mesh, 
00072   ! a real code working would check ... 
00073 
00074   ! read mesh informations : mesh dimension, space dimension ...
00075   call  mmhmin(fid, mname, sdim, mdim, mtype, mdesc, dtunit, stype, nstep, atype, axname, unname, cret)
00076   if (cret .ne. 0 ) then
00077      print *,'Read mesh informations'
00078      call efexit(-1)
00079   endif
00080   print *,"mesh name =", mname
00081   print *,"space dim =", sdim
00082   print *,"mesh dim =", mdim
00083   print *,"mesh type =", mtype
00084   print *,"mesh description =", mdesc
00085   print *,"dt unit = ", dtunit
00086   print *,"sorting type =", stype
00087   print *,"number of computing step =", nstep
00088   print *,"coordinates axis type =", atype
00089   print *,"coordinates axis name =", axname
00090   print *,"coordinates axis units =", unname
00091 
00092   ! read how many nodes in the mesh
00093   call mmhnme(fid,mname,MED_NO_DT,MED_NO_IT,MED_NODE,MED_NO_GEOTYPE,MED_COORDINATE,MED_NO_CMODE,coocha,geotra,nnodes,cret)
00094   if (cret .ne. 0 ) then
00095      print *,'Read number of nodes ...'
00096      call efexit(-1)
00097   endif
00098   print *,"Number of nodes  =", nnodes
00099 
00100   ! ... we know that we only have MED_TRIA3 and MED_QUAD4 in the mesh, 
00101   ! a real code working would check all MED geometry cell types ...
00102 
00103   ! read how many triangular cells in the mesh
00104   call mmhnme(fid,mname,MED_NO_DT,MED_NO_IT,MED_CELL,MED_TRIA3,MED_CONNECTIVITY,MED_NODAL,coocha,geotra,ntria3,cret)
00105   if (cret .ne. 0 ) then
00106      print *,'Read number of MED_TRIA3 ...'
00107      call efexit(-1)
00108   endif
00109   print *,"Number of MED_TRIA3  =", ntria3
00110 
00111   ! read how many quadrangular cells in the mesh
00112   call mmhnme(fid,mname,MED_NO_DT,MED_NO_IT,MED_CELL,MED_QUAD4,MED_CONNECTIVITY,MED_NODAL,coocha,geotra,nquad4,cret)
00113   if (cret .ne. 0 ) then
00114      print *,'Read number of MED_QUAD4 ...'
00115      call efexit(-1)
00116   endif
00117   print *,"Number of MED_QUAD4  =", nquad4
00118 
00119   ! read mesh nodes coordinates
00120   allocate ( coords(nnodes*sdim),STAT=cret )
00121   if (cret .ne. 0) then
00122      print *,'Memory allocation'
00123      call efexit(-1)
00124   endif
00125 
00126   call mmhcor(fid,mname,MED_NO_DT,MED_NO_IT,MED_FULL_INTERLACE,coords,cret)
00127   print *,cret
00128   if (cret .ne. 0 ) then
00129      print *,'Read nodes coordinates'
00130      call efexit(-1)
00131   endif
00132   print *,"Nodes coordinates =", coords
00133   deallocate(coords)
00134 
00135   ! read cells connectivity in the mesh
00136   allocate ( tricon(ntria3*3),STAT=cret )
00137   if (cret .ne. 0) then
00138      print *,'Memory allocation'
00139      call efexit(-1)
00140   endif
00141 
00142   call mmhcyr(fid,mname,MED_NO_DT,MED_NO_IT,MED_CELL,MED_TRIA3,MED_NODAL,MED_FULL_INTERLACE,tricon,cret)
00143   if (cret .ne. 0 ) then
00144      print *,'Read MED_TRIA3 connectivity'
00145      call efexit(-1)
00146   endif
00147   print *,"MED_TRIA3 connectivity =", tricon
00148   deallocate(tricon)
00149 
00150   ! read cells connectivity in the mesh
00151   allocate ( quacon(nquad4*4),STAT=cret )
00152   if (cret .ne. 0) then
00153      print *,'Memory allocation'
00154      call efexit(-1)
00155   endif
00156 
00157   call mmhcyr(fid,mname,MED_NO_DT,MED_NO_IT,MED_CELL,MED_QUAD4,MED_NODAL,MED_FULL_INTERLACE,quacon,cret)
00158   if (cret .ne. 0 ) then
00159      print *,'Read MED_QUAD4 connectivity'
00160      call efexit(-1)
00161   endif
00162   print *,"MED_QUAD4 connectivity =", quacon
00163   deallocate(quacon)
00164 
00165   ! read families of entities
00166   call mfanfa(fid,mname,nfam,cret)
00167   if (cret .ne. 0 ) then
00168      print *,'Read number of family'
00169      call efexit(-1)
00170   endif
00171   print *,"Number of family =", nfam
00172 
00173   do n=1,nfam
00174 
00175      call mfanfg(fid,mname,n,ngro,cret)
00176      if (cret .ne. 0 ) then
00177         print *,'Read number of group in a family'
00178         call efexit(-1)
00179      endif
00180      print *,"Number of group in family =", ngro
00181 
00182      if (ngro .gt. 0) then
00183         allocate ( gname((ngro)),STAT=cret )
00184         if (cret .ne. 0) then
00185            print *,'Memory allocation'
00186            call efexit(-1)
00187         endif
00188         call mfafai(fid,mname,n,fyname,fnum,gname,cret)
00189         if (cret .ne. 0) then
00190            print *,'Read group names'
00191            call efexit(-1)
00192         endif
00193         print *,"Group name =", gname
00194         deallocate(gname)
00195      endif
00196   
00197   enddo
00198 
00199   ! read family numbers for nodes
00200   ! By convention, if there is no numbers in the file, it means that 0 is the family 
00201   ! number of all nodes
00202   allocate ( fanbrs(nnodes),STAT=cret )
00203   if (cret .ne. 0) then
00204      print *,'Memory allocation'
00205      call efexit(-1)
00206   endif
00207   call mmhfnr(fid,mname,MED_NO_DT,MED_NO_IT,MED_NODE, MED_NONE,fanbrs,cret)
00208   if (cret .ne. 0) then
00209      do n=1,nnodes
00210         fanbrs(n) = 0
00211      enddo
00212   endif
00213   print *, 'Family numbers for nodes :', fanbrs
00214   deallocate(fanbrs)
00215 
00216   ! read family numbers for cells
00217   allocate ( fanbrs(ntria3),STAT=cret )
00218   if (cret .ne. 0) then
00219      print *,'Memory allocation'
00220      call efexit(-1)
00221   endif
00222  
00223   do n=1,ntria3
00224      fanbrs(n) = 0
00225   enddo
00226   call mmhfnr(fid,mname,MED_NO_DT,MED_NO_IT,MED_CELL,MED_TRIA3,fanbrs,cret)
00227   if (cret .ne. 0) then
00228      do n=1,ntria3
00229         fanbrs(n) = 0
00230      enddo
00231   endif
00232   print *, 'Family numbers for tria cells :', fanbrs
00233   deallocate(fanbrs)
00234 
00235   allocate ( fanbrs(nquad4),STAT=cret )
00236   if (cret .ne. 0) then
00237      print *,'Memory allocation'
00238      call efexit(-1)
00239   endif
00240   do n=1,nquad4
00241      fanbrs(n) = 0
00242   enddo  
00243   call mmhfnr(fid,mname,MED_NO_DT,MED_NO_IT,MED_CELL,MED_QUAD4,fanbrs,cret)
00244   if (cret .ne. 0) then
00245      do n=1,nquad4
00246         fanbrs(n) = 0
00247      enddo
00248   endif
00249   print *, 'Family numbers for quad cells :', fanbrs
00250   deallocate(fanbrs)
00251 
00252 ! close MED file
00253   call mficlo(fid,cret)
00254   if (cret .ne. 0 ) then
00255      print *,'ERROR :  close file'
00256      call efexit(-1)
00257   endif
00258 
00259 end program UsesCase_MEDmesh_11
00260 

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