# f/2.3.6/test26.f

    00001 C*  This file is part of MED.
    00002 C*
    00003 C*  COPYRIGHT (C) 1999 - 2012  EDF R&D, CEA/DEN
    00004 C*  MED is free software: you can redistribute it and/or modify
    00005 C*  it under the terms of the GNU Lesser General Public License as published by
    00006 C*  the Free Software Foundation, either version 3 of the License, or
    00007 C*  (at your option) any later version.
    00008 C*
    00009 C*  MED is distributed in the hope that it will be useful,
    00010 C*  but WITHOUT ANY WARRANTY; without even the implied warranty of
    00011 C*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    00012 C*  GNU Lesser General Public License for more details.
    00013 C*
    00014 C*  You should have received a copy of the GNU Lesser General Public License
    00015 C*  along with MED.  If not, see <http://www.gnu.org/licenses/>.
    00016 C*
    00017
    00018 C       *******************************************************************************
    00019 C       * - Nom du fichier : test26.f
    00020 C       *
    00021 C       * - Description : lecture de mailles MED_POLYEDRE dans le maillage MED
    00022 C       *                 du fichier test25.med
    00023 C       *
    00024 C       ******************************************************************************
    00025         program test26
    00026 C
    00027         implicit none
    00028         include 'med.hf'
    00029 C
    00030         integer cret,fid,mdim,nmaa,npoly,i,j,k,l
    00031         integer nfaces, nnoeuds
    00032         integer ind1, ind2
    00033         character*32 maa
    00034         character*200 desc
    00035         integer n
    00036         parameter (n=2)
    00037         integer np,nf,np2,nf2,taille,tmp
    00038         parameter (np=3,nf=9,np2=3,nf2=8)
    00039         integer indexp(np),indexf(nf)
    00040         integer conn(24)
    00041         integer indexp2(np2),indexf2(nf2)
    00042         integer conn2(nf2)
    00043         character*16 nom(n)
    00044         integer num(n),fam(n)
    00045         integer type
    00046 C
    00047 C       Ouverture du fichier test25.med en lecture seule
    00048         call efouvr(fid,'test25.med',MED_LECTURE, cret)
    00049         print *,cret
    00050         if (cret .ne. 0 ) then
    00051            print *,'Erreur ouverture du fichier'
    00052            call efexit(-1)
    00053         endif
    00054         print *,'Ouverture du fichier test25.med'
    00055 C
    00056 C       Combien de maillage
    00057         call efnmaa(fid,nmaa,cret)
    00058         print *,cret
    00059         if (cret .ne. 0 ) then
    00060            print *,'Erreur lecture du nombre de maillage'
    00061            call efexit(-1)
    00062         endif
    00063         print *,'Nombre de maillages : ',nmaa
    00064 C
    00065 C       Lecture de toutes les mailles MED_POLYEDRE
    00066 C       dans chaque maillage
    00067         do 10 i=1,nmaa
    00068 C
    00069 C          Info sur chaque maillage
    00070            call efmaai(fid,i,maa,mdim,type,desc,cret)
    00071            print *,cret
    00072            if (cret .ne. 0 ) then
    00073               print *,'Erreur infos maillage'
    00074               call efexit(-1)
    00075            endif
    00076            print *,'Maillage : ',maa
    00077            print *,'Dimension : ',mdim
    00078 C
    00079 C          Combien de mailles polyedres
    00080            call efnema(fid,maa,MED_CONN,MED_MAILLE,MED_POLYEDRE,
    00081      &                       MED_NOD,npoly,cret)
    00082            print *,cret
    00083            if (cret .ne. 0 ) then
    00084               print *,'Erreur lecture nombre de polyedre'
    00085               call efexit(-1)
    00086            endif
    00087            print *,'Nombre de mailles MED_POLYEDRE : ',npoly
    00088 C
    00089 C          Taille des connectivites et du tableau d'indexation
    00090            call efpyei(fid,maa,MED_NOD,tmp,taille,cret)
    00091            print *,cret
    00092            if (cret .ne. 0 ) then
    00093               print *,'Erreur infos sur les polyedres'
    00094               call efexit(-1)
    00095            endif
    00096            print *,'Taille de la connectivite : ',taille
    00097            print *,'Taille du tableau indexf : ',tmp
    00098 C
    00099 C          Lecture de la connectivite en mode nodal
    00100            call efpecl(fid,maa,indexp,npoly+1,indexf,tmp,conn,
    00101      &                       MED_NOD,cret)
    00102            print *,cret
    00103            if (cret .ne. 0 ) then
    00104               print *,'Erreur lecture connectivites polyedres'
    00105               call efexit(-1)
    00106            endif
    00107            print *,'Lecture de la connectivite des polyedres'
    00108            print *,'Connectivite nodale'
    00109 C
    00110 C          Lecture de la connectivite en mode descendant
    00111            call efpecl(fid,maa,indexp2,npoly+1,indexf2,tmp,conn2,
    00112      &                       MED_DESC,cret)
    00113            print *,cret
    00114            if (cret .ne. 0 ) then
    00115               print *,'Erreur lecture connectivite des polyedres'
    00116               call efexit(-1)
    00117            endif
    00118            print *,'Lecture de la connectivite des polyedres'
    00119            print *,'Connectivite descendante'
    00120 C
    00121 C          Lecture des noms
    00122            call efnoml(fid,maa,nom,npoly,MED_MAILLE,MED_POLYEDRE,
    00123      &                       cret)
    00124            print *,cret
    00125            if (cret .ne. 0 ) then
    00126               print *,'Erreur lecture noms des polyedres'
    00127               call efexit(-1)
    00128            endif
    00129            print *,'Lecture des noms'
    00130 C
    00131 C          Lecture des numeros
    00132            call efnuml(fid,maa,num,npoly,MED_MAILLE,MED_POLYEDRE,
    00133      &                       cret)
    00134            print *,cret
    00135            if (cret .ne. 0 ) then
    00136               print *,'Erreur lecture des numeros des polyedres'
    00137               call efexit(-1)
    00138            endif
    00139            print *,'Lecture des numeros'
    00140 C
    00141 C          Lecture des numeros de familles
    00142            call effaml(fid,maa,fam,npoly,MED_MAILLE,MED_POLYEDRE,
    00143      &                       cret)
    00144            print *,cret
    00145            if (cret .ne. 0 ) then
    00146               print *,'Erreur lecture numeros de famille polyedres'
    00147               call efexit(-1)
    00148            endif
    00149            print *,'Lecture des numeros de famille'
    00150 C
    00151 C          Affichage des resultats
    00152            print *,'Affichage des resultats'
    00153            do 20 j=1,npoly
    00154 C
    00155               print *,'>> Maille polygone ',j
    00156               print *,'---- Connectivite nodale    ---- : '
    00157               nfaces = indexp(j+1) - indexp(j)
    00158 C             ind1 = indice dans "indexf" pour acceder aux
    00159 C             numeros des faces
    00160               ind1 = indexp(j)
    00161               do 30 k=1,nfaces
    00162 C                ind2 = indice dans "conn" pour acceder au premier noeud
    00163                  ind2 = indexf(ind1+k-1)
    00164                  nnoeuds = indexf(ind1+k) - indexf(ind1+k-1)
    00165                  print *,'   - Face ',k
    00166                  do 40 l=1,nnoeuds
    00167                     print *,'   ',conn(ind2+l-1)
    00168  40              continue
    00169  30           continue
    00170               print *,'---- Connectivite descendante ---- : '
    00171               nfaces = indexp2(j+1) - indexp2(j)
    00172 C             ind1 = indice dans "conn2" pour acceder aux faces
    00173               ind1 = indexp2(j)
    00174               do 50 k=1,nfaces
    00175                  print *,'   - Face ',k
    00176                  print *,'   => Numero : ',conn2(ind1+k-1)
    00177                  print *,'   => Type   : ',indexf2(ind1+k-1)
    00178  50           continue
    00179               print *,'---- Nom                    ---- : ',nom(j)
    00180               print *,'---- Numero                 ----:  ',num(j)
    00181               print *,'---- Numero de famille      ---- : ',fam(j)
    00182 C
    00183  20        continue
    00184 C
    00185  10     continue
    00186 C
    00187 C       Fermeture du fichier
    00188         call efferm (fid,cret)
    00189         print *,cret
    00190         if (cret .ne. 0 ) then
    00191            print *,'Erreur fermeture du fichier'
    00192            call efexit(-1)
    00193         endif
    00194         print *,'Fermeture du fichier'
    00195 C
    00196         end