1 |
module histdef_m |
2 |
|
3 |
implicit none |
4 |
|
5 |
contains |
6 |
|
7 |
SUBROUTINE histdef(fileid, varname, ptitle, unit, xsize, ysize, & |
8 |
horiid, pzsize, par_oriz, par_szz, pzid, popp, pfreq_opp, pfreq_wrt) |
9 |
|
10 |
! With this subroutine each variable to be archived on the history |
11 |
! tape should be declared. It gives the user the choise of |
12 |
! operation to be performed on the variables, the frequency of |
13 |
! this operation and the frequency of the archiving. |
14 |
|
15 |
USE find_str_m, ONLY: find_str |
16 |
USE mathelp, ONLY: buildop |
17 |
USE errioipsl, ONLY: histerr |
18 |
USE histcom_var, ONLY: buff_pos, deltat, freq_opp, freq_wrt, fullop, & |
19 |
full_size, itau0, last_opp, last_opp_chk, last_wrt, last_wrt_chk, & |
20 |
missing_val, name, name_length, nbopp, nbopp_max, nb_hax, nb_opp, & |
21 |
nb_tax, nb_var, nb_var_max, nb_wrt, nb_zax, point, scal, scsize, & |
22 |
slab_ori, slab_sz, sopps, tax_last, tax_name, tax_name_length, & |
23 |
title, topp, unit_name, var_axid, var_haxid, var_zaxid, zax_name, & |
24 |
zax_size, zorig, zsize |
25 |
USE calendar, ONLY: ioget_calendar |
26 |
|
27 |
INTEGER, INTENT (IN):: fileid |
28 |
! (ID of the file the variable should be archived in) |
29 |
|
30 |
CHARACTER (len=*), INTENT (IN):: varname |
31 |
! (name of the variable, short and easy to remember) |
32 |
|
33 |
CHARACTER (len=*), INTENT (IN):: ptitle ! full name of the variable |
34 |
CHARACTER (len=*), INTENT (IN):: unit ! units of the variable |
35 |
|
36 |
! The next 3 arguments give the size of that data |
37 |
! that will be passed to histwrite. The zoom will be |
38 |
! done there with the horizontal information obtained |
39 |
! in "histbeg" and the vertical information to follow. |
40 |
INTEGER, INTENT (IN):: xsize, ysize ! Sizes in X and Y directions |
41 |
INTEGER, INTENT (IN):: horiid ! ID of the horizontal axis |
42 |
|
43 |
! The next two arguments give the vertical zoom to use. |
44 |
|
45 |
INTEGER, INTENT (IN):: pzsize |
46 |
! (Size in Z direction (If 1 then no axis is declared for this |
47 |
! variable and pzid is not used) |
48 |
|
49 |
INTEGER, INTENT (IN):: par_oriz ! Off set of the zoom |
50 |
INTEGER, INTENT (IN):: par_szz ! Size of the zoom |
51 |
|
52 |
INTEGER, INTENT (IN):: pzid |
53 |
! (ID of the vertical axis to use. It has to have the size of the zoom.) |
54 |
|
55 |
CHARACTER (len=*), INTENT (IN):: popp |
56 |
! Operation to be performed. The following options exist today: |
57 |
! inst: keeps instantaneous values for writting |
58 |
! ave: Computes the average from call between writes |
59 |
|
60 |
REAL, INTENT (IN):: pfreq_opp ! Frequency of this operation (in seconds) |
61 |
|
62 |
REAL, INTENT (IN):: pfreq_wrt |
63 |
! (Frequency at which the variable should be written, in seconds) |
64 |
|
65 |
! Local: |
66 |
|
67 |
INTEGER:: iv, i, nb |
68 |
CHARACTER (len=70):: str70, str71, str72 |
69 |
CHARACTER (len=20):: tmp_name |
70 |
CHARACTER (len=20):: str20, tab_str20(nb_var_max) |
71 |
INTEGER:: tab_str20_length(nb_var_max) |
72 |
CHARACTER (len=40):: str40, tab_str40(nb_var_max) |
73 |
INTEGER:: tab_str40_length(nb_var_max) |
74 |
CHARACTER (len=10):: str10 |
75 |
CHARACTER (len=80):: tmp_str80 |
76 |
CHARACTER (len=7):: tmp_topp, tmp_sopp(nbopp_max) |
77 |
CHARACTER (len=120):: ex_topps |
78 |
REAL:: tmp_scal(nbopp_max), un_an, un_jour, test_fopp, test_fwrt |
79 |
INTEGER:: pos, buff_sz |
80 |
|
81 |
!--------------------------------------------------------------------- |
82 |
|
83 |
ex_topps = 'ave, inst, t_min, t_max, t_sum, once, never, l_max, l_min' |
84 |
|
85 |
nb_var(fileid) = nb_var(fileid) + 1 |
86 |
iv = nb_var(fileid) |
87 |
|
88 |
IF (iv>nb_var_max) THEN |
89 |
CALL histerr(3, 'histdef', & |
90 |
'Table of variables too small. You should increase nb_var_max', & |
91 |
'in M_HISTCOM.f90 in order to accomodate all these variables', ' ') |
92 |
END IF |
93 |
|
94 |
! 1.0 Transfer informations on the variable to the common |
95 |
! and verify that it does not already exist |
96 |
|
97 |
IF (iv>1) THEN |
98 |
str20 = varname |
99 |
nb = iv - 1 |
100 |
tab_str20(1:nb) = name(fileid, 1:nb) |
101 |
tab_str20_length(1:nb) = name_length(fileid, 1:nb) |
102 |
CALL find_str(nb, tab_str20, tab_str20_length, str20, pos) |
103 |
ELSE |
104 |
pos = 0 |
105 |
END IF |
106 |
|
107 |
IF (pos>0) THEN |
108 |
str70 = 'Variable already exists' |
109 |
WRITE (str71, '("Check variable ", a, " in file", I3)') str20, & |
110 |
fileid |
111 |
str72 = 'Can also be a wrong file ID in another declaration' |
112 |
CALL histerr(3, 'histdef', str70, str71, str72) |
113 |
END IF |
114 |
|
115 |
name(fileid, iv) = varname |
116 |
name_length(fileid, iv) = len_trim(name(fileid, iv)) |
117 |
title(fileid, iv) = ptitle |
118 |
unit_name(fileid, iv) = unit |
119 |
tmp_name = name(fileid, iv) |
120 |
|
121 |
! 1.1 decode the operations |
122 |
|
123 |
fullop(fileid, iv) = popp |
124 |
tmp_str80 = popp |
125 |
CALL buildop(tmp_str80, ex_topps, tmp_topp, nbopp_max, missing_val, & |
126 |
tmp_sopp, tmp_scal, nbopp(fileid, iv)) |
127 |
|
128 |
topp(fileid, iv) = tmp_topp |
129 |
DO i = 1, nbopp(fileid, iv) |
130 |
sopps(fileid, iv, i) = tmp_sopp(i) |
131 |
scal(fileid, iv, i) = tmp_scal(i) |
132 |
END DO |
133 |
|
134 |
! 1.2 If we have an even number of operations |
135 |
! then we need to add identity |
136 |
|
137 |
IF (2*int(nbopp(fileid, iv)/2.0)==nbopp(fileid, iv)) THEN |
138 |
nbopp(fileid, iv) = nbopp(fileid, iv) + 1 |
139 |
sopps(fileid, iv, nbopp(fileid, iv)) = 'ident' |
140 |
scal(fileid, iv, nbopp(fileid, iv)) = missing_val |
141 |
END IF |
142 |
|
143 |
! 2.0 Put the size of the variable in the common and check |
144 |
|
145 |
scsize(fileid, iv, :) = (/ xsize, ysize, pzsize/) |
146 |
|
147 |
zorig(fileid, iv, 1:3) = (/ slab_ori(fileid, 1), slab_ori(fileid, 2), & |
148 |
par_oriz/) |
149 |
|
150 |
zsize(fileid, iv, 1:3) = (/ slab_sz(fileid, 1), slab_sz(fileid, 2), & |
151 |
par_szz/) |
152 |
|
153 |
! Is the size of the full array the same as that of the coordinates ? |
154 |
|
155 |
IF ((xsize>full_size(fileid, 1)) .OR. (ysize>full_size(fileid, & |
156 |
2))) THEN |
157 |
|
158 |
str70 = 'The size of the variable is different ' // & |
159 |
'from the one of the coordinates' |
160 |
WRITE (str71, '("Size of coordinates:", 2I4)') full_size(fileid, 1), & |
161 |
full_size(fileid, 2) |
162 |
WRITE (str72, '("Size declared for variable ", a, ":", 2I4)') & |
163 |
trim(tmp_name), xsize, ysize |
164 |
CALL histerr(3, 'histdef', str70, str71, str72) |
165 |
END IF |
166 |
|
167 |
! Is the size of the zoom smaler than the coordinates ? |
168 |
|
169 |
IF ((full_size(fileid, 1)<slab_sz(fileid, 1)) .OR. (full_size(fileid, & |
170 |
2)<slab_sz(fileid, 2))) THEN |
171 |
str70 = 'Size of variable should be greater or equal & |
172 |
&to those of the zoom' |
173 |
WRITE (str71, '("Size of XY zoom:", 2I4)') slab_sz(fileid, 1), & |
174 |
slab_sz(fileid, 1) |
175 |
WRITE (str72, '("Size declared for variable ", a, ":", 2I4)') & |
176 |
trim(tmp_name), xsize, ysize |
177 |
CALL histerr(3, 'histdef', str70, str71, str72) |
178 |
END IF |
179 |
|
180 |
! 2.1 We store the horizontal grid information with minimal |
181 |
! and a fall back onto the default grid |
182 |
|
183 |
IF (horiid>0 .AND. horiid<=nb_hax(fileid)) THEN |
184 |
var_haxid(fileid, iv) = horiid |
185 |
ELSE |
186 |
var_haxid(fileid, iv) = 1 |
187 |
CALL histerr(2, 'histdef', & |
188 |
'We use the default grid for variable as an invalide', & |
189 |
'ID was provided for variable: ', varname) |
190 |
END IF |
191 |
|
192 |
! 2.2 Check the vertical coordinates if needed |
193 |
|
194 |
IF (par_szz>1) THEN |
195 |
|
196 |
! Does the vertical coordinate exist ? |
197 |
|
198 |
IF (pzid>nb_zax(fileid)) THEN |
199 |
WRITE (str70, '("The vertical coordinate chosen for variable ", a)' & |
200 |
) trim(tmp_name) |
201 |
str71 = ' Does not exist.' |
202 |
CALL histerr(3, 'histdef', str70, str71, ' ') |
203 |
END IF |
204 |
|
205 |
! Is the vertical size of the variable equal to that of the axis ? |
206 |
|
207 |
IF (par_szz/=zax_size(fileid, pzid)) THEN |
208 |
str20 = zax_name(fileid, pzid) |
209 |
str70 = 'The size of the zoom does not correspond ' // & |
210 |
'to the size of the chosen vertical axis' |
211 |
WRITE (str71, '("Size of zoom in z:", I4)') par_szz |
212 |
WRITE (str72, '("Size declared for axis ", a, ":", I4)') & |
213 |
trim(str20), zax_size(fileid, pzid) |
214 |
CALL histerr(3, 'histdef', str70, str71, str72) |
215 |
END IF |
216 |
|
217 |
! Is the zoom smaler that the total size of the variable ? |
218 |
|
219 |
IF (pzsize<par_szz) THEN |
220 |
str20 = zax_name(fileid, pzid) |
221 |
str70 = 'The vertical size of variable ' // & |
222 |
'is smaller than that of the zoom.' |
223 |
WRITE (str71, '("Declared vertical size of data:", I5)') pzsize |
224 |
WRITE (str72, '("Size of zoom for variable ", a, " = ", I5)') & |
225 |
trim(tmp_name), par_szz |
226 |
CALL histerr(3, 'histdef', str70, str71, str72) |
227 |
END IF |
228 |
var_zaxid(fileid, iv) = pzid |
229 |
ELSE |
230 |
var_zaxid(fileid, iv) = -99 |
231 |
END IF |
232 |
|
233 |
! 3.0 Determine the position of the variable in the buffer |
234 |
! If it is instantaneous output then we do not use the buffer |
235 |
|
236 |
! 3.1 We get the size of the arrays histwrite will get and check |
237 |
! that they fit into the tmp_buffer |
238 |
|
239 |
buff_sz = zsize(fileid, iv, 1)*zsize(fileid, iv, 2)*zsize(fileid, iv, 3) |
240 |
|
241 |
! 3.2 move the pointer of the buffer array for operation |
242 |
! which need bufferisation |
243 |
|
244 |
IF ((trim(tmp_topp)/='inst') .AND. (trim(tmp_topp)/='once') .AND. ( & |
245 |
trim(tmp_topp)/='never')) THEN |
246 |
point(fileid, iv) = buff_pos + 1 |
247 |
buff_pos = buff_pos + buff_sz |
248 |
END IF |
249 |
|
250 |
! 4.0 Transfer the frequency of the operations and check |
251 |
! for validity. We have to pay attention to negative values |
252 |
! of the frequency which indicate monthly time-steps. |
253 |
! The strategy is to bring it back to seconds for the tests |
254 |
|
255 |
freq_opp(fileid, iv) = pfreq_opp |
256 |
freq_wrt(fileid, iv) = pfreq_wrt |
257 |
|
258 |
CALL ioget_calendar(un_an, un_jour) |
259 |
IF (pfreq_opp<0) THEN |
260 |
CALL ioget_calendar(un_an) |
261 |
test_fopp = pfreq_opp*(-1.)*un_an/12.*un_jour |
262 |
ELSE |
263 |
test_fopp = pfreq_opp |
264 |
END IF |
265 |
IF (pfreq_wrt<0) THEN |
266 |
CALL ioget_calendar(un_an) |
267 |
test_fwrt = pfreq_wrt*(-1.)*un_an/12.*un_jour |
268 |
ELSE |
269 |
test_fwrt = pfreq_wrt |
270 |
END IF |
271 |
|
272 |
! 4.1 Frequency of operations and output should be larger than deltat ! |
273 |
|
274 |
IF (test_fopp<deltat(fileid)) THEN |
275 |
str70 = 'Frequency of operations should be larger than deltat' |
276 |
WRITE (str71, '("It is not the case for variable ", a, ":", F10.4)') & |
277 |
trim(tmp_name), pfreq_opp |
278 |
str72 = 'PATCH: frequency set to deltat' |
279 |
|
280 |
CALL histerr(2, 'histdef', str70, str71, str72) |
281 |
|
282 |
freq_opp(fileid, iv) = deltat(fileid) |
283 |
END IF |
284 |
|
285 |
IF (test_fwrt<deltat(fileid)) THEN |
286 |
str70 = 'Frequency of output should be larger than deltat' |
287 |
WRITE (str71, '("It is not the case for variable ", a, ":", F10.4)') & |
288 |
trim(tmp_name), pfreq_wrt |
289 |
str72 = 'PATCH: frequency set to deltat' |
290 |
|
291 |
CALL histerr(2, 'histdef', str70, str71, str72) |
292 |
|
293 |
freq_wrt(fileid, iv) = deltat(fileid) |
294 |
END IF |
295 |
|
296 |
! 4.2 First the existence of the operation is tested and then |
297 |
! its compatibility with the choice of frequencies |
298 |
|
299 |
IF (trim(tmp_topp)=='inst') THEN |
300 |
IF (test_fopp/=test_fwrt) THEN |
301 |
str70 = 'For instantaneous output the frequency ' // & |
302 |
'of operations and output' |
303 |
WRITE (str71, & |
304 |
'("should be the same, this was not case for variable ", a)') & |
305 |
trim(tmp_name) |
306 |
str72 = 'PATCH: The smalest frequency of both is used' |
307 |
CALL histerr(2, 'histdef', str70, str71, str72) |
308 |
IF (test_fopp<test_fwrt) THEN |
309 |
freq_opp(fileid, iv) = pfreq_opp |
310 |
freq_wrt(fileid, iv) = pfreq_opp |
311 |
ELSE |
312 |
freq_opp(fileid, iv) = pfreq_wrt |
313 |
freq_wrt(fileid, iv) = pfreq_wrt |
314 |
END IF |
315 |
END IF |
316 |
ELSE IF (index(ex_topps, trim(tmp_topp))>0) THEN |
317 |
IF (test_fopp>test_fwrt) THEN |
318 |
str70 = 'For averages the frequency of operations ' // & |
319 |
'should be smaller or equal' |
320 |
WRITE (str71, & |
321 |
'("to that of output. It is not the case for variable ", a)') & |
322 |
trim(tmp_name) |
323 |
str72 = 'PATCH: The output frequency is used for both' |
324 |
CALL histerr(2, 'histdef', str70, str71, str72) |
325 |
freq_opp(fileid, iv) = pfreq_wrt |
326 |
END IF |
327 |
ELSE |
328 |
WRITE (str70, '("Operation on variable ", a, " is unknown")') & |
329 |
trim(tmp_name) |
330 |
WRITE (str71, '("operation requested is:", a)') tmp_topp |
331 |
WRITE (str72, '("File ID:", I3)') fileid |
332 |
CALL histerr(3, 'histdef', str70, str71, str72) |
333 |
END IF |
334 |
|
335 |
! 5.0 Initialize other variables of the common |
336 |
|
337 |
last_opp(fileid, iv) = itau0(fileid) |
338 |
! - freq_opp(fileid, iv)/2./deltat(fileid) |
339 |
last_wrt(fileid, iv) = itau0(fileid) |
340 |
! - freq_wrt(fileid, iv)/2./deltat(fileid) |
341 |
last_opp_chk(fileid, iv) = itau0(fileid) |
342 |
! - freq_opp(fileid, iv)/2./deltat(fileid) |
343 |
last_wrt_chk(fileid, iv) = itau0(fileid) |
344 |
! - freq_wrt(fileid, iv)/2./deltat(fileid) |
345 |
nb_opp(fileid, iv) = 0 |
346 |
nb_wrt(fileid, iv) = 0 |
347 |
|
348 |
! 6.0 Get the time axis for this variable |
349 |
|
350 |
IF (freq_wrt(fileid, iv)>0) THEN |
351 |
WRITE (str10, '(I8.8)') int(freq_wrt(fileid, iv)) |
352 |
str40 = trim(tmp_topp) // '_' // trim(str10) |
353 |
ELSE |
354 |
WRITE (str10, '(I2.2, "month")') abs(int(freq_wrt(fileid, iv))) |
355 |
str40 = trim(tmp_topp) // '_' // trim(str10) |
356 |
END IF |
357 |
|
358 |
DO i = 1, nb_tax(fileid) |
359 |
tab_str40(i) = tax_name(fileid, i) |
360 |
tab_str40_length(i) = tax_name_length(fileid, i) |
361 |
END DO |
362 |
|
363 |
CALL find_str(nb_tax(fileid), tab_str40, tab_str40_length, str40, pos) |
364 |
|
365 |
! No time axis for once, l_max, l_min or never operation |
366 |
|
367 |
IF ((trim(tmp_topp)/='once') .AND. (trim(tmp_topp)/='never') .AND. ( & |
368 |
trim(tmp_topp)/='l_max') .AND. (trim(tmp_topp)/='l_min')) THEN |
369 |
IF (pos<0) THEN |
370 |
nb_tax(fileid) = nb_tax(fileid) + 1 |
371 |
tax_name(fileid, nb_tax(fileid)) = str40 |
372 |
tax_name_length(fileid, nb_tax(fileid)) = len_trim(str40) |
373 |
tax_last(fileid, nb_tax(fileid)) = 0 |
374 |
var_axid(fileid, iv) = nb_tax(fileid) |
375 |
ELSE |
376 |
var_axid(fileid, iv) = pos |
377 |
END IF |
378 |
ELSE |
379 |
var_axid(fileid, iv) = -99 |
380 |
END IF |
381 |
|
382 |
! 7.0 prepare frequence of writing and operation |
383 |
! for never or once operation |
384 |
|
385 |
IF ((trim(tmp_topp)=='once') .OR. (trim(tmp_topp)=='never')) THEN |
386 |
freq_opp(fileid, iv) = 0. |
387 |
freq_wrt(fileid, iv) = 0. |
388 |
END IF |
389 |
|
390 |
END SUBROUTINE histdef |
391 |
|
392 |
end module histdef_m |