f/2.3.6/test20.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 : test20.f
00020 C *
00021 C * - Description : montage/demontage de fichiers MED. 
00022 C *
00023 C ******************************************************************************
00024       program test20
00025 C     
00026       implicit none
00027       include 'med.hf'
00028 C
00029 C
00030       integer cret, fid, ncha, nmaa, mid, mid2
00031       integer i, ncomp, type
00032       character*16  comp(3), unit(3)
00033       character*32  nom
00034 C
00035 C     ** Ouverture du fichier test2.med en mode lecture ajout
00036       call efouvr(fid,'test2.med',MED_LECTURE_AJOUT, cret)
00037       print *,cret 
00038       if (cret .ne. 0 ) then
00039          print *,'Erreur ouverture du fichier'
00040          call efexit(-1)
00041       endif      
00042       print *,'On ouvre le fichier test2.med'
00043 C
00044 C     ** Lecture du nombre de champ
00045       call efncha(fid,0,ncha,cret)
00046       print *,cret
00047       if (cret .ne. 0 ) then
00048          print *,'Erreur lecture du nombre de champ'
00049          call efexit(-1)
00050       endif      
00051       print *,'Nombre de champs dans test2.med : ',ncha
00052 C
00053 C     ** Montage du fichier test10.med (acces aux champs)
00054       call efmont(fid,'test10.med',MED_CHAMP,mid,cret)
00055       print *,cret
00056       if (cret .ne. 0 ) then
00057          print *,'Erreur montage du fichier'
00058          call efexit(-1)
00059       endif      
00060       print *,'On monte les champs du fichier test10.med'
00061 C
00062 C     ** Lecture du nombre de champ apres montage
00063       call efncha(fid,0,ncha,cret)
00064       print *,cret
00065       if (cret .ne. 0 ) then
00066          print *,'Erreur lecture du nombre de champ'
00067          call efexit(-1)
00068       endif      
00069       print *,'Nombre de champs dans test2.med apres montage : ',ncha
00070 C
00071 C     ** Acces a tous les champs de test10.med a travers le point de 
00072 C     ** montage
00073 C
00074       do 10 i = 1,ncha
00075 C
00076 C        ** Lecture du nombre de composante dans le champ
00077          call efncha(fid,i,ncomp,cret)
00078          print *,cret
00079          if (cret .ne. 0 ) then
00080             print *,'Erreur lecture du nombre de composante'
00081             call efexit(-1)
00082          endif      
00083 C
00084 C           ** Lecture des informations sur le champ
00085          call efchai(fid,i,nom,type,comp,unit,ncomp,cret)
00086          print *,cret
00087          if (cret .ne. 0 ) then
00088             print *,'Erreur lecture des infos sur le champ'
00089             call efexit(-1)
00090          endif      
00091          print *,'Champ de nom ',nom
00092          print *,' avec ', ncomp, ' composantes'
00093 C
00094  10   continue
00095 C    
00096 C
00097 C     ** Demontage de test10.med
00098       call efdemo(fid,mid,MED_CHAMP,cret)
00099       print *,cret
00100       if (cret .ne. 0 ) then
00101          print *,'Erreur demontage du fichier'
00102          call efexit(-1)
00103       endif      
00104       print *,'On demonte le fichier test10.med'
00105 C
00106 C     ** Lecture du nombre de champ apres demontage
00107       call efncha(fid,0,ncha,cret)
00108       print *,cret
00109       if (cret .ne. 0 ) then
00110          print *,'Erreur lecture du nombre de champ'
00111          call efexit(-1)
00112       endif      
00113       print *,'Nombre de champs apres demontage : ',ncha
00114 C
00115 C     ** Fermeture du fichier
00116       call efferm(fid,cret)
00117       print *, cret
00118       if (cret .ne. 0 ) then
00119          print *,'Erreur fermeture du fichier'
00120          call efexit(-1)
00121       endif      
00122       print *,'On ferme le fichier test2.med'
00123 C
00124 C     ** Creation du fichier test20.med
00125       call efouvr(fid,'test20.med',MED_LECTURE_ECRITURE,cret)
00126       print *,cret
00127       if (cret .ne. 0 ) then
00128          print *,'Erreur creation du fichier'
00129          call efexit(-1)
00130       endif      
00131       print *,'Creation du fichier test20.med'
00132 C
00133 C     ** Montage du fichier test2.med (acces aux maillages)
00134       call efmont(fid,'test2.med',MED_MAILLAGE,mid,cret)
00135       print *,cret
00136       if (cret .ne. 0 ) then
00137          print *,'Erreur montage du fichier'
00138          call efexit(-1)
00139       endif      
00140       print *,'On monte le fichier test2.med'
00141 C
00142 C     ** Lecture du nombre de maillage apres montage
00143       call efnmaa(fid,nmaa,cret)
00144       print *,cret
00145       if (cret .ne. 0 ) then
00146          print *,'Erreur lecture du nombre de maillage'
00147          call efexit(-1)
00148       endif      
00149       print *,'Nombre de maillage apres montage : ', nmaa
00150 C
00151 C     ** Montage du fichier test10.med (acces aux champs)
00152       call efmont(fid,'test10.med',MED_CHAMP,mid2,cret)
00153       print *,cret
00154       if (cret .ne. 0 ) then
00155          print *,'Erreur montage du fichier'
00156          call efexit(-1)
00157       endif      
00158       print *,'On monte le fichier test10.med'
00159 C
00160 C     ** Lecture du nombre de champs apres montage
00161       call efncha(fid,0,ncha,cret)
00162       print *,cret
00163       if (cret .ne. 0 ) then
00164          print *,'Erreur lecture du nombre de champ'
00165          call efexit(-1)
00166       endif      
00167       print *,'Nombre de champ  apres montage : ',ncha
00168 C
00169 C     ** Demontage de test10.med
00170       call efdemo(fid,mid2,MED_CHAMP,cret)
00171       print *,cret
00172       if (cret .ne. 0 ) then
00173          print *,'Erreur demontage du fichier'
00174          call efexit(-1)
00175       endif      
00176       print *,'On demonte test10.med'
00177 C
00178 C     ** Demontage de test2.med
00179       call efdemo(fid,mid,MED_MAILLAGE,cret)
00180       print *,cret
00181       if (cret .ne. 0 ) then
00182          print *,'Erreur demontage du fichier'
00183          call efexit(-1)
00184       endif      
00185       print *,'On demonte test2.med'
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 test20.med'
00195 C
00196       end
00197 C

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