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 : test26.f
 21  C       *
 22  C       * - Description : lecture de mailles MED_POLYEDRE dans le maillage MED
 23  C       *                 du fichier test25.med   
 24  C       *
 25  C       ******************************************************************************
 26        program test26
 27  C       
 28        implicit none
 29        include 'med.hf'
 30  C   
 31        integer cret,fid,mdim,nmaa,npoly,i,j,k,l
 32        integer nfaces, nnoeuds
 33        integer ind1, ind2
 34        character*32 maa
 35        character*200 desc
 36        integer n
 37        parameter (n=2)
 38        integer np,nf,np2,nf2,taille,tmp
 39        parameter (np=3,nf=9,np2=3,nf2=8)
 40        integer indexp(np),indexf(nf)
 41        integer conn(24)
 42        integer indexp2(np2),indexf2(nf2)
 43        integer conn2(nf2)
 44        character*16 nom(n)
 45        integer num(n),fam(n)
 46        integer type
 47  C
 48  C       Ouverture du fichier test25.med en lecture seule
 49          call efouvr(fid,'test25.med',MED_LECTURE, cret)
 50          print *,cret
 51          print *,'Ouverture du fichier test25.med'
 52  C
 53  C       Combien de maillage
 54          if (cret .eq. 0)  then
 55             call efnmaa(fid,nmaa,cret)
 56             print *,cret
 57             print *,'Nombre de maillages : ',nmaa
 58          endif
 59  C   
 60  C       Lecture de toutes les mailles MED_POLYEDRE
 61  C       dans chaque maillage
 62          if (cret .eq. 0) then
 63             do 10 i=1,nmaa
 64  C
 65  C             Info sur chaque maillage
 66                call efmaai(fid,i,maa,mdim,type,desc,cret)
 67                print *,cret
 68                print *,'Maillage : ',maa
 69                print *,'Dimension : ',mdim
 70  C     
 71  C             Combien de mailles polyedres
 72                if (cret .eq. 0) then
 73                   call efnema(fid,maa,MED_CONN,MED_MAILLE,MED_POLYEDRE,
 74       &                       MED_NOD,npoly,cret)
 75                   print *,cret
 76                   print *,'Nombre de mailles MED_POLYEDRE : ',npoly
 77                endif
 78  C
 79  C             Taille des connectivites et du tableau d'indexation
 80                if (cret .eq. 0) then
 81                   call efpyei(fid,maa,MED_NOD,tmp,taille,cret)
 82                   print *,cret
 83                   print *,'Taille de la connectivite : ',taille
 84                   print *,'Taille du tableau indexf : ',tmp
 85                endif
 86  C
 87  C             Lecture de la connectivite en mode nodal
 88                if (cret .eq. 0) then
 89                   call efpecl(fid,maa,indexp,npoly+1,indexf,tmp,conn,
 90       &                       MED_NOD,cret)
 91                   print *,cret
 92                   print *,'Lecture de la connectivite des polyedres'
 93                   print *,'Connectivite nodale'
 94                endif
 95  C
 96  C             Lecture de la connectivite en mode descendant
 97                if (cret .eq. 0) then
 98                   call efpecl(fid,maa,indexp2,npoly+1,indexf2,tmp,conn2,
 99       &                       MED_DESC,cret)
100                   print *,cret
101                   print *,'Lecture de la connectivite des polyedres'
102                   print *,'Connectivite descendante'
103                endif
104  C
105  C             Lecture des noms
106                if (cret .eq. 0) then
107                   call efnoml(fid,maa,nom,npoly,MED_MAILLE,MED_POLYEDRE,
108       &                       cret)
109                   print *,cret
110                   print *,'Lecture des noms'
111                endif
112  C
113  C             Lecture des numeros
114                if (cret .eq. 0) then
115                   call efnuml(fid,maa,num,npoly,MED_MAILLE,MED_POLYEDRE,
116       &                       cret)
117                   print *,cret
118                   print *,'Lecture des numeros'
119                endif
120  C
121  C             Lecture des numeros de familles
122                if (cret .eq. 0) then
123                   call effaml(fid,maa,fam,npoly,MED_MAILLE,MED_POLYEDRE,
124       &                       cret)
125                   print *,cret
126                   print *,'Lecture des numeros de famille'
127                endif
128  C
129  C             Affichage des resultats
130                if (cret .eq. 0) then
131                   print *,'Affichage des resultats'
132                   do 20 j=1,npoly
133  C
134                      print *,'>> Maille polygone ',j
135                      print *,'---- Connectivite nodale    ---- : '
136                      nfaces = indexp(j+1) - indexp(j)
137  C                   ind1 = indice dans "indexf" pour acceder aux
138  C                          numeros des faces 
139                      ind1 = indexp(j)
140                      do 30 k=1,nfaces
141  C                      ind2 = indice dans "conn" pour acceder au premier noeud 
142                         ind2 = indexf(ind1+k-1)
143                         nnoeuds = indexf(ind1+k) - indexf(ind1+k-1)
144                         print *,'   - Face ',k
145                         do 40 l=1,nnoeuds
146                              print *,'   ',conn(ind2+l-1)
147   40                   continue
148   30                 continue
149                      print *,'---- Connectivite descendante ---- : '
150                      nfaces = indexp2(j+1) - indexp2(j)
151  C                   ind1 = indice dans "conn2" pour acceder aux faces
152                      ind1 = indexp2(j)
153                      do 50 k=1,nfaces
154                         print *,'   - Face ',k
155                         print *,'   => Numero : ',conn2(ind1+k-1)
156                         print *,'   => Type   : ',indexf2(ind1+k-1)
157   50                 continue
158                      print *,'---- Nom                    ---- : ',nom(j)
159                      print *,'---- Numero                 ----:  ',num(j)
160                      print *,'---- Numero de famille      ---- : ',fam(j)
161  C
162   20              continue
163                endif
164  C
165   10        continue
166          endif
167  C
168  C       Fermeture du fichier
169          call efferm (fid,cret)
170          print *,cret
171          print *,'Fermeture du fichier'
172          end