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