# test24.f

Aller à la documentation de ce fichier.

    00001 C*  This file is part of MED.
    00002 C*
    00003 C*  COPYRIGHT (C) 1999 - 2011  EDF R&D, CEA/DEN
    00004 C*  MED is free software: you can redistribute it and/or modify
    00005 C*  it under the terms of the GNU Lesser General Public License as published by
    00006 C*  the Free Software Foundation, either version 3 of the License, or
    00007 C*  (at your option) any later version.
    00008 C*
    00009 C*  MED is distributed in the hope that it will be useful,
    00010 C*  but WITHOUT ANY WARRANTY; without even the implied warranty of
    00011 C*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    00012 C*  GNU Lesser General Public License for more details.
    00013 C*
    00014 C*  You should have received a copy of the GNU Lesser General Public License
    00015 C*  along with MED.  If not, see <http://www.gnu.org/licenses/>.
    00016 C*
    00017
    00018 C       *******************************************************************************
    00019 C       * - Nom du fichier : test24.f
    00020 C       *
    00021 C       * - Description : lecture de mailles MED_POLYGONE dans le maillage MED
    00022 C       *                 du fichier test23.med
    00023 C       *
    00024 C       ******************************************************************************
    00025         program test23
    00026 C
    00027         implicit none
    00028         include 'med.hf'
    00029 C
    00030         integer cret, fid,mdim,nmaa,npoly,i,j,k,taille
    00031         integer edim,nstep,stype,atype, chgt, tsf
    00032         character*64 maa
    00033         character*200 desc
    00034         integer ni, n, isize;
    00035         parameter (ni=4, n=3)
    00036         integer index(ni),ind1,ind2
    00037         character*16 nom(n)
    00038         integer num(n),fam(n)
    00039         integer con(16)
    00040         integer type
    00041         character*16 nomcoo(2)
    00042         character*16 unicoo(2)
    00043         character(16)  :: dtunit
    00044 C
    00045 C       Ouverture du fichier test23.med en lecture seule
    00046         call mfiope(fid,'test23.med',MED_ACC_RDONLY, cret)
    00047         print *,cret
    00048         if (cret .ne. 0 ) then
    00049            print *,'Erreur ouverture du fichier'
    00050            call efexit(-1)
    00051         endif
    00052         print *,'Ouverture du fichier test23.med'
    00053 C
    00054 C       Lecture du nombre de maillages
    00055         call mmhnmh(fid,nmaa,cret)
    00056         print *,cret
    00057         if (cret .ne. 0 ) then
    00058            print *,'Erreur lecture nombre de maillage'
    00059            call efexit(-1)
    00060         endif
    00061         print *,'Nombre de maillages : ',nmaa
    00062 C
    00063 C       Lecture de toutes les mailles MED_POLYGONE
    00064 C       dans chaque maillage
    00065         do 10 i=1,nmaa
    00066 C
    00067 C          Info sur chaque maillage
    00068            call mmhmii(fid,i,maa,edim,mdim,type,desc,
    00069      &                 dtunit,stype,nstep,atype,
    00070      &                 nomcoo,unicoo,cret)
    00071            if (cret .ne. 0 ) then
    00072               print *,'Erreur lecture infos maillage'
    00073               call efexit(-1)
    00074            endif
    00075            print *,cret
    00076            print *,'Maillage : ',maa
    00077            print *,'Dimension : ',mdim
    00078 C
    00079 C          Combien de mailles polygones
    00080            call mmhnme(fid,maa,MED_NO_DT,MED_NO_IT,MED_CELL,MED_POLYGON,
    00081      &                 MED_INDEX_NODE,MED_NODAL,chgt,tsf,isize,cret)
    00082            npoly = isize - 1;
    00083            print *,cret
    00084            if (cret .ne. 0 ) then
    00085               print *,'Erreur lecture du nombre de polygone'
    00086               call efexit(-1)
    00087            endif
    00088            print *,'Nombre de mailles MED_POLYGONE : ',npoly
    00089 C
    00090 C          Taille des connectivites
    00091            call mmhnme(fid,maa,MED_NO_DT,MED_NO_IT,MED_CELL,MED_POLYGON,
    00092      &                 MED_CONNECTIVITY,MED_NODAL,chgt,tsf,taille,cret)
    00093            print *,cret
    00094            if (cret .ne. 0 ) then
    00095               print *,'Erreur lecture infos polygones'
    00096               call efexit(-1)
    00097            endif
    00098            print *,'Taille de la connectivite : ',taille
    00099 C
    00100 C          Lecture de la connectivite
    00101            call mmhpgr(fid,maa,MED_NO_DT,MED_NO_IT,MED_CELL,
    00102      &                 MED_NODAL,index,con,cret)
    00103            print *,cret
    00104            if (cret .ne. 0 ) then
    00105               print *,'Erreur lecture des connectivites polygones'
    00106               call efexit(-1)
    00107            endif
    00108            print *,'Lecture de la connectivite des polygones'
    00109 C
    00110 C          Lecture des noms
    00111            call mmhear(fid,maa,MED_NO_DT,MED_NO_IT,
    00112      &                 MED_CELL,MED_POLYGON,nom,cret)
    00113            print *,cret
    00114            if (cret .ne. 0 ) then
    00115               print *,'Erreur lecture des noms des polygones'
    00116               call efexit(-1)
    00117            endif
    00118            print *,'Lecture des noms'
    00119 C
    00120 C          Lecture des numeros
    00121            call mmhfnr(fid,maa,MED_NO_DT,MED_NO_IT,MED_CELL,MED_POLYGON,
    00122      &                 num,cret)
    00123            print *,cret
    00124            if (cret .ne. 0 ) then
    00125               print *,'Erreur lecture des numeros des polygones'
    00126               call efexit(-1)
    00127            endif
    00128            print *,'Lecture des numeros'
    00129 C
    00130 C          Lecture des numeros de familles
    00131            call mmhfnr(fid,maa,MED_NO_DT,MED_NO_IT,MED_CELL,MED_POLYGON,
    00132      &                 fam,cret)
    00133            print *,cret
    00134            if (cret .ne. 0 ) then
    00135               print *,
    00136 'Erreur lecture des numeros de famille des     & polygones'
    00137               call efexit(-1)
    00138            endif
    00139            print *,'Lecture des numeros de famille'
    00140 C
    00141 C          Affichage des resultats
    00142            print *,'Affichage des resultats'
    00143            do 20 j=1,npoly
    00144 C
    00145               print *,'>> Maille polygone ',j
    00146               print *,'---- Connectivite      ---- : '
    00147               ind1 = index(j)
    00148               ind2 = index(j+1)
    00149               do 30 k=ind1,ind2-1
    00150                  print *,con(k)
    00151  30           continue
    00152 c             print *,'---- Nom               ---- : ',nom(j)
    00153               print *,'---- Numero            ----:  ',num(j)
    00154               print *,'---- Numero de famille ---- : ',fam(j)
    00155 C
    00156  20        continue
    00157 C
    00158  10     continue
    00159 C
    00160 C       Fermeture du fichier
    00161         call mficlo(fid,cret)
    00162         print *,cret
    00163         if (cret .ne. 0 ) then
    00164            print *,'Erreur fermeture du fichier'
    00165            call efexit(-1)
    00166         endif
    00167         print *,'Fermeture du fichier'
    00168 C
    00169         end