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,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

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