      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