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