MED fichier
Unittest_MEDparameter_3.f
Aller à la documentation de ce fichier.
1 C* This file is part of MED.
2 C*
3 C* COPYRIGHT (C) 1999 - 2023 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 * Tests for parameter module
20 C *
21 C *****************************************************************************
22  program medparameter3
23 C
24  implicit none
25  include 'med.hf'
26 C
27 C
28  integer cret
29  integer*8 fid
30 
31  character*64 fname
32  parameter(fname = "Unittest_MEDparameter_1.med")
33  character*64 pname1,pname2,pname
34  parameter(pname1="first parameter name")
35  parameter(pname2="second parameter name")
36  integer type1,type2,type
37  parameter(type1=med_float64, type2=med_int)
38  character*200 desc1,desc2,desc
39  parameter(desc1="First parameter description")
40  parameter(desc2="Second parameter description")
41  character*16 dtunit1,dtunit2,dtunit
42  parameter(dtunit1="unit1")
43  parameter(dtunit2="unit2")
44  real*8 p1v1, p1v2,rv
45  parameter(p1v1=1.0,p1v2=2.0)
46  integer p1numdt1,p1numdt2,p2numdt1,p2numdt2,numdt
47  parameter(p1numdt1=med_no_dt,p1numdt2=1)
48  parameter(p2numdt1=2, p2numdt2=3)
49  real*8 dt1, dt2,dt
50  parameter(dt1=med_undef_dt,dt2=5.5)
51  integer p2v1,p2v2,iv
52  parameter(p2v1=3,p2v2=4)
53  integer p1numit1, p1numit2, p2numit1, p2numit2
54  integer numit
55  parameter(p1numit1=med_no_it, p1numit2=1)
56  parameter(p2numit1=2, p2numit2=3)
57  integer nstep1,nstep2,nstep,sit
58  parameter(nstep1=2,nstep2=2)
59  integer np,np1,it
60  parameter(np1=2)
61 C
62 C
63 C open file
64  call mfiope(fid,fname,med_acc_rdonly,cret)
65  print *,'Open file',cret
66  if (cret .ne. 0 ) then
67  print *,'ERROR : open file'
68  call efexit(-1)
69  endif
70 C
71 C
72 C number of parameter
73  call mprnpr(fid,np,cret)
74  print *,'Number of parameter',cret
75  if ((cret .ne. 0) .or.
76  & (np .ne. np1)) then
77  print *,'ERROR : number of parameter'
78  call efexit(-1)
79  endif
80 C
81 C
82 C read parameters
83  do it=1,np
84 c
85  call mprpri(fid,it,pname,type,desc,
86  & dtunit,nstep,cret)
87  print *,'interpolation information',cret
88  if (cret .ne. 0 ) then
89  print *,'ERROR : interpolation information'
90  call efexit(-1)
91  endif
92 c
93 c if (it .eq. 1) then
94 c if ((pname .ne. pname1) .or.
95 c & (type .ne. type1) .or.
96 c & (desc .ne. desc1) .or.
97 c & (dtunit .ne. dtunit1) .or.
98 c & (nstep .ne. nstep1)) then
99 c print *,'ERROR : interpolation information'
100 c call efexit(-1)
101 c endif
102 c endif
103 c
104 c if (it .eq. 2) then
105 c if ((pname .ne. pname2) .or.
106 c & (type .ne. type2) .or.
107 c & (desc .ne. desc2) .or.
108 c & (dtunit .ne. dtunit2) .or.
109 c & (nstep .ne. nstep2)) then
110 c print *,'ERROR : interpolation information'
111 c call efexit(-1)
112 c endif
113 c endif
114 c
115  do sit=1,nstep
116 c
117  call mprcsi(fid,pname,sit,numdt,numit,
118  & dt,cret)
119  print *,'computation step information',cret
120  if (cret .ne. 0 ) then
121  print *,'ERROR : computation step information'
122  call efexit(-1)
123  endif
124 c
125 c if ((pname .eq. pname1) .and.
126 c & (sit .eq. 1)) then
127 c if ((numdt .ne. p1numdt1) .or.
128 c & (numit .ne. p1numit1) .or.
129 c & (dt .ne. dt1)) then
130 c print *,'ERROR : read value'
131 c call efexit(-1)
132 c endif
133 c endif
134 c
135 c if ((pname .eq. pname1) .and.
136 c & (sit .eq. 2)) then
137 c if ((numdt .ne. p1numdt2) .or.
138 c & (numit .ne. p1numit2) .or.
139 c & (dt .ne. dt2)) then
140 c print *,'ERROR : read value'
141 c call efexit(-1)
142 c endif
143 c endif
144 c
145 c if ((pname .eq. pname2) .and.
146 c & (sit .eq. 1)) then
147 c if ((numdt .ne. p2numdt1) .or.
148 c & (numit .ne. p2numit1) .or.
149 c & (dt .ne. dt1)) then
150 c print *,'ERROR : read value'
151 c call efexit(-1)
152 c endif
153 c endif
154 c
155 c if ((pname .eq. pname2) .and.
156 c & (sit .eq. 2)) then
157 c if ((numdt .ne. p2numdt2) .or.
158 c & (numit .ne. p2numit2) .or.
159 c & (dt .ne. dt2)) then
160 c print *,'ERROR : read value'
161 c call efexit(-1)
162 c endif
163 c endif
164 c
165 c if (type .eq. MED_INT) then
166 c call mprivr(fid,pname,numdt,numit,iv,cret)
167 c print *,'read value',cret
168 c if (cret .ne. 0 ) then
169 c print *,'ERROR : read value'
170 c call efexit(-1)
171 c endif
172 c
173 c if ((sit .eq. 1) .and.
174 c & (iv .ne. p2v1)) then
175 c print *,'ERROR : read value'
176 c call efexit(-1)
177 c endif
178 c
179 c if ((sit .eq. 2) .and.
180 c & (iv .ne. p2v2)) then
181 c print *,'ERROR : read value'
182 c call efexit(-1)
183 c endif
184 c else
185 c call mprrvr(fid,pname,numdt,numit,rv,cret)
186 c print *,'read value',cret
187 c if (cret .ne. 0 ) then
188 c print *,'ERROR : read value'
189 c call efexit(-1)
190 c endif
191 c
192 c if ((sit .eq. 1) .and.
193 c & (rv .ne. p1v1)) then
194 c print *,'ERROR : read value'
195 c call efexit(-1)
196 c endif
197 c
198 c if ((sit .eq. 2) .and.
199 c & (rv .ne. p1v2)) then
200 c print *,'ERROR : read value'
201 c call efexit(-1)
202 c endif
203 c endif
204  enddo
205 c
206  enddo
207 C
208 C
209 C close file
210  call mficlo(fid,cret)
211  print *,'Close file',cret
212  if (cret .ne. 0 ) then
213  print *,'ERROR : close file'
214  call efexit(-1)
215  endif
216 C
217 C
218 C
219  end
220 
medparameter3
program medparameter3
Definition: Unittest_MEDparameter_3.f:22
mprnpr
subroutine mprnpr(fid, n, cret)
Cette routine permet la lecture du nombre de paramètre numérique scalaire dans un fichier.
Definition: medparameter.f:111
mprpri
subroutine mprpri(fid, it, name, type, desc, dtunit, nstep, cret)
Cette routine permet la lecture des informations relatives à un paramètre scalaire via un itérateur.
Definition: medparameter.f:134
med_int
int med_int
Definition: med.h:344
mprcsi
subroutine mprcsi(fid, name, it, numdt, numit, dt, cret)
Cette routine permet la lecture des informations relatives à une étape de calcul du paramètre numériq...
Definition: medparameter.f:174
mficlo
subroutine mficlo(fid, cret)
Fermeture d'un fichier MED.
Definition: medfile.f:82
med_float64
double med_float64
Definition: med.h:339
mfiope
subroutine mfiope(fid, name, access, cret)
Ouverture d'un fichier MED.
Definition: medfile.f:42