1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
24
25 implicit none
26 include 'med.hf'
27
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
36
37
38
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'
46
47
48
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
57
58
59
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
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
77
78
79
80
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
89
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
96
97 if (numo.eq.med_no_it) then
98 print *,' - Aucun numero ordre'
99 else
100 print *,' - Numero ordre : ',numo
101 endif
102
104
105
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
114
115
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
124
125 20 continue
126
127 10 continue
128
129
130
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'
138
139 end
subroutine mfiope(fid, name, access, cret)
subroutine mficlo(fid, cret)
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)