# f/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,nfindex
    00031         integer edim,nstep,stype,atype, chgt, tsf
    00032         integer nfaces, nnoeuds
    00033         integer ind1, ind2
    00034         character*64 maa
    00035         character*200 desc
    00036         integer n
    00037         parameter (n=2)
    00038         integer np,nf,np2,nf2,taille,tmp
    00039         parameter (np=3,nf=9,np2=3,nf2=8)
    00040         integer indexp(np),indexf(nf)
    00041         integer conn(24)
    00042         integer indexp2(np2),indexf2(nf2)
    00043         integer conn2(nf2)
    00044         character*16 nom(n)
    00045         integer num(n),fam(n)
    00046         integer type
    00047         character*16 nomcoo(3)
    00048         character*16 unicoo(3)
    00049         character(16)  :: dtunit
    00050 C
    00051 C       Ouverture du fichier test25.med en lecture seule
    00052         call mfiope(fid,'test25.med',MED_ACC_RDONLY, cret)
    00053         print *,cret
    00054         if (cret .ne. 0 ) then
    00055            print *,'Erreur ouverture du fichier'
    00056            call efexit(-1)
    00057         endif
    00058         print *,'Ouverture du fichier test25.med'
    00059 C
    00060 C       Combien de maillage
    00061         call mmhnmh(fid,nmaa,cret)
    00062         print *,cret
    00063         if (cret .ne. 0 ) then
    00064            print *,'Erreur lecture du nombre de maillage'
    00065            call efexit(-1)
    00066         endif
    00067         print *,'Nombre de maillages : ',nmaa
    00068 C
    00069 C       Lecture de toutes les mailles MED_POLYEDRE
    00070 C       dans chaque maillage
    00071         do 10 i=1,nmaa
    00072 C
    00073 C          Info sur chaque maillage
    00074            call mmhmii(fid,i,maa,edim,mdim,type,desc,
    00075      &                 dtunit,stype,nstep,atype,
    00076      &                 nomcoo,unicoo,cret)
    00077            print *,cret
    00078            if (cret .ne. 0 ) then
    00079               print *,'Erreur infos maillage'
    00080               call efexit(-1)
    00081            endif
    00082            print *,'Maillage : ',maa
    00083            print *,'Dimension : ',mdim
    00084 C
    00085 C          Combien de mailles polyedres a partir de la taille du tableau
    00086 C          d'indexation des faces en connectivite nodale
    00087            call mmhnme(fid,maa,MED_NO_DT,MED_NO_IT,
    00088      &                 MED_CELL,MED_POLYHEDRON,MED_INDEX_FACE,MED_NODAL,
    00089      &                 chgt,tsf,nfindex,cret)
    00090            npoly = nfindex - 1
    00091            print *,cret
    00092            if (cret .ne. 0 ) then
    00093               print *,'Erreur lecture nombre de polyedre'
    00094               call efexit(-1)
    00095            endif
    00096            print *,'Nombre de mailles MED_POLYEDRE : ',npoly
    00097 C
    00098 C          Taille des connectivites et du tableau d'indexation des faces
    00099 C          en connectivite nodale
    00100            call mmhnme(fid,maa,MED_NO_DT,MED_NO_IT,
    00101      &                 MED_CELL,MED_POLYHEDRON,
    00102      &                 MED_INDEX_NODE,MED_NODAL,
    00103      &                 chgt,tsf,taille,cret)
    00104            print *,cret
    00105            if (cret .ne. 0 ) then
    00106               print *,'Erreur infos sur les polyedres'
    00107               call efexit(-1)
    00108            endif
    00109            print *,'Taille de la connectivite : ',taille
    00110            print *,'Taille du tableau indexf : ', nfindex
    00111 C
    00112 C          Lecture de la connectivite en mode nodal
    00113            call mmhphr(fid,maa,MED_NO_DT,MED_NO_IT,MED_CELL,
    00114      &                 MED_NODAL,indexp,indexf,conn,cret)
    00115            print *,cret
    00116            if (cret .ne. 0 ) then
    00117               print *,'Erreur lecture connectivites polyedres'
    00118               call efexit(-1)
    00119            endif
    00120            print *,'Lecture de la connectivite des polyedres'
    00121            print *,'Connectivite nodale'
    00122 C
    00123 C          Lecture de la connectivite en mode descendant
    00124            call mmhphr(fid,maa,MED_NO_DT,MED_NO_IT,MED_CELL,
    00125      &                 MED_DESCENDING,indexp2,indexf2,conn2,cret)
    00126            print *,cret
    00127            if (cret .ne. 0 ) then
    00128               print *,'Erreur lecture connectivite des polyedres'
    00129               call efexit(-1)
    00130            endif
    00131            print *,'Lecture de la connectivite des polyedres'
    00132            print *,'Connectivite descendante'
    00133 C
    00134 C          Lecture des noms
    00135            call mmhear(fid,maa,MED_NO_DT,MED_NO_IT,
    00136      &                 MED_CELL,MED_POLYHEDRON,nom,cret)
    00137            print *,cret
    00138            if (cret .ne. 0 ) then
    00139               print *,'Erreur lecture noms des polyedres'
    00140               call efexit(-1)
    00141            endif
    00142            print *,'Lecture des noms'
    00143 C
    00144 C          Lecture des numeros
    00145            call mmhfnr(fid,maa,MED_NO_DT,MED_NO_IT,MED_CELL,
    00146      &                 MED_POLYHEDRON,num,cret)
    00147            print *,cret
    00148            if (cret .ne. 0 ) then
    00149               print *,'Erreur lecture des numeros des polyedres'
    00150               call efexit(-1)
    00151            endif
    00152            print *,'Lecture des numeros'
    00153 C
    00154 C          Lecture des numeros de familles
    00155            call mmhfnr(fid,maa,MED_NO_DT,MED_NO_IT,MED_CELL,
    00156      &                 MED_POLYHEDRON,fam,cret)
    00157            print *,cret
    00158            if (cret .ne. 0 ) then
    00159               print *,'Erreur lecture numeros de famille polyedres'
    00160               call efexit(-1)
    00161            endif
    00162            print *,'Lecture des numeros de famille'
    00163 C
    00164 C          Affichage des resultats
    00165            print *,'Affichage des resultats'
    00166            do 20 j=1,npoly
    00167 C
    00168               print *,'>> Maille polyhedre ',j
    00169               print *,'---- Connectivite nodale    ---- : '
    00170               nfaces = indexp(j+1) - indexp(j)
    00171 C             ind1 = indice dans "indexf" pour acceder aux
    00172 C             numeros des faces
    00173               ind1 = indexp(j)
    00174               do 30 k=1,nfaces
    00175 C                ind2 = indice dans "conn" pour acceder au premier noeud
    00176                  ind2 = indexf(ind1+k-1)
    00177                  nnoeuds = indexf(ind1+k) - indexf(ind1+k-1)
    00178                  print *,'   - Face ',k
    00179                  do 40 l=1,nnoeuds
    00180                     print *,'   ',conn(ind2+l-1)
    00181  40              continue
    00182  30           continue
    00183               print *,'---- Connectivite descendante ---- : '
    00184               nfaces = indexp2(j+1) - indexp2(j)
    00185 C             ind1 = indice dans "conn2" pour acceder aux faces
    00186               ind1 = indexp2(j)
    00187               do 50 k=1,nfaces
    00188                  print *,'   - Face ',k
    00189                  print *,'   => Numero : ',conn2(ind1+k-1)
    00190                  print *,'   => Type   : ',indexf2(ind1+k-1)
    00191  50           continue
    00192               print *,'---- Nom                    ---- : ',nom(j)
    00193               print *,'---- Numero                 ----:  ',num(j)
    00194               print *,'---- Numero de famille      ---- : ',fam(j)
    00195 C
    00196  20        continue
    00197 C
    00198  10     continue
    00199 C
    00200 C       Fermeture du fichier
    00201         call mficlo(fid,cret)
    00202         print *,cret
    00203         if (cret .ne. 0 ) then
    00204            print *,'Erreur fermeture du fichier'
    00205            call efexit(-1)
    00206         endif
    00207         print *,'Fermeture du fichier'
    00208 C
    00209         end