     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 : test1.f
    21 C *
    22 C * - Description : exemples d'ouverture/fermeture de fichiers MED
    23 C *
    24 C *****************************************************************************
    25       program test1
    26 C
    27       implicit none
    28       include 'med.hf'
    29 C
    30 C
    31       integer cret
    32       integer fid
    33       character*200 des
    34       parameter (des = "Ceci est un courte description"
    35      1     // " du fichier test1.med")
    36
    37 C     Creation du fichier "test1.med"
    38       call efouvr(fid,'test1.med',MED_LECTURE_ECRITURE, cret)
    39       print *,cret
    40       if (cret .ne. 0 ) then
    41          print *,'Erreur à la création du fichier'
    42          call efexit(-1)
    43       endif
    44
    45 C     Ecriture d'un en-tete dans le fichier
    46       call effide (fid,des,cret)
    47       print *,cret
    48       if (cret .ne. 0 ) then
    49          print *,'Erreur à ecriture en-tete'
    50          call efexit(-1)
    51       endif
    52
    53 C     Fermeture du fichier
    54       call efferm (fid,cret)
    55       print *,cret
    56       if (cret .ne. 0 ) then
    57          print *,'Erreur à la fermeture du fichier'
    58          call efexit(-1)
    59       endif
    60
    61 C     Re-ouverture du fichier en lecture seule
    62       call efouvr(fid,'test1.med',MED_LECTURE, cret)
    63       print *,cret
    64       if (cret .ne. 0 ) then
    65          print *,'Erreur ouverture du fichier en lecture'
    66          call efexit(-1)
    67       endif
    68
    69 C     Fermeture du fichier
    70       call efferm (fid,cret)
    71       print *,cret
    72       if (cret .ne. 0 ) then
    73          print *,'Erreur à la fermeture du fichier'
    74          call efexit(-1)
    75       endif
    76
    77       end