# f/2.3.6/test24.f

    00001 C*  This file is part of MED.
    00002 C*
    00003 C*  COPYRIGHT (C) 1999 - 2012  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         character*32 maa
    00032         character*200 desc
    00033         integer ni, n
    00034         parameter (ni=4, n=3)
    00035         integer index(ni),ind1,ind2
    00036         character*16 nom(n)
    00037         integer num(n),fam(n)
    00038         integer con(16)
    00039         integer type
    00040 C
    00041 C       Ouverture du fichier test23.med en lecture seule
    00042         call efouvr(fid,'test23.med',MED_LECTURE, cret)
    00043         print *,cret
    00044         if (cret .ne. 0 ) then
    00045            print *,'Erreur ouverture du fichier'
    00046            call efexit(-1)
    00047         endif
    00048         print *,'Ouverture du fichier test23.med'
    00049 C
    00050 C       Lecture du nombre de maillages
    00051         call efnmaa(fid,nmaa,cret)
    00052         print *,cret
    00053         if (cret .ne. 0 ) then
    00054            print *,'Erreur lecture nombre de maillage'
    00055            call efexit(-1)
    00056         endif
    00057         print *,'Nombre de maillages : ',nmaa
    00058 C
    00059 C       Lecture de toutes les mailles MED_POLYGONE
    00060 C       dans chaque maillage
    00061         do 10 i=1,nmaa
    00062 C
    00063 C          Info sur chaque maillage
    00064            call efmaai(fid,i,maa,mdim,type,desc,cret)
    00065            if (cret .ne. 0 ) then
    00066               print *,'Erreur lecture infos maillage'
    00067               call efexit(-1)
    00068            endif
    00069            print *,cret
    00070            print *,'Maillage : ',maa
    00071            print *,'Dimension : ',mdim
    00072 C
    00073 C          Combien de mailles polygones
    00074            call efnema(fid,maa,MED_CONN,MED_MAILLE,MED_POLYGONE,
    00075      &                       MED_NOD,npoly,cret)
    00076            print *,cret
    00077            if (cret .ne. 0 ) then
    00078               print *,'Erreur lecture du nombre de polygone'
    00079               call efexit(-1)
    00080            endif
    00081            print *,'Nombre de mailles MED_POLYGONE : ',npoly
    00082 C
    00083 C          Taille des connectivites
    00084            call efpygi(fid,maa,MED_MAILLE,MED_NOD,taille,cret)
    00085            print *,cret
    00086            if (cret .ne. 0 ) then
    00087               print *,'Erreur lecture infos polygones'
    00088               call efexit(-1)
    00089            endif
    00090            print *,'Taille de la connectivite : ',taille
    00091 C
    00092 C          Lecture de la connectivite
    00093            call efpgcl(fid,maa,index,npoly+1,con,MED_MAILLE,
    00094      &                       MED_NOD,cret)
    00095            print *,cret
    00096            if (cret .ne. 0 ) then
    00097               print *,'Erreur lecture des connectivites polygones'
    00098               call efexit(-1)
    00099            endif
    00100            print *,'Lecture de la connectivite des polygones'
    00101 C
    00102 C          Lecture des noms
    00103            call efnoml(fid,maa,nom,npoly,MED_MAILLE,MED_POLYGONE,
    00104      &                       cret)
    00105            print *,cret
    00106            if (cret .ne. 0 ) then
    00107               print *,'Erreur lecture des noms des polygones'
    00108               call efexit(-1)
    00109            endif
    00110            print *,'Lecture des noms'
    00111 C
    00112 C          Lecture des numeros
    00113            call efnuml(fid,maa,num,npoly,MED_MAILLE,MED_POLYGONE,
    00114      &                       cret)
    00115            print *,cret
    00116            if (cret .ne. 0 ) then
    00117               print *,'Erreur lecture des numeros des polygones'
    00118               call efexit(-1)
    00119            endif
    00120            print *,'Lecture des numeros'
    00121 C
    00122 C          Lecture des numeros de familles
    00123            call effaml(fid,maa,fam,npoly,MED_MAILLE,MED_POLYGONE,
    00124      &                       cret)
    00125            print *,cret
    00126            if (cret .ne. 0 ) then
    00127               print *,
    00128 'Erreur lecture des numeros de famille des     & polygones'
    00129               call efexit(-1)
    00130            endif
    00131            print *,'Lecture des numeros de famille'
    00132 C
    00133 C          Affichage des resultats
    00134            print *,'Affichage des resultats'
    00135            do 20 j=1,npoly
    00136 C
    00137               print *,'>> Maille polygone ',j
    00138               print *,'---- Connectivite      ---- : '
    00139               ind1 = index(j)
    00140               ind2 = index(j+1)
    00141               do 30 k=ind1,ind2-1
    00142                  print *,con(k)
    00143  30           continue
    00144               print *,'---- Nom               ---- : ',nom(j)
    00145               print *,'---- Numero            ----:  ',num(j)
    00146               print *,'---- Numero de famille ---- : ',fam(j)
    00147 C
    00148  20        continue
    00149 C
    00150  10     continue
    00151 C
    00152 C       Fermeture du fichier
    00153         call efferm (fid,cret)
    00154         print *,cret
    00155         if (cret .ne. 0 ) then
    00156            print *,'Erreur fermeture du fichier'
    00157            call efexit(-1)
    00158         endif
    00159         print *,'Fermeture du fichier'
    00160 C
    00161         end