      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