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