1 C*************************************************************************
  2 C COPYRIGHT (C) 1999 - 2007  EDF R&D, CEA/DEN
  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         if (cret .ne. 0 ) then
 52            print *,'Erreur ouverture du fichier'
 53            call efexit(-1)
 54         endif
 55         print *,'Ouverture du fichier test25.med'
 56 C
 57 C       Combien de maillage
 58         call efnmaa(fid,nmaa,cret)
 59         print *,cret
 60         if (cret .ne. 0 ) then
 61            print *,'Erreur lecture du nombre de maillage'
 62            call efexit(-1)
 63         endif
 64         print *,'Nombre de maillages : ',nmaa
 65 C
 66 C       Lecture de toutes les mailles MED_POLYEDRE
 67 C       dans chaque maillage
 68         do 10 i=1,nmaa
 69 C
 70 C          Info sur chaque maillage
 71            call efmaai(fid,i,maa,mdim,type,desc,cret)
 72            print *,cret
 73            if (cret .ne. 0 ) then
 74               print *,'Erreur infos maillage'
 75               call efexit(-1)
 76            endif
 77            print *,'Maillage : ',maa
 78            print *,'Dimension : ',mdim
 79 C
 80 C          Combien de mailles polyedres
 81            call efnema(fid,maa,MED_CONN,MED_MAILLE,MED_POLYEDRE,
 82      &                       MED_NOD,npoly,cret)
 83            print *,cret
 84            if (cret .ne. 0 ) then
 85               print *,'Erreur lecture nombre de polyedre'
 86               call efexit(-1)
 87            endif
 88            print *,'Nombre de mailles MED_POLYEDRE : ',npoly
 89 C
 90 C          Taille des connectivites et du tableau d'indexation
 91            call efpyei(fid,maa,MED_NOD,tmp,taille,cret)
 92            print *,cret
 93            if (cret .ne. 0 ) then
 94               print *,'Erreur infos sur les polyedres'
 95               call efexit(-1)
 96            endif      
 97            print *,'Taille de la connectivite : ',taille
 98            print *,'Taille du tableau indexf : ',tmp
 99 C
100 C          Lecture de la connectivite en mode nodal
101            call efpecl(fid,maa,indexp,npoly+1,indexf,tmp,conn,
102      &                       MED_NOD,cret)
103            print *,cret
104            if (cret .ne. 0 ) then
105               print *,'Erreur lecture connectivites polyedres'
106               call efexit(-1)
107            endif      
108            print *,'Lecture de la connectivite des polyedres'
109            print *,'Connectivite nodale'
110 C
111 C          Lecture de la connectivite en mode descendant
112            call efpecl(fid,maa,indexp2,npoly+1,indexf2,tmp,conn2,
113      &                       MED_DESC,cret)
114            print *,cret
115            if (cret .ne. 0 ) then
116               print *,'Erreur lecture connectivite des polyedres'
117               call efexit(-1)
118            endif      
119            print *,'Lecture de la connectivite des polyedres'
120            print *,'Connectivite descendante'
121 C
122 C          Lecture des noms
123            call efnoml(fid,maa,nom,npoly,MED_MAILLE,MED_POLYEDRE,
124      &                       cret)
125            print *,cret
126            if (cret .ne. 0 ) then
127               print *,'Erreur lecture noms des polyedres'
128               call efexit(-1)
129            endif      
130            print *,'Lecture des noms'
131 C
132 C          Lecture des numeros
133            call efnuml(fid,maa,num,npoly,MED_MAILLE,MED_POLYEDRE,
134      &                       cret)
135            print *,cret
136            if (cret .ne. 0 ) then
137               print *,'Erreur lecture des numeros des polyedres'
138               call efexit(-1)
139            endif      
140            print *,'Lecture des numeros'
141 C
142 C          Lecture des numeros de familles
143            call effaml(fid,maa,fam,npoly,MED_MAILLE,MED_POLYEDRE,
144      &                       cret)
145            print *,cret
146            if (cret .ne. 0 ) then
147               print *,'Erreur lecture numeros de famille polyedres'
148               call efexit(-1)
149            endif      
150            print *,'Lecture des numeros de famille'
151 C
152 C          Affichage des resultats
153            print *,'Affichage des resultats'
154            do 20 j=1,npoly
155 C
156               print *,'>> Maille polygone ',j
157               print *,'---- Connectivite nodale    ---- : '
158               nfaces = indexp(j+1) - indexp(j)
159 C             ind1 = indice dans "indexf" pour acceder aux
160 C             numeros des faces 
161               ind1 = indexp(j)
162               do 30 k=1,nfaces
163 C                ind2 = indice dans "conn" pour acceder au premier noeud 
164                  ind2 = indexf(ind1+k-1)
165                  nnoeuds = indexf(ind1+k) - indexf(ind1+k-1)
166                  print *,'   - Face ',k
167                  do 40 l=1,nnoeuds
168                     print *,'   ',conn(ind2+l-1)
169  40              continue
170  30           continue
171               print *,'---- Connectivite descendante ---- : '
172               nfaces = indexp2(j+1) - indexp2(j)
173 C             ind1 = indice dans "conn2" pour acceder aux faces
174               ind1 = indexp2(j)
175               do 50 k=1,nfaces
176                  print *,'   - Face ',k
177                  print *,'   => Numero : ',conn2(ind1+k-1)
178                  print *,'   => Type   : ',indexf2(ind1+k-1)
179  50           continue
180               print *,'---- Nom                    ---- : ',nom(j)
181               print *,'---- Numero                 ----:  ',num(j)
182               print *,'---- Numero de famille      ---- : ',fam(j)
183 C       
184  20        continue
185 C
186  10     continue
187 C
188 C       Fermeture du fichier
189         call efferm (fid,cret)
190         print *,cret
191         if (cret .ne. 0 ) then
192            print *,'Erreur fermeture du fichier'
193            call efexit(-1)
194         endif      
195         print *,'Fermeture du fichier'
196 C
197         end