# f/2.3.6/test20.f

    00001 C*  This file is part of MED.
    00002 C*
    00003 C*  COPYRIGHT (C) 1999 - 2012  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