f/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         integer edim,nstep,stype,atype, chgt, tsf
00032         character*64 maa
00033         character*200 desc
00034         integer ni, n, isize;
00035         parameter (ni=4, n=3)
00036         integer index(ni),ind1,ind2
00037         character*16 nom(n)
00038         integer num(n),fam(n)
00039         integer con(16)
00040         integer type
00041         character*16 nomcoo(2)
00042         character*16 unicoo(2)
00043         character(16)  :: dtunit
00044 C
00045 C       Ouverture du fichier test23.med en lecture seule
00046         call mfiope(fid,'test23.med',MED_ACC_RDONLY, cret)
00047         print *,cret
00048         if (cret .ne. 0 ) then
00049            print *,'Erreur ouverture du fichier'
00050            call efexit(-1)
00051         endif      
00052         print *,'Ouverture du fichier test23.med'
00053 C
00054 C       Lecture du nombre de maillages
00055         call mmhnmh(fid,nmaa,cret)
00056         print *,cret
00057         if (cret .ne. 0 ) then
00058            print *,'Erreur lecture nombre de maillage'
00059            call efexit(-1)
00060         endif      
00061         print *,'Nombre de maillages : ',nmaa
00062 C   
00063 C       Lecture de toutes les mailles MED_POLYGONE
00064 C       dans chaque maillage
00065         do 10 i=1,nmaa
00066 C
00067 C          Info sur chaque maillage
00068            call mmhmii(fid,i,maa,edim,mdim,type,desc,
00069      &                 dtunit,stype,nstep,atype,
00070      &                 nomcoo,unicoo,cret)
00071            if (cret .ne. 0 ) then
00072               print *,'Erreur lecture infos maillage'
00073               call efexit(-1)
00074            endif      
00075            print *,cret
00076            print *,'Maillage : ',maa
00077            print *,'Dimension : ',mdim
00078 C     
00079 C          Combien de mailles polygones
00080            call mmhnme(fid,maa,MED_NO_DT,MED_NO_IT,MED_CELL,MED_POLYGON,
00081      &                 MED_INDEX_NODE,MED_NODAL,chgt,tsf,isize,cret) 
00082            npoly = isize - 1;
00083            print *,cret
00084            if (cret .ne. 0 ) then
00085               print *,'Erreur lecture du nombre de polygone'
00086               call efexit(-1)
00087            endif      
00088            print *,'Nombre de mailles MED_POLYGONE : ',npoly
00089 C
00090 C          Taille des connectivites
00091            call mmhnme(fid,maa,MED_NO_DT,MED_NO_IT,MED_CELL,MED_POLYGON,
00092      &                 MED_CONNECTIVITY,MED_NODAL,chgt,tsf,taille,cret)   
00093            print *,cret
00094            if (cret .ne. 0 ) then
00095               print *,'Erreur lecture infos polygones'
00096               call efexit(-1)
00097            endif      
00098            print *,'Taille de la connectivite : ',taille
00099 C
00100 C          Lecture de la connectivite
00101            call mmhpgr(fid,maa,MED_NO_DT,MED_NO_IT,MED_CELL,
00102      &                 MED_NODAL,index,con,cret)
00103            print *,cret
00104            if (cret .ne. 0 ) then
00105               print *,'Erreur lecture des connectivites polygones'
00106               call efexit(-1)
00107            endif      
00108            print *,'Lecture de la connectivite des polygones'
00109 C
00110 C          Lecture des noms
00111            call mmhear(fid,maa,MED_NO_DT,MED_NO_IT,
00112      &                 MED_CELL,MED_POLYGON,nom,cret)
00113            print *,cret
00114            if (cret .ne. 0 ) then
00115               print *,'Erreur lecture des noms des polygones'
00116               call efexit(-1)
00117            endif      
00118            print *,'Lecture des noms'
00119 C
00120 C          Lecture des numeros
00121            call mmhfnr(fid,maa,MED_NO_DT,MED_NO_IT,MED_CELL,MED_POLYGON,
00122      &                 num,cret)
00123            print *,cret
00124            if (cret .ne. 0 ) then
00125               print *,'Erreur lecture des numeros des polygones'
00126               call efexit(-1)
00127            endif      
00128            print *,'Lecture des numeros'
00129 C
00130 C          Lecture des numeros de familles
00131            call mmhfnr(fid,maa,MED_NO_DT,MED_NO_IT,MED_CELL,MED_POLYGON,
00132      &                 fam,cret)
00133            print *,cret
00134            if (cret .ne. 0 ) then
00135               print *,
00136 'Erreur lecture des numeros de famille des     & polygones'
00137               call efexit(-1)
00138            endif      
00139            print *,'Lecture des numeros de famille'
00140 C
00141 C          Affichage des resultats
00142            print *,'Affichage des resultats'
00143            do 20 j=1,npoly
00144 C       
00145               print *,'>> Maille polygone ',j
00146               print *,'---- Connectivite      ---- : '
00147               ind1 = index(j)
00148               ind2 = index(j+1)
00149               do 30 k=ind1,ind2-1
00150                  print *,con(k)
00151  30           continue
00152 c             print *,'---- Nom               ---- : ',nom(j)
00153               print *,'---- Numero            ----:  ',num(j)
00154               print *,'---- Numero de famille ---- : ',fam(j)
00155 C
00156  20        continue
00157 C
00158  10     continue
00159 C
00160 C       Fermeture du fichier
00161         call mficlo(fid,cret)
00162         print *,cret
00163         if (cret .ne. 0 ) then
00164            print *,'Erreur fermeture du fichier'
00165            call efexit(-1)
00166         endif      
00167         print *,'Fermeture du fichier'
00168 C
00169         end

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