2.3.6/test26.f

Aller à la documentation de ce fichier.
00001 C*  This file is part of MED.
00002 C*
00003 C*  COPYRIGHT (C) 1999 - 2015  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

Généré le Thu Oct 8 14:26:17 2015 pour MED fichier par  doxygen 1.6.1