f/test21.f
C* This file is part of MED.
C*
C* COPYRIGHT (C) 1999 - 2020 EDF R&D, CEA/DEN
C* MED is free software: you can redistribute it and/or modify
C* it under the terms of the GNU Lesser General Public License as published by
C* the Free Software Foundation, either version 3 of the License, or
C* (at your option) any later version.
C*
C* MED is distributed in the hope that it will be useful,
C* but WITHOUT ANY WARRANTY; without even the implied warranty of
C* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
C* GNU Lesser General Public License for more details.
C*
C* You should have received a copy of the GNU Lesser General Public License
C* along with MED. If not, see <http://www.gnu.org/licenses/>.
C*
C******************************************************************************
C* - Nom du fichier : test21.f
C*
C* - Description : ecriture de valeurs scalaires numeriques dans un fichier MED
C*
C ******************************************************************************
program test21
C
implicit none
include 'med.hf'
C
integer*8 fid
integer cret
character*16 edtuni,dtunit1
character*64 nom1, nom2
character*200 desc1, desc2
integer vali1, vali2
real*8 valr1,dt
C
parameter(nom1="VariableEntiere")
parameter(nom2="VariableFlottante")
data desc1 / "Une premiere description" /
data desc2 / "Une seconde description" /
parameter(vali1 = 56,vali2 = -789)
parameter(valr1 = 67.98d0)
parameter(edtuni=" "
1 ,dtunit1="ms")
C
C
C Creation du fichier test21.med
C
call mfiope(fid,'test21.med',med_acc_rdwr, cret)
print *,cret
if (cret .ne. 0 ) then
print *,'Erreur creation du fichier'
call efexit(-1)
endif
print *,'Creation du fichier test21.med'
C
C Creation d'une variable scalaire entiere
C
call mprcre(fid,nom1,med_int,desc1,dtunit1,
& cret)
print *,cret
if (cret .ne. 0 ) then
print *,'Erreur creation variable scalaire'
call efexit(-1)
endif
print *,'Creation d une variable scalaire entiere'
C
C Ecriture d'une valeur sans pas de temps ni numero d'ordre
C
call mprivw(fid,nom1,med_no_dt,med_no_it,med_undef_dt,
& vali1,cret)
print *,cret
if (cret .ne. 0 ) then
print *,'Erreur ecriture valeur scalaire'
call efexit(-1)
endif
print *,'Ecriture valeur entiere sans pas de temps'
C
C Ecriture d'une valeur avec pas de temps et sans numero d'ordre
C
dt = 5.5d0
call mprivw(fid,nom1,1,med_no_it,dt,vali2,cret)
print *,cret
if (cret .ne. 0 ) then
print *,'Erreur ecriture valeur scalaire'
call efexit(-1)
endif
print *,'Ecriture valeur entiere avec pas de temps'
C
C Creation d'une variable scalaire flottante
C
call mprcre(fid,nom2,med_float64,desc2,dtunit1,
& cret)
print *,cret
if (cret .ne. 0 ) then
print *,'Erreur creation variable sclaire'
call efexit(-1)
endif
print *,'Creation d une variable scalaire flottante'
C
C Ecriture d'une valeur flottante avec pas de temps et numero d'ordre
C
call mprrvw(fid,nom2,1,2,dt,valr1,cret)
print *,cret
if (cret .ne. 0 ) then
print *,'Erreur ecriture valeur scalaire'
call efexit(-1)
endif
print *,'Ecriture valeur entiere avec pas de temps'
C
C Fermeture du fichier
C
call mficlo(fid,cret)
if (cret .ne. 0 ) then
print *,'Erreur fermeture du fichier'
call efexit(-1)
endif
print *,cret
print *,'Fermeture du fichier test21.med'
C
end
C
med_float64
double med_float64
Definition build.python3.12/include/med.h:328
med_int
int med_int
Definition build.python3.12/include/med.h:333
mfiope
subroutine mfiope(fid, name, access, cret)
Definition medfile.f:42
mficlo
subroutine mficlo(fid, cret)
Definition medfile.f:82
mprrvw
subroutine mprrvw(fid, name, numdt, numit, dt, val, cret)
Definition medparameter.f:38
mprcre
subroutine mprcre(fid, name, type, des, dtunit, cret)
Definition medparameter.f:19
mprivw
subroutine mprivw(fid, name, numdt, numit, dt, val, cret)
Definition medparameter.f:56
test21
program test21
Definition test21.f:24