C*************************************************************************
C COPYRIGHT (C) 1999 - 2003  EDF R&D
C THIS LIBRARY IS FREE SOFTWARE; YOU CAN REDISTRIBUTE IT AND/OR MODIFY
C IT UNDER THE TERMS OF THE GNU LESSER GENERAL PUBLIC LICENSE 
C AS PUBLISHED BY THE FREE SOFTWARE FOUNDATION; 
C EITHER VERSION 2.1 OF THE LICENSE, OR (AT YOUR OPTION) ANY LATER VERSION.
C
C THIS LIBRARY IS DISTRIBUTED IN THE HOPE THAT IT WILL BE USEFUL, BUT
C WITHOUT ANY WARRANTY; WITHOUT EVEN THE IMPLIED WARRANTY OF
C MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE. SEE THE GNU
C LESSER GENERAL PUBLIC LICENSE FOR MORE DETAILS.
C
C YOU SHOULD HAVE RECEIVED A COPY OF THE GNU LESSER GENERAL PUBLIC LICENSE
C ALONG WITH THIS LIBRARY; IF NOT, WRITE TO THE FREE SOFTWARE FOUNDATION,
C INC., 59 TEMPLE PLACE, SUITE 330, BOSTON, MA 02111-1307 USA
C
C**************************************************************************

C ******************************************************************************
C * - Nom du fichier : test20.f
C *
C * - Description : montage/demontage de fichiers MED. 
C *
C ******************************************************************************
      program test20
C     
      implicit none
      include 'med.hf'
C
C
      integer cret, fid, ncha, nmaa, mid, mid2
      integer i, ncomp, type
      character*16  comp(3), unit(3)
      character*32  nom
C
C     ** Ouverture du fichier test2.med en mode lecture ajout
      call efouvr(fid,'test2.med',MED_LECTURE_AJOUT, cret)
      print *,cret 
      print *,'On ouvre le fichier test2.med'
C
C     ** Lecture du nombre de champ
      if (cret .eq. 0) then
         call efncha(fid,0,ncha,cret)
         print *,cret
         print *,'Nombre de champs dans test2.med : ',ncha
      endif
C
C     ** Montage du fichier test10.med (acces aux champs)
      if (cret .eq. 0) then
         call efmont(fid,'test10.med',MED_CHAMP,mid,cret)
         print *,cret
         print *,'On monte les champs du fichier test10.med'
      endif
C
C     ** Lecture du nombre de champ apres montage
      if (cret .eq. 0) then
         call efncha(fid,0,ncha,cret)
         print *,cret
         print *,'Nombre de champs dans test2.med apres montage : ',ncha
      endif
C
C     ** Acces a tous les champs de test10.med a travers le point de 
C     ** montage
      if (cret .eq. 0) then
C
         do 10 i = 1,ncha
C
C           ** Lecture du nombre de composante dans le champ
            if (cret .eq. 0) then
               call efncha(fid,i,ncomp,cret)
               print *,cret
            endif
C
C           ** Lecture des informations sur le champ
            if (cret .eq. 0) then
               call efchai(fid,i,nom,type,comp,unit,ncomp,cret)
               print *,cret
               print *,'Champ de nom ',nom
               print *,' avec ', ncomp, ' composantes'
            endif
 10      continue
C    
      end if
C
C     ** Demontage de test10.med
      if (cret .eq. 0) then
         call efdemo(fid,mid,MED_CHAMP,cret)
         print *,cret
         print *,'On demonte le fichier test10.med'
      endif
C
C     ** Lecture du nombre de champ apres demontage
      if (cret .eq. 0) then
         call efncha(fid,0,ncha,cret)
         print *,cret
         print *,'Nombre de champs apres demontage : ',ncha
      endif
C
C     ** Fermeture du fichier
      call efferm(fid,cret)
      print *, cret
      print *,'On ferme le fichier test2.med'
C
C     ** Creation du fichier test20.med
      call efouvr(fid,'test20.med',MED_CREATION,cret)
      print *,cret
      print *,'Creation du fichier test20.med'
C
C     ** Montage du fichier test2.med (acces aux maillages)
      if (cret .eq. 0) then
         call efmont(fid,'test2.med',MED_MAILLAGE,mid,cret)
         print *,cret
         print *,'On monte le fichier test2.med'
      endif
C
C     ** Lecture du nombre de maillage apres montage
      if (cret .eq. 0) then 
         call efnmaa(fid,nmaa,cret)
         print *,cret
         print *,'Nombre de maillages apres montage : ', nmaa
      endif
C
C     ** Montage du fichier test10.med (acces aux champs)
      if (cret .eq. 0) then
         call efmont(fid,'test10.med',MED_CHAMP,mid2,cret)
         print *,cret
         print *,'On monte le fichier test10.med'
      endif
C
C     ** Lecture du nombre de champs apres montage
      if (cret .eq. 0) then
         call efncha(fid,0,ncha,cret)
         print *,cret
         print *,'Nombre de champs  apres montage : ',ncha
      endif
C
C     ** Demontage de test10.med
      if (cret .eq. 0) then
         call efdemo(fid,mid2,MED_CHAMP,cret)
         print *,cret
         print *,'On demonte test10.med'
      endif
C
C     ** Demontage de test2.med
      if (cret .eq. 0) then
         call efdemo(fid,mid,MED_MAILLAGE,cret)
         print *,cret
         print *,'On demonte test2.med'
      endif
C
C     ** Fermeture du fichier
      call efferm(fid,cret)
      print *,cret
      print *,'Fermeture du fichier test20.med'
C
      end
C
