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 : test21.f
 21 C*
 22 C* - Description : ecriture de valeurs scalaires numeriques dans un fichier MED
 23 C*
 24 C ******************************************************************************
 25       program test21
 26 C     
 27       implicit none
 28       include 'med.hf'
 29 C
 30       integer cret, fid
 31       character*16 edtuni,dtunit1
 32       character*32 nom1, nom2
 33       character*200 desc1, desc2
 34       integer vali1, vali2
 35       real*8 valr1,dt
 36 C
 37       parameter (nom1="VariableEntiere")
 38       parameter (nom2="VariableFlottante")
 39       data desc1 / "Une premiere description" /
 40       data desc2 / "Une seconde description" /
 41       parameter (vali1 = 56,vali2 = -789)
 42       parameter (valr1 = 67.98D0)
 43 
 44       parameter (edtuni="                "
 45      1         ,dtunit1="ms")
 46 C
 47 C     
 48 C     Creation du fichier test21.med
 49 C
 50       call efouvr(fid,'test21.med',MED_LECTURE_ECRITURE,cret)
 51       print *,cret
 52       if (cret .ne. 0 ) then
 53          print *,'Erreur creation du fichier'
 54          call efexit(-1)
 55       endif
 56       print *,'Creation du fichier test21.med'
 57 C
 58 C     Creation d'une variable scalaire entiere 
 59 C
 60       call efscac(fid,nom1,MED_INT,desc1,cret)
 61       print *,cret
 62       if (cret .ne. 0 ) then
 63          print *,'Erreur creation variable scalaire'
 64          call efexit(-1)
 65       endif
 66       print *,'Creation d une variable scalaire entiere'
 67 C
 68 C     Ecriture d'une valeur sans pas de temps ni numero d'ordre
 69 C
 70       dt =0.0D0
 71       call efscee(fid,nom1,vali1,MED_NOPDT,edtuni,dt,MED_NONOR,cret)
 72       print *,cret
 73       if (cret .ne. 0 ) then
 74          print *,'Erreur ecriture valeur scalaire'
 75          call efexit(-1)
 76       endif
 77       print *,'Ecriture valeur entiere sans pas de temps'
 78 C
 79 C     Ecriture d'une valeur avec pas de temps et sans numero d'ordre
 80 C
 81       dt = 5.5D0
 82       call efscee(fid,nom1,vali2,1,dtunit1,dt,MED_NONOR,cret)
 83       print *,cret
 84       if (cret .ne. 0 ) then
 85          print *,'Erreur ecriture valeur scalaire'
 86          call efexit(-1)
 87       endif
 88       print *,'Ecriture valeur entiere avec pas de temps'
 89 C
 90 C     Creation d'une variable scalaire flottante
 91 C
 92       call efscac(fid,nom2,MED_FLOAT64,desc2,cret)
 93       print *,cret
 94       if (cret .ne. 0 ) then
 95          print *,'Erreur creation variable sclaire'
 96          call efexit(-1)
 97       endif
 98       print *,'Creation d une variable scalaire flottante'
 99 C
100 C     Ecriture d'une valeur flottante avec pas de temps et numero d'ordre
101 C
102       call efscfe(fid,nom2,valr1,1,dtunit1,dt,2,cret)
103       print *,cret
104       if (cret .ne. 0 ) then
105          print *,'Erreur ecriture valeur scalaire'
106          call efexit(-1)
107       endif
108       print *,'Ecriture valeur entiere avec pas de temps'
109 C
110 C     Fermeture du fichier      
111 C
112       call efferm(fid,cret)
113       if (cret .ne. 0 ) then
114          print *,'Erreur fermeture du fichier'
115          call efexit(-1)
116       endif
117       print *,cret
118       print *,'Fermeture du fichier test21.med'
119 C
120       end
121 C