      1  C*************************************************************************
      2  C COPYRIGHT (C) 1999 - 2003  EDF R&D
      3  C THIS LIBRARY IS FREE SOFTWARE; YOU CAN REDISTRIBUTE IT AND/OR MODIFY
      4  C IT UNDER THE TERMS OF THE GNU LESSER GENERAL PUBLIC LICENSE
      5  C AS PUBLISHED BY THE FREE SOFTWARE FOUNDATION;
      6  C EITHER VERSION 2.1 OF THE LICENSE, OR (AT YOUR OPTION) ANY LATER VERSION.
      7  C
      8  C THIS LIBRARY IS DISTRIBUTED IN THE HOPE THAT IT WILL BE USEFUL, BUT
      9  C WITHOUT ANY WARRANTY; WITHOUT EVEN THE IMPLIED WARRANTY OF
     10  C MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE. SEE THE GNU
     11  C LESSER GENERAL PUBLIC LICENSE FOR MORE DETAILS.
     12  C
     13  C YOU SHOULD HAVE RECEIVED A COPY OF THE GNU LESSER GENERAL PUBLIC LICENSE
     14  C ALONG WITH THIS LIBRARY; IF NOT, WRITE TO THE FREE SOFTWARE FOUNDATION,
     15  C INC., 59 TEMPLE PLACE, SUITE 330, BOSTON, MA 02111-1307 USA
     16  C
     17  C**************************************************************************
     18
     19  C       *******************************************************************************
     20  C       * - Nom du fichier : test24.f
     21  C       *
     22  C       * - Description : lecture de mailles MED_POLYGONE dans le maillage MED
     23  C       *                 du fichier test23.med
     24  C       *
     25  C       ******************************************************************************
     26          program test24
     27  C
     28          implicit none
     29          include 'med.hf'
     30  C
     31          integer cret, fid,mdim,nmaa,npoly,i,j,k,taille
     32          character*32 maa
     33          character*200 desc
     34          integer ni, n
     35          parameter (ni=4, n=3)
     36          integer index(ni),ind1,ind2
     37          character*16 nom(n)
     38          integer num(n),fam(n)
     39          integer con(16)
     40          integer type
     41  C
     42  C       Ouverture du fichier test23.med en lecture seule
     43          call efouvr(fid,'test23.med',MED_LECTURE, cret)
     44          print *,cret
     45          print *,'Ouverture du fichier test23.med'
     46  C
     47  C       Lecture du nombre de maillages
     48          if (cret .eq. 0)  then
     49             call efnmaa(fid,nmaa,cret)
     50             print *,cret
     51             print *,'Nombre de maillages : ',nmaa
     52          endif
     53  C
     54  C       Lecture de toutes les mailles MED_POLYGONE
     55  C       dans chaque maillage
     56          if (cret .eq. 0) then
     57             do 10 i=1,nmaa
     58  C
     59  C             Info sur chaque maillage
     60                call efmaai(fid,i,maa,mdim,type,desc,cret)
     61                print *,cret
     62                print *,'Maillage : ',maa
     63                print *,'Dimension : ',mdim
     64  C
     65  C             Combien de mailles polygones
     66                if (cret .eq. 0) then
     67                   call efnema(fid,maa,MED_CONN,MED_MAILLE,MED_POLYGONE,
     68       &                       MED_NOD,npoly,cret)
     69                   print *,cret
     70                   print *,'Nombre de mailles MED_POLYGONE : ',npoly
     71                endif
     72  C
     73  C             Taille des connectivites
     74                if (cret .eq. 0) then
     75                   call efpygi(fid,maa,MED_MAILLE,MED_NOD,taille,cret)
     76                   print *,cret
     77                   print *,'Taille de la connectivite : ',taille
     78                endif
     79  C
     80  C             Lecture de la connectivite
     81                if (cret .eq. 0) then
     82                   call efpgcl(fid,maa,index,npoly+1,con,MED_MAILLE,
     83       &                       MED_NOD,cret)
     84                   print *,cret
     85                   print *,'Lecture de la connectivite des polygones'
     86                endif
     87  C
     88  C             Lecture des noms
     89                if (cret .eq. 0) then
     90                   call efnoml(fid,maa,nom,npoly,MED_MAILLE,MED_POLYGONE,
     91       &                       cret)
     92                   print *,cret
     93                   print *,'Lecture des noms'
     94                endif
     95  C
     96  C             Lecture des numeros
     97                if (cret .eq. 0) then
     98                   call efnuml(fid,maa,num,npoly,MED_MAILLE,MED_POLYGONE,
     99       &                       cret)
    100                   print *,cret
    101                   print *,'Lecture des numeros'
    102                endif
    103  C
    104  C             Lecture des numeros de familles
    105                if (cret .eq. 0) then
    106                   call effaml(fid,maa,fam,npoly,MED_MAILLE,MED_POLYGONE,
    107       &                       cret)
    108                   print *,cret
    109                   print *,'Lecture des numeros de famille'
    110                endif
    111  C
    112  C             Affichage des resultats
    113                if (cret .eq. 0) then
    114                   print *,'Affichage des resultats'
    115                   do 20 j=1,npoly
    116  C
    117                      print *,'>> Maille polygone ',j
    118                      print *,'---- Connectivite      ---- : '
    119                      ind1 = index(j)
    120                      ind2 = index(j+1)
    121                      do 30 k=ind1,ind2-1
    122                         print *,con(k)
    123   30                 continue
    124                      print *,'---- Nom               ---- : ',nom(j)
    125                      print *,'---- Numero            ----:  ',num(j)
    126                      print *,'---- Numero de famille ---- : ',fam(j)
    127  C
    128   20              continue
    129                endif
    130  C
    131   10        continue
    132          endif
    133  C
    134  C       Fermeture du fichier
    135          call efferm (fid,cret)
    136          print *,cret
    137          print *,'Fermeture du fichier'
    138          end