f/2.3.6/test24.f

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 : test24.f
00020 C       *
00021 C       * - Description : lecture de mailles MED_POLYGONE dans le maillage MED
00022 C       *                 du fichier test23.med   
00023 C       *
00024 C       ******************************************************************************
00025         program test23
00026 C       
00027         implicit none
00028         include 'med.hf'
00029 C       
00030         integer cret, fid,mdim,nmaa,npoly,i,j,k,taille
00031         character*32 maa
00032         character*200 desc
00033         integer ni, n
00034         parameter (ni=4, n=3)
00035         integer index(ni),ind1,ind2
00036         character*16 nom(n)
00037         integer num(n),fam(n)
00038         integer con(16)
00039         integer type
00040 C
00041 C       Ouverture du fichier test23.med en lecture seule
00042         call efouvr(fid,'test23.med',MED_LECTURE, cret)
00043         print *,cret
00044         if (cret .ne. 0 ) then
00045            print *,'Erreur ouverture du fichier'
00046            call efexit(-1)
00047         endif      
00048         print *,'Ouverture du fichier test23.med'
00049 C
00050 C       Lecture du nombre de maillages
00051         call efnmaa(fid,nmaa,cret)
00052         print *,cret
00053         if (cret .ne. 0 ) then
00054            print *,'Erreur lecture nombre de maillage'
00055            call efexit(-1)
00056         endif      
00057         print *,'Nombre de maillages : ',nmaa
00058 C   
00059 C       Lecture de toutes les mailles MED_POLYGONE
00060 C       dans chaque maillage
00061         do 10 i=1,nmaa
00062 C
00063 C          Info sur chaque maillage
00064            call efmaai(fid,i,maa,mdim,type,desc,cret)
00065            if (cret .ne. 0 ) then
00066               print *,'Erreur lecture infos maillage'
00067               call efexit(-1)
00068            endif      
00069            print *,cret
00070            print *,'Maillage : ',maa
00071            print *,'Dimension : ',mdim
00072 C     
00073 C          Combien de mailles polygones
00074            call efnema(fid,maa,MED_CONN,MED_MAILLE,MED_POLYGONE,
00075      &                       MED_NOD,npoly,cret)
00076            print *,cret
00077            if (cret .ne. 0 ) then
00078               print *,'Erreur lecture du nombre de polygone'
00079               call efexit(-1)
00080            endif      
00081            print *,'Nombre de mailles MED_POLYGONE : ',npoly
00082 C
00083 C          Taille des connectivites
00084            call efpygi(fid,maa,MED_MAILLE,MED_NOD,taille,cret)
00085            print *,cret
00086            if (cret .ne. 0 ) then
00087               print *,'Erreur lecture infos polygones'
00088               call efexit(-1)
00089            endif      
00090            print *,'Taille de la connectivite : ',taille
00091 C
00092 C          Lecture de la connectivite
00093            call efpgcl(fid,maa,index,npoly+1,con,MED_MAILLE,
00094      &                       MED_NOD,cret)
00095            print *,cret
00096            if (cret .ne. 0 ) then
00097               print *,'Erreur lecture des connectivites polygones'
00098               call efexit(-1)
00099            endif      
00100            print *,'Lecture de la connectivite des polygones'
00101 C
00102 C          Lecture des noms
00103            call efnoml(fid,maa,nom,npoly,MED_MAILLE,MED_POLYGONE,
00104      &                       cret)
00105            print *,cret
00106            if (cret .ne. 0 ) then
00107               print *,'Erreur lecture des noms des polygones'
00108               call efexit(-1)
00109            endif      
00110            print *,'Lecture des noms'
00111 C
00112 C          Lecture des numeros
00113            call efnuml(fid,maa,num,npoly,MED_MAILLE,MED_POLYGONE,
00114      &                       cret)
00115            print *,cret
00116            if (cret .ne. 0 ) then
00117               print *,'Erreur lecture des numeros des polygones'
00118               call efexit(-1)
00119            endif      
00120            print *,'Lecture des numeros'
00121 C
00122 C          Lecture des numeros de familles
00123            call effaml(fid,maa,fam,npoly,MED_MAILLE,MED_POLYGONE,
00124      &                       cret)
00125            print *,cret
00126            if (cret .ne. 0 ) then
00127               print *,
00128 'Erreur lecture des numeros de famille des     & polygones'
00129               call efexit(-1)
00130            endif      
00131            print *,'Lecture des numeros de famille'
00132 C
00133 C          Affichage des resultats
00134            print *,'Affichage des resultats'
00135            do 20 j=1,npoly
00136 C       
00137               print *,'>> Maille polygone ',j
00138               print *,'---- Connectivite      ---- : '
00139               ind1 = index(j)
00140               ind2 = index(j+1)
00141               do 30 k=ind1,ind2-1
00142                  print *,con(k)
00143  30           continue
00144               print *,'---- Nom               ---- : ',nom(j)
00145               print *,'---- Numero            ----:  ',num(j)
00146               print *,'---- Numero de famille ---- : ',fam(j)
00147 C
00148  20        continue
00149 C
00150  10     continue
00151 C
00152 C       Fermeture du fichier
00153         call efferm (fid,cret)
00154         print *,cret
00155         if (cret .ne. 0 ) then
00156            print *,'Erreur fermeture du fichier'
00157            call efexit(-1)
00158         endif      
00159         print *,'Fermeture du fichier'
00160 C
00161         end

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