1  C*************************************************************************
  2  C COPYRIGHT (C) 1999 - 2003  EDF R&D
  3  C THIS LIBRARY IS FREE SOFTWARE; YOU CAN REDISTRIBUTE IT AND/OR MODIFY
  4  C IT UNDER THE TERMS OF THE GNU LESSER GENERAL PUBLIC LICENSE 
  5  C AS PUBLISHED BY THE FREE SOFTWARE FOUNDATION; 
  6  C EITHER VERSION 2.1 OF THE LICENSE, OR (AT YOUR OPTION) ANY LATER VERSION.
  7  C
  8  C THIS LIBRARY IS DISTRIBUTED IN THE HOPE THAT IT WILL BE USEFUL, BUT
  9  C WITHOUT ANY WARRANTY; WITHOUT EVEN THE IMPLIED WARRANTY OF
 10  C MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE. SEE THE GNU
 11  C LESSER GENERAL PUBLIC LICENSE FOR MORE DETAILS.
 12  C
 13  C YOU SHOULD HAVE RECEIVED A COPY OF THE GNU LESSER GENERAL PUBLIC LICENSE
 14  C ALONG WITH THIS LIBRARY; IF NOT, WRITE TO THE FREE SOFTWARE FOUNDATION,
 15  C INC., 59 TEMPLE PLACE, SUITE 330, BOSTON, MA 02111-1307 USA
 16  C
 17  C**************************************************************************
 18
 19  C ******************************************************************************
 20  C * - Nom du fichier : test20.f
 21  C *
 22  C * - Description : montage/demontage de fichiers MED. 
 23  C *
 24  C ******************************************************************************
 25        program test20
 26  C     
 27        implicit none
 28        include 'med.hf'
 29  C
 30  C
 31        integer cret, fid, ncha, nmaa, mid, mid2
 32        integer i, ncomp, type
 33        character*16  comp(3), unit(3)
 34        character*32  nom
 35  C
 36  C     ** Ouverture du fichier test2.med en mode lecture ajout
 37        call efouvr(fid,'test2.med',MED_LECTURE_AJOUT, cret)
 38        print *,cret
 39        print *,'On ouvre le fichier test2.med'
 40  C
 41  C     ** Lecture du nombre de champ
 42        if (cret .eq. 0) then
 43           call efncha(fid,0,ncha,cret)
 44           print *,cret
 45           print *,'Nombre de champs dans test2.med : ',ncha
 46        endif
 47  C
 48  C     ** Montage du fichier test10.med (acces aux champs)
 49        if (cret .eq. 0) then
 50           call efmont(fid,'test10.med',MED_CHAMP,mid,cret)
 51           print *,cret
 52           print *,'On monte les champs du fichier test10.med'
 53        endif
 54  C
 55  C     ** Lecture du nombre de champ apres montage
 56        if (cret .eq. 0) then
 57           call efncha(fid,0,ncha,cret)
 58           print *,cret
 59           print *,'Nombre de champs dans test2.med apres montage : ',ncha
 60        endif
 61  C
 62  C     ** Acces a tous les champs de test10.med a travers le point de 
 63  C     ** montage
 64        if (cret .eq. 0) then
 65  C
 66           do 10 i = 1,ncha
 67  C
 68  C           ** Lecture du nombre de composante dans le champ
 69              if (cret .eq. 0) then
 70                 call efncha(fid,i,ncomp,cret)
 71                 print *,cret
 72              endif
 73  C
 74  C           ** Lecture des informations sur le champ
 75              if (cret .eq. 0) then
 76                 call efchai(fid,i,nom,type,comp,unit,ncomp,cret)
 77                 print *,cret
 78                 print *,'Champ de nom ',nom
 79                 print *,' avec ', ncomp, ' composantes'
 80              endif
 81   10      continue
 82  C    
 83        end if
 84  C
 85  C     ** Demontage de test10.med
 86        if (cret .eq. 0) then
 87           call efdemo(fid,mid,MED_CHAMP,cret)
 88           print *,cret
 89           print *,'On demonte le fichier test10.med'
 90        endif
 91  C
 92  C     ** Lecture du nombre de champ apres demontage
 93        if (cret .eq. 0) then
 94           call efncha(fid,0,ncha,cret)
 95           print *,cret
 96           print *,'Nombre de champs apres demontage : ',ncha
 97        endif
 98  C
 99  C     ** Fermeture du fichier
100        call efferm(fid,cret)
101        print *, cret
102        print *,'On ferme le fichier test2.med'
103  C
104  C     ** Creation du fichier test20.med
105        call efouvr(fid,'test20.med',MED_CREATION,cret)
106        print *,cret
107        print *,'Creation du fichier test20.med'
108  C
109  C     ** Montage du fichier test2.med (acces aux maillages)
110        if (cret .eq. 0) then
111           call efmont(fid,'test2.med',MED_MAILLAGE,mid,cret)
112           print *,cret
113           print *,'On monte le fichier test2.med'
114        endif
115  C
116  C     ** Lecture du nombre de maillage apres montage
117        if (cret .eq. 0) then
118           call efnmaa(fid,nmaa,cret)
119           print *,cret
120           print *,'Nombre de maillages apres montage : ', nmaa
121        endif
122  C
123  C     ** Montage du fichier test10.med (acces aux champs)
124        if (cret .eq. 0) then
125           call efmont(fid,'test10.med',MED_CHAMP,mid2,cret)
126           print *,cret
127           print *,'On monte le fichier test10.med'
128        endif
129  C
130  C     ** Lecture du nombre de champs apres montage
131        if (cret .eq. 0) then
132           call efncha(fid,0,ncha,cret)
133           print *,cret
134           print *,'Nombre de champs  apres montage : ',ncha
135        endif
136  C
137  C     ** Demontage de test10.med
138        if (cret .eq. 0) then
139           call efdemo(fid,mid2,MED_CHAMP,cret)
140           print *,cret
141           print *,'On demonte test10.med'
142        endif
143  C
144  C     ** Demontage de test2.med
145        if (cret .eq. 0) then
146           call efdemo(fid,mid,MED_MAILLAGE,cret)
147           print *,cret
148           print *,'On demonte test2.med'
149        endif
150  C
151  C     ** Fermeture du fichier
152        call efferm(fid,cret)
153        print *,cret
154        print *,'Fermeture du fichier test20.med'
155  C
156        end
157  C