      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