# UsesCase_MEDmesh_11.f90

Aller à la documentation de ce fichier.

    00001 !*  This file is part of MED.
    00002 !*
    00003 !*  COPYRIGHT (C) 1999 - 2011  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