      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