MED fichier
f/2.3.6/test22.f
1 C* This file is part of MED.
2 C*
3 C* COPYRIGHT (C) 1999 - 2017 EDF R&D, CEA/DEN
4 C* MED is free software: you can redistribute it and/or modify
5 C* it under the terms of the GNU Lesser General Public License as published by
6 C* the Free Software Foundation, either version 3 of the License, or
7 C* (at your option) any later version.
8 C*
9 C* MED is distributed in the hope that it will be useful,
10 C* but WITHOUT ANY WARRANTY; without even the implied warranty of
11 C* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12 C* GNU Lesser General Public License for more details.
13 C*
14 C* You should have received a copy of the GNU Lesser General Public License
15 C* along with MED. If not, see <http://www.gnu.org/licenses/>.
16 C*
17 
18 C******************************************************************************
19 C* - Nom du fichier : test22.f
20 C*
21 C* - Description : lecture des valeurs scalaires numeriques dans un fichier MED
22 C ******************************************************************************
23  program test22
24 C
25  implicit none
26  include 'med.hf'
27 C
28  integer*8 fid
29  integer cret
30  character*16 dtunit
31  character*32 nom
32  character*200 desc
33  integer vali
34  real*8 valr,dt
35  integer n,npdt,i,j,type,numdt,numo
36 C
37 C Ouverture du fichier test21.med en lecture seule
38 C
39  call efouvr(fid,'test21.med',med_lecture,cret)
40  print *,cret
41  if (cret .ne. 0 ) then
42  print *,'Erreur ouverture du fichier'
43  call efexit(-1)
44  endif
45  print *,'Ouverture du fichier test21.med'
46 C
47 C Lecture du nombre de variable scalaire
48 C
49  call efnsca(fid,n,cret)
50  print *,cret
51  if (cret .ne. 0 ) then
52  print *,'Erreur lecture du nombre de variable'
53  call efexit(-1)
54  endif
55  print *,'Nombre de variables scalaires : ',n
56 C
57 C Lecture des infos (type,description) propres
58 C a chaque variable
59 C
60  do 10 i=1,n
61  call efscai(fid,i,nom,type,desc,cret)
62  print *,cret
63  if (cret .ne. 0 ) then
64  print *,'Erreur lecture des infos'
65  call efexit(-1)
66  endif
67  print *,'- Scalaire de nom : ',nom
68  if (type.eq.med_float64) then
69  print *,' de type flottant'
70  else
71  print *,' de type entier'
72  endif
73  print *,' Description associee : ',desc
74 C
75 C Pour chaque scalaire, on regarde les valeurs associees
76 C eventuellement a un pas de temps et/ou un numero d'ordre
77 C
78  call efnspd(fid,nom,npdt,cret)
79  if (cret .ne. 0 ) then
80  print *,'Erreur lecture du nombre de pas de temps'
81  call efexit(-1)
82  endif
83  print *,cret
84  print *,' Nombre de valeurs : ',npdt
85 C
86  do 20 j=1,npdt
87  call efspdi(fid,nom,j,numdt,dtunit,dt,numo,cret)
88  print *,cret
89  if (cret .ne. 0 ) then
90  print *,'Erreur infos pas de temps'
91  call efexit(-1)
92  endif
93  print *,' Valeur ', j
94 C
95  if (numdt.eq.med_nopdt) then
96  print *,' - Aucun pas de temps'
97  else
98  print *,' - Pas de temps de numero ',numdt
99  print *,' de valeur : ',dt
100  print *,' unite : ',dtunit
101  endif
102 C
103  if (numo.eq.med_nonor) then
104  print *,' - Aucun numero ordre'
105  else
106  print *,' - Numero ordre : ',numo
107  endif
108 C
109  if (type.eq.med_float64) then
110 C ** Lecture de la valeur flottante associee
111 C ** au pas de temps
112  call efscfl(fid,nom,valr,numdt,numo,cret)
113  print *,cret
114  if (cret .ne. 0 ) then
115  print *,'Erreur lecture valeur'
116  call efexit(-1)
117  endif
118  print *,' - Valeur : ',valr
119  else
120 C ** Lecture de la valeur entiere associee
121 C ** au pas de temps
122  call efscel(fid,nom,vali,numdt,numo,cret)
123  print *,cret
124  if (cret .ne. 0 ) then
125  print *,'Erreur lecture valeur'
126  call efexit(-1)
127  endif
128  print *,' - Valeur : ',vali
129  endif
130 C
131  20 continue
132 C
133  10 continue
134 C
135 C Fermeture du fichier
136 C
137  call efferm(fid,cret)
138  print *,cret
139  if (cret .ne. 0 ) then
140  print *,'Erreur fermeture du fichier'
141  call efexit(-1)
142  endif
143  print *,'Fermeture du fichier test21.med'
144 C
145  end