1 C*************************************************************************
  2 C COPYRIGHT (C) 1999 - 2007  EDF R&D, CEA/DEN
  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       if (cret .ne. 0 ) then
 40          print *,'Erreur ouverture du fichier'
 41          call efexit(-1)
 42       endif
 43       print *,'On ouvre le fichier test2.med'
 44 C
 45 C     ** Lecture du nombre de champ
 46       call efncha(fid,0,ncha,cret)
 47       print *,cret
 48       if (cret .ne. 0 ) then
 49          print *,'Erreur lecture du nombre de champ'
 50          call efexit(-1)
 51       endif
 52       print *,'Nombre de champs dans test2.med : ',ncha
 53 C
 54 C     ** Montage du fichier test10.med (acces aux champs)
 55       call efmont(fid,'test10.med',MED_CHAMP,mid,cret)
 56       print *,cret
 57       if (cret .ne. 0 ) then
 58          print *,'Erreur montage du fichier'
 59          call efexit(-1)
 60       endif
 61       print *,'On monte les champs du fichier test10.med'
 62 C
 63 C     ** Lecture du nombre de champ apres montage
 64       call efncha(fid,0,ncha,cret)
 65       print *,cret
 66       if (cret .ne. 0 ) then
 67          print *,'Erreur lecture du nombre de champ'
 68          call efexit(-1)
 69       endif
 70       print *,'Nombre de champs dans test2.med apres montage : ',ncha
 71 C
 72 C     ** Acces a tous les champs de test10.med a travers le point de 
 73 C     ** montage
 74 C
 75       do 10 i = 1,ncha
 76 C
 77 C        ** Lecture du nombre de composante dans le champ
 78          call efncha(fid,i,ncomp,cret)
 79          print *,cret
 80          if (cret .ne. 0 ) then
 81             print *,'Erreur lecture du nombre de composante'
 82             call efexit(-1)
 83          endif
 84 C
 85 C           ** Lecture des informations sur le champ
 86          call efchai(fid,i,nom,type,comp,unit,ncomp,cret)
 87          print *,cret
 88          if (cret .ne. 0 ) then
 89             print *,'Erreur lecture des infos sur le champ'
 90             call efexit(-1)
 91          endif
 92          print *,'Champ de nom ',nom
 93          print *,' avec ', ncomp, ' composantes'
 94 C
 95  10   continue
 96 C    
 97 C
 98 C     ** Demontage de test10.med
 99       call efdemo(fid,mid,MED_CHAMP,cret)
100       print *,cret
101       if (cret .ne. 0 ) then
102          print *,'Erreur demontage du fichier'
103          call efexit(-1)
104       endif
105       print *,'On demonte le fichier test10.med'
106 C
107 C     ** Lecture du nombre de champ apres demontage
108       call efncha(fid,0,ncha,cret)
109       print *,cret
110       if (cret .ne. 0 ) then
111          print *,'Erreur lecture du nombre de champ'
112          call efexit(-1)
113       endif
114       print *,'Nombre de champs apres demontage : ',ncha
115 C
116 C     ** Fermeture du fichier
117       call efferm(fid,cret)
118       print *, cret
119       if (cret .ne. 0 ) then
120          print *,'Erreur fermeture du fichier'
121          call efexit(-1)
122       endif
123       print *,'On ferme le fichier test2.med'
124 C
125 C     ** Creation du fichier test20.med
126       call efouvr(fid,'test20.med',MED_LECTURE_ECRITURE,cret)
127       print *,cret
128       if (cret .ne. 0 ) then
129          print *,'Erreur creation du fichier'
130          call efexit(-1)
131       endif
132       print *,'Creation du fichier test20.med'
133 C
134 C     ** Montage du fichier test2.med (acces aux maillages)
135       call efmont(fid,'test2.med',MED_MAILLAGE,mid,cret)
136       print *,cret
137       if (cret .ne. 0 ) then
138          print *,'Erreur montage du fichier'
139          call efexit(-1)
140       endif
141       print *,'On monte le fichier test2.med'
142 C
143 C     ** Lecture du nombre de maillage apres montage
144       call efnmaa(fid,nmaa,cret)
145       print *,cret
146       if (cret .ne. 0 ) then
147          print *,'Erreur lecture du nombre de maillage'
148          call efexit(-1)
149       endif
150       print *,'Nombre de maillage apres montage : ', nmaa
151 C
152 C     ** Montage du fichier test10.med (acces aux champs)
153       call efmont(fid,'test10.med',MED_CHAMP,mid2,cret)
154       print *,cret
155       if (cret .ne. 0 ) then
156          print *,'Erreur montage du fichier'
157          call efexit(-1)
158       endif
159       print *,'On monte le fichier test10.med'
160 C
161 C     ** Lecture du nombre de champs apres montage
162       call efncha(fid,0,ncha,cret)
163       print *,cret
164       if (cret .ne. 0 ) then
165          print *,'Erreur lecture du nombre de champ'
166          call efexit(-1)
167       endif
168       print *,'Nombre de champ  apres montage : ',ncha
169 C
170 C     ** Demontage de test10.med
171       call efdemo(fid,mid2,MED_CHAMP,cret)
172       print *,cret
173       if (cret .ne. 0 ) then
174          print *,'Erreur demontage du fichier'
175          call efexit(-1)
176       endif
177       print *,'On demonte test10.med'
178 C
179 C     ** Demontage de test2.med
180       call efdemo(fid,mid,MED_MAILLAGE,cret)
181       print *,cret
182       if (cret .ne. 0 ) then
183          print *,'Erreur demontage du fichier'
184          call efexit(-1)
185       endif
186       print *,'On demonte test2.med'
187 C
188 C     ** Fermeture du fichier
189       call efferm(fid,cret)
190       print *,cret
191       if (cret .ne. 0 ) then
192          print *,'Erreur fermeture du fichier'
193          call efexit(-1)
194       endif
195       print *,'Fermeture du fichier test20.med'
196 C
197       end
198 C