1 |
guez |
30 |
MODULE histwrite_m |
2 |
|
|
|
3 |
guez |
31 |
! From histcom.f90, version 2.1 2004/04/21 09:27:10 |
4 |
guez |
30 |
|
5 |
|
|
implicit none |
6 |
|
|
|
7 |
|
|
INTERFACE histwrite |
8 |
guez |
31 |
! The "histwrite" procedures give the data to the input-output system. |
9 |
|
|
! They trigger the operations to be performed and the writing to |
10 |
|
|
! the file if needed. |
11 |
guez |
30 |
|
12 |
guez |
31 |
! We test the work to be done at this time here so that at a |
13 |
|
|
! later stage we can call different operations and write subroutines |
14 |
|
|
! for the REAL and INTEGER interfaces. |
15 |
guez |
30 |
|
16 |
|
|
! INTEGER, INTENT(IN):: pfileid |
17 |
|
|
! The ID of the file on which this variable is to be written. |
18 |
|
|
! The variable should have been defined in this file before. |
19 |
|
|
|
20 |
|
|
! CHARACTER(LEN=*), INTENT(IN):: pvarname |
21 |
|
|
! short name of the variable |
22 |
|
|
|
23 |
|
|
! INTEGER, INTENT(IN):: pitau |
24 |
|
|
! current timestep |
25 |
|
|
|
26 |
|
|
! REAL, INTENT(IN):: pdata(:) or (:, :) or (:, :, :) |
27 |
|
|
! values of the variable |
28 |
|
|
|
29 |
|
|
! INTEGER, INTENT(IN):: nbindex |
30 |
|
|
! number of indices provided |
31 |
|
|
! If it is equal to the size of the full field as provided in histdef |
32 |
|
|
! then nothing is done. |
33 |
|
|
|
34 |
|
|
! INTEGER, INTENT(IN):: nindex(nbindex) |
35 |
|
|
! The indices used to expand the variable (pdata) onto the full field |
36 |
|
|
|
37 |
|
|
! The difference between the procedures is the rank of "pdata". |
38 |
|
|
|
39 |
|
|
MODULE PROCEDURE histwrite_r1d, histwrite_r2d, histwrite_r3d |
40 |
|
|
END INTERFACE |
41 |
|
|
|
42 |
guez |
45 |
PRIVATE histwrite_r1d, histwrite_r2d, histwrite_r3d |
43 |
|
|
|
44 |
guez |
30 |
CONTAINS |
45 |
|
|
|
46 |
|
|
SUBROUTINE histwrite_r1d(pfileid, pvarname, pitau, pdata) |
47 |
|
|
|
48 |
|
|
USE errioipsl, ONLY : histerr |
49 |
|
|
use calendar, only: isittime |
50 |
guez |
32 |
USE mathop_m, ONLY : mathop |
51 |
guez |
31 |
use histcom_var |
52 |
guez |
45 |
use histvar_seq_m, only: histvar_seq |
53 |
|
|
use histwrite_real_m, only: histwrite_real |
54 |
guez |
30 |
|
55 |
|
|
INTEGER, INTENT(IN) :: pfileid, pitau |
56 |
|
|
REAL, INTENT(IN) :: pdata(:) |
57 |
|
|
CHARACTER(LEN=*), INTENT(IN) :: pvarname |
58 |
|
|
|
59 |
|
|
! Variables local to the procedure: |
60 |
|
|
integer nbindex, nindex(size(pdata)) |
61 |
|
|
LOGICAL :: do_oper, do_write, largebuf |
62 |
|
|
INTEGER :: varid, io, nbpt_in, nbpt_out |
63 |
|
|
REAL, ALLOCATABLE, SAVE :: buff_tmp(:) |
64 |
|
|
INTEGER, SAVE :: buff_tmp_sz |
65 |
|
|
CHARACTER(LEN=7) :: tmp_opp |
66 |
|
|
|
67 |
guez |
31 |
!-------------------------------------------------------------------- |
68 |
guez |
30 |
|
69 |
|
|
nbindex = size(nindex) |
70 |
|
|
nindex = 0 |
71 |
|
|
|
72 |
|
|
! 1.0 Try to catch errors like specifying the wrong file ID. |
73 |
|
|
! Thanks Marine for showing us what errors users can make ! |
74 |
|
|
|
75 |
|
|
IF ( (pfileid < 1).OR.(pfileid > nb_files) ) THEN |
76 |
|
|
CALL histerr (3, "histwrite", & |
77 |
|
|
& 'Illegal file ID in the histwrite of variable', pvarname, ' ') |
78 |
|
|
ENDIF |
79 |
|
|
|
80 |
|
|
! 1.1 Find the id of the variable to be written and the real time |
81 |
|
|
|
82 |
|
|
CALL histvar_seq (pfileid, pvarname, varid) |
83 |
|
|
|
84 |
|
|
! 2.0 do nothing for never operation |
85 |
|
|
|
86 |
|
|
tmp_opp = topp(pfileid, varid) |
87 |
|
|
|
88 |
|
|
IF (TRIM(tmp_opp) == "never") THEN |
89 |
|
|
last_opp_chk(pfileid, varid) = -99 |
90 |
|
|
last_wrt_chk(pfileid, varid) = -99 |
91 |
|
|
ENDIF |
92 |
|
|
|
93 |
|
|
! 3.0 We check if we need to do an operation |
94 |
|
|
|
95 |
|
|
IF (last_opp_chk(pfileid, varid) == pitau) THEN |
96 |
|
|
CALL histerr (3, "histwrite", & |
97 |
|
|
& 'This variable as already been analysed at the present', & |
98 |
|
|
& 'time step', ' ') |
99 |
|
|
ENDIF |
100 |
|
|
|
101 |
|
|
CALL isittime & |
102 |
|
|
& (pitau, date0(pfileid), deltat(pfileid), freq_opp(pfileid, varid), & |
103 |
|
|
& last_opp(pfileid, varid), last_opp_chk(pfileid, varid), do_oper) |
104 |
|
|
|
105 |
|
|
! 4.0 We check if we need to write the data |
106 |
|
|
|
107 |
|
|
IF (last_wrt_chk(pfileid, varid) == pitau) THEN |
108 |
|
|
CALL histerr (3, "histwrite", & |
109 |
|
|
& 'This variable as already been written for the present', & |
110 |
|
|
& 'time step', ' ') |
111 |
|
|
ENDIF |
112 |
|
|
|
113 |
|
|
CALL isittime & |
114 |
|
|
& (pitau, date0(pfileid), deltat(pfileid), freq_wrt(pfileid, varid), & |
115 |
|
|
& last_wrt(pfileid, varid), last_wrt_chk(pfileid, varid), do_write) |
116 |
|
|
|
117 |
|
|
! 5.0 histwrite called |
118 |
|
|
|
119 |
|
|
IF (do_oper.OR.do_write) THEN |
120 |
|
|
|
121 |
guez |
31 |
!- 5.1 Get the sizes of the data we will handle |
122 |
guez |
30 |
|
123 |
|
|
IF (datasz_in(pfileid, varid, 1) <= 0) THEN |
124 |
guez |
31 |
!--- There is the risk here that the user has over-sized the array. |
125 |
|
|
!--- But how can we catch this ? |
126 |
|
|
!--- In the worst case we will do impossible operations |
127 |
|
|
!--- on part of the data ! |
128 |
guez |
30 |
datasz_in(pfileid, varid, 1) = SIZE(pdata) |
129 |
|
|
datasz_in(pfileid, varid, 2) = -1 |
130 |
|
|
datasz_in(pfileid, varid, 3) = -1 |
131 |
|
|
ENDIF |
132 |
|
|
|
133 |
guez |
31 |
!- 5.2 The maximum size of the data will give the size of the buffer |
134 |
guez |
30 |
|
135 |
|
|
IF (datasz_max(pfileid, varid) <= 0) THEN |
136 |
|
|
largebuf = .FALSE. |
137 |
|
|
DO io=1, nbopp(pfileid, varid) |
138 |
|
|
IF (INDEX(fuchnbout, sopps(pfileid, varid, io)) > 0) THEN |
139 |
|
|
largebuf = .TRUE. |
140 |
|
|
ENDIF |
141 |
|
|
ENDDO |
142 |
|
|
IF (largebuf) THEN |
143 |
|
|
datasz_max(pfileid, varid) = & |
144 |
|
|
& scsize(pfileid, varid, 1) & |
145 |
|
|
& *scsize(pfileid, varid, 2) & |
146 |
|
|
& *scsize(pfileid, varid, 3) |
147 |
|
|
ELSE |
148 |
|
|
datasz_max(pfileid, varid) = & |
149 |
|
|
& datasz_in(pfileid, varid, 1) |
150 |
|
|
ENDIF |
151 |
|
|
ENDIF |
152 |
|
|
|
153 |
|
|
IF (.NOT.ALLOCATED(buff_tmp)) THEN |
154 |
|
|
ALLOCATE (buff_tmp(datasz_max(pfileid, varid))) |
155 |
|
|
buff_tmp_sz = datasz_max(pfileid, varid) |
156 |
|
|
ELSE IF (datasz_max(pfileid, varid) > buff_tmp_sz) THEN |
157 |
|
|
DEALLOCATE (buff_tmp) |
158 |
|
|
ALLOCATE (buff_tmp(datasz_max(pfileid, varid))) |
159 |
|
|
buff_tmp_sz = datasz_max(pfileid, varid) |
160 |
|
|
ENDIF |
161 |
|
|
|
162 |
guez |
31 |
!- We have to do the first operation anyway. |
163 |
|
|
!- Thus we do it here and change the ranke |
164 |
|
|
!- of the data at the same time. This should speed up things. |
165 |
guez |
30 |
|
166 |
|
|
nbpt_in = datasz_in(pfileid, varid, 1) |
167 |
|
|
nbpt_out = datasz_max(pfileid, varid) |
168 |
|
|
CALL mathop (sopps(pfileid, varid, 1), nbpt_in, pdata, & |
169 |
|
|
& missing_val, nbindex, nindex, & |
170 |
|
|
& scal(pfileid, varid, 1), nbpt_out, buff_tmp) |
171 |
|
|
CALL histwrite_real (pfileid, varid, pitau, nbpt_out, & |
172 |
|
|
& buff_tmp, nbindex, nindex, do_oper, do_write) |
173 |
|
|
ENDIF |
174 |
|
|
|
175 |
|
|
! 6.0 Manage time steps |
176 |
|
|
|
177 |
|
|
IF ((TRIM(tmp_opp) /= "once").AND.(TRIM(tmp_opp) /= "never")) THEN |
178 |
|
|
last_opp_chk(pfileid, varid) = pitau |
179 |
|
|
last_wrt_chk(pfileid, varid) = pitau |
180 |
|
|
ELSE |
181 |
|
|
last_opp_chk(pfileid, varid) = -99 |
182 |
|
|
last_wrt_chk(pfileid, varid) = -99 |
183 |
|
|
ENDIF |
184 |
guez |
31 |
!-------------------------- |
185 |
guez |
30 |
END SUBROUTINE histwrite_r1d |
186 |
|
|
|
187 |
|
|
!=== |
188 |
|
|
|
189 |
|
|
SUBROUTINE histwrite_r2d (pfileid, pvarname, pitau, pdata) |
190 |
guez |
31 |
!-------------------------------------------------------------------- |
191 |
guez |
30 |
|
192 |
|
|
use calendar, only: isittime |
193 |
|
|
USE errioipsl, ONLY : histerr |
194 |
guez |
32 |
USE mathop_m, ONLY : mathop |
195 |
guez |
31 |
use histcom_var |
196 |
guez |
45 |
use histvar_seq_m, only: histvar_seq |
197 |
|
|
use histwrite_real_m, only: histwrite_real |
198 |
guez |
30 |
|
199 |
|
|
INTEGER, INTENT(IN) :: pfileid, pitau |
200 |
|
|
REAL, DIMENSION(:, :), INTENT(IN) :: pdata |
201 |
|
|
CHARACTER(LEN=*), INTENT(IN) :: pvarname |
202 |
|
|
|
203 |
|
|
integer nbindex, nindex(size(pdata)) |
204 |
|
|
LOGICAL :: do_oper, do_write, largebuf |
205 |
|
|
INTEGER :: varid, io, nbpt_in(1:2), nbpt_out |
206 |
|
|
REAL, ALLOCATABLE, SAVE :: buff_tmp(:) |
207 |
|
|
INTEGER, SAVE :: buff_tmp_sz |
208 |
|
|
CHARACTER(LEN=7) :: tmp_opp |
209 |
|
|
|
210 |
guez |
31 |
!-------------------------------------------------------------------- |
211 |
guez |
30 |
|
212 |
|
|
nbindex = size(nindex) |
213 |
|
|
nindex = 0 |
214 |
|
|
|
215 |
|
|
! 1.0 Try to catch errors like specifying the wrong file ID. |
216 |
|
|
! Thanks Marine for showing us what errors users can make ! |
217 |
|
|
|
218 |
|
|
IF ( (pfileid < 1).OR.(pfileid > nb_files) ) THEN |
219 |
|
|
CALL histerr (3, "histwrite", & |
220 |
|
|
& 'Illegal file ID in the histwrite of variable', pvarname, ' ') |
221 |
|
|
ENDIF |
222 |
|
|
|
223 |
|
|
! 1.1 Find the id of the variable to be written and the real time |
224 |
|
|
|
225 |
|
|
CALL histvar_seq (pfileid, pvarname, varid) |
226 |
|
|
|
227 |
|
|
! 2.0 do nothing for never operation |
228 |
|
|
|
229 |
|
|
tmp_opp = topp(pfileid, varid) |
230 |
|
|
|
231 |
|
|
IF (TRIM(tmp_opp) == "never") THEN |
232 |
|
|
last_opp_chk(pfileid, varid) = -99 |
233 |
|
|
last_wrt_chk(pfileid, varid) = -99 |
234 |
|
|
ENDIF |
235 |
|
|
|
236 |
|
|
! 3.0 We check if we need to do an operation |
237 |
|
|
|
238 |
|
|
IF (last_opp_chk(pfileid, varid) == pitau) THEN |
239 |
|
|
CALL histerr (3, "histwrite", & |
240 |
|
|
& 'This variable as already been analysed at the present', & |
241 |
|
|
& 'time step', ' ') |
242 |
|
|
ENDIF |
243 |
|
|
|
244 |
|
|
CALL isittime & |
245 |
|
|
& (pitau, date0(pfileid), deltat(pfileid), freq_opp(pfileid, varid), & |
246 |
|
|
& last_opp(pfileid, varid), last_opp_chk(pfileid, varid), do_oper) |
247 |
|
|
|
248 |
|
|
! 4.0 We check if we need to write the data |
249 |
|
|
|
250 |
|
|
IF (last_wrt_chk(pfileid, varid) == pitau) THEN |
251 |
|
|
CALL histerr (3, "histwrite", & |
252 |
|
|
& 'This variable as already been written for the present', & |
253 |
|
|
& 'time step', ' ') |
254 |
|
|
ENDIF |
255 |
|
|
|
256 |
|
|
CALL isittime & |
257 |
|
|
& (pitau, date0(pfileid), deltat(pfileid), freq_wrt(pfileid, varid), & |
258 |
|
|
& last_wrt(pfileid, varid), last_wrt_chk(pfileid, varid), do_write) |
259 |
|
|
|
260 |
|
|
! 5.0 histwrite called |
261 |
|
|
|
262 |
|
|
IF (do_oper.OR.do_write) THEN |
263 |
|
|
|
264 |
guez |
31 |
!- 5.1 Get the sizes of the data we will handle |
265 |
guez |
30 |
|
266 |
|
|
IF (datasz_in(pfileid, varid, 1) <= 0) THEN |
267 |
guez |
31 |
!--- There is the risk here that the user has over-sized the array. |
268 |
|
|
!--- But how can we catch this ? |
269 |
|
|
!--- In the worst case we will do impossible operations |
270 |
|
|
!--- on part of the data ! |
271 |
guez |
30 |
datasz_in(pfileid, varid, 1) = SIZE(pdata, DIM=1) |
272 |
|
|
datasz_in(pfileid, varid, 2) = SIZE(pdata, DIM=2) |
273 |
|
|
datasz_in(pfileid, varid, 3) = -1 |
274 |
|
|
ENDIF |
275 |
|
|
|
276 |
guez |
31 |
!- 5.2 The maximum size of the data will give the size of the buffer |
277 |
guez |
30 |
|
278 |
|
|
IF (datasz_max(pfileid, varid) <= 0) THEN |
279 |
|
|
largebuf = .FALSE. |
280 |
|
|
DO io=1, nbopp(pfileid, varid) |
281 |
|
|
IF (INDEX(fuchnbout, sopps(pfileid, varid, io)) > 0) THEN |
282 |
|
|
largebuf = .TRUE. |
283 |
|
|
ENDIF |
284 |
|
|
ENDDO |
285 |
|
|
IF (largebuf) THEN |
286 |
|
|
datasz_max(pfileid, varid) = & |
287 |
|
|
& scsize(pfileid, varid, 1) & |
288 |
|
|
& *scsize(pfileid, varid, 2) & |
289 |
|
|
& *scsize(pfileid, varid, 3) |
290 |
|
|
ELSE |
291 |
|
|
datasz_max(pfileid, varid) = & |
292 |
|
|
& datasz_in(pfileid, varid, 1) & |
293 |
|
|
& *datasz_in(pfileid, varid, 2) |
294 |
|
|
ENDIF |
295 |
|
|
ENDIF |
296 |
|
|
|
297 |
|
|
IF (.NOT.ALLOCATED(buff_tmp)) THEN |
298 |
|
|
ALLOCATE (buff_tmp(datasz_max(pfileid, varid))) |
299 |
|
|
buff_tmp_sz = datasz_max(pfileid, varid) |
300 |
|
|
ELSE IF (datasz_max(pfileid, varid) > buff_tmp_sz) THEN |
301 |
|
|
DEALLOCATE (buff_tmp) |
302 |
|
|
ALLOCATE (buff_tmp(datasz_max(pfileid, varid))) |
303 |
|
|
buff_tmp_sz = datasz_max(pfileid, varid) |
304 |
|
|
ENDIF |
305 |
|
|
|
306 |
guez |
31 |
!- We have to do the first operation anyway. |
307 |
|
|
!- Thus we do it here and change the ranke |
308 |
|
|
!- of the data at the same time. This should speed up things. |
309 |
guez |
30 |
|
310 |
|
|
nbpt_in(1:2) = datasz_in(pfileid, varid, 1:2) |
311 |
|
|
nbpt_out = datasz_max(pfileid, varid) |
312 |
|
|
CALL mathop (sopps(pfileid, varid, 1), nbpt_in, pdata, & |
313 |
|
|
& missing_val, nbindex, nindex, & |
314 |
|
|
& scal(pfileid, varid, 1), nbpt_out, buff_tmp) |
315 |
|
|
CALL histwrite_real (pfileid, varid, pitau, nbpt_out, & |
316 |
|
|
& buff_tmp, nbindex, nindex, do_oper, do_write) |
317 |
|
|
ENDIF |
318 |
|
|
|
319 |
|
|
! 6.0 Manage time steps |
320 |
|
|
|
321 |
|
|
IF ((TRIM(tmp_opp) /= "once").AND.(TRIM(tmp_opp) /= "never")) THEN |
322 |
|
|
last_opp_chk(pfileid, varid) = pitau |
323 |
|
|
last_wrt_chk(pfileid, varid) = pitau |
324 |
|
|
ELSE |
325 |
|
|
last_opp_chk(pfileid, varid) = -99 |
326 |
|
|
last_wrt_chk(pfileid, varid) = -99 |
327 |
|
|
ENDIF |
328 |
guez |
31 |
!-------------------------- |
329 |
guez |
30 |
END SUBROUTINE histwrite_r2d |
330 |
|
|
|
331 |
|
|
!=== |
332 |
|
|
|
333 |
|
|
SUBROUTINE histwrite_r3d (pfileid, pvarname, pitau, pdata) |
334 |
guez |
31 |
!-------------------------------------------------------------------- |
335 |
guez |
30 |
|
336 |
|
|
use calendar, only: isittime |
337 |
|
|
USE errioipsl, ONLY : histerr |
338 |
guez |
32 |
USE mathop_m, ONLY : mathop |
339 |
guez |
31 |
use histcom_var |
340 |
guez |
45 |
use histvar_seq_m, only: histvar_seq |
341 |
|
|
use histwrite_real_m, only: histwrite_real |
342 |
guez |
30 |
|
343 |
|
|
INTEGER, INTENT(IN) :: pfileid, pitau |
344 |
|
|
REAL, DIMENSION(:, :, :), INTENT(IN) :: pdata |
345 |
|
|
CHARACTER(LEN=*), INTENT(IN) :: pvarname |
346 |
|
|
|
347 |
|
|
integer nbindex, nindex(size(pdata)) |
348 |
|
|
LOGICAL :: do_oper, do_write, largebuf |
349 |
|
|
INTEGER :: varid, io, nbpt_in(1:3), nbpt_out |
350 |
|
|
REAL, ALLOCATABLE, SAVE :: buff_tmp(:) |
351 |
|
|
INTEGER, SAVE :: buff_tmp_sz |
352 |
|
|
CHARACTER(LEN=7) :: tmp_opp |
353 |
|
|
|
354 |
guez |
31 |
!-------------------------------------------------------------------- |
355 |
guez |
30 |
|
356 |
|
|
nbindex = size(nindex) |
357 |
|
|
nindex = 0 |
358 |
|
|
|
359 |
|
|
! 1.0 Try to catch errors like specifying the wrong file ID. |
360 |
|
|
! Thanks Marine for showing us what errors users can make ! |
361 |
|
|
|
362 |
|
|
IF ( (pfileid < 1).OR.(pfileid > nb_files) ) THEN |
363 |
|
|
CALL histerr (3, "histwrite", & |
364 |
|
|
& 'Illegal file ID in the histwrite of variable', pvarname, ' ') |
365 |
|
|
ENDIF |
366 |
|
|
|
367 |
|
|
! 1.1 Find the id of the variable to be written and the real time |
368 |
|
|
|
369 |
|
|
CALL histvar_seq (pfileid, pvarname, varid) |
370 |
|
|
|
371 |
|
|
! 2.0 do nothing for never operation |
372 |
|
|
|
373 |
|
|
tmp_opp = topp(pfileid, varid) |
374 |
|
|
|
375 |
|
|
IF (TRIM(tmp_opp) == "never") THEN |
376 |
|
|
last_opp_chk(pfileid, varid) = -99 |
377 |
|
|
last_wrt_chk(pfileid, varid) = -99 |
378 |
|
|
ENDIF |
379 |
|
|
|
380 |
|
|
! 3.0 We check if we need to do an operation |
381 |
|
|
|
382 |
|
|
IF (last_opp_chk(pfileid, varid) == pitau) THEN |
383 |
|
|
CALL histerr (3, "histwrite", & |
384 |
|
|
& 'This variable as already been analysed at the present', & |
385 |
|
|
& 'time step', ' ') |
386 |
|
|
ENDIF |
387 |
|
|
|
388 |
|
|
CALL isittime & |
389 |
|
|
& (pitau, date0(pfileid), deltat(pfileid), freq_opp(pfileid, varid), & |
390 |
|
|
& last_opp(pfileid, varid), last_opp_chk(pfileid, varid), do_oper) |
391 |
|
|
|
392 |
|
|
! 4.0 We check if we need to write the data |
393 |
|
|
|
394 |
|
|
IF (last_wrt_chk(pfileid, varid) == pitau) THEN |
395 |
|
|
CALL histerr (3, "histwrite", & |
396 |
|
|
& 'This variable as already been written for the present', & |
397 |
|
|
& 'time step', ' ') |
398 |
|
|
ENDIF |
399 |
|
|
|
400 |
|
|
CALL isittime & |
401 |
|
|
& (pitau, date0(pfileid), deltat(pfileid), freq_wrt(pfileid, varid), & |
402 |
|
|
& last_wrt(pfileid, varid), last_wrt_chk(pfileid, varid), do_write) |
403 |
|
|
|
404 |
|
|
! 5.0 histwrite called |
405 |
|
|
|
406 |
|
|
IF (do_oper.OR.do_write) THEN |
407 |
|
|
|
408 |
guez |
31 |
!- 5.1 Get the sizes of the data we will handle |
409 |
guez |
30 |
|
410 |
|
|
IF (datasz_in(pfileid, varid, 1) <= 0) THEN |
411 |
guez |
31 |
!--- There is the risk here that the user has over-sized the array. |
412 |
|
|
!--- But how can we catch this ? |
413 |
|
|
!--- In the worst case we will do impossible operations |
414 |
|
|
!--- on part of the data ! |
415 |
guez |
30 |
datasz_in(pfileid, varid, 1) = SIZE(pdata, DIM=1) |
416 |
|
|
datasz_in(pfileid, varid, 2) = SIZE(pdata, DIM=2) |
417 |
|
|
datasz_in(pfileid, varid, 3) = SIZE(pdata, DIM=3) |
418 |
|
|
ENDIF |
419 |
|
|
|
420 |
guez |
31 |
!- 5.2 The maximum size of the data will give the size of the buffer |
421 |
guez |
30 |
|
422 |
|
|
IF (datasz_max(pfileid, varid) <= 0) THEN |
423 |
|
|
largebuf = .FALSE. |
424 |
|
|
DO io =1, nbopp(pfileid, varid) |
425 |
|
|
IF (INDEX(fuchnbout, sopps(pfileid, varid, io)) > 0) THEN |
426 |
|
|
largebuf = .TRUE. |
427 |
|
|
ENDIF |
428 |
|
|
ENDDO |
429 |
|
|
IF (largebuf) THEN |
430 |
|
|
datasz_max(pfileid, varid) = & |
431 |
|
|
& scsize(pfileid, varid, 1) & |
432 |
|
|
& *scsize(pfileid, varid, 2) & |
433 |
|
|
& *scsize(pfileid, varid, 3) |
434 |
|
|
ELSE |
435 |
|
|
datasz_max(pfileid, varid) = & |
436 |
|
|
& datasz_in(pfileid, varid, 1) & |
437 |
|
|
& *datasz_in(pfileid, varid, 2) & |
438 |
|
|
& *datasz_in(pfileid, varid, 3) |
439 |
|
|
ENDIF |
440 |
|
|
ENDIF |
441 |
|
|
|
442 |
|
|
IF (.NOT.ALLOCATED(buff_tmp)) THEN |
443 |
|
|
ALLOCATE (buff_tmp(datasz_max(pfileid, varid))) |
444 |
|
|
buff_tmp_sz = datasz_max(pfileid, varid) |
445 |
|
|
ELSE IF (datasz_max(pfileid, varid) > buff_tmp_sz) THEN |
446 |
|
|
DEALLOCATE (buff_tmp) |
447 |
|
|
ALLOCATE (buff_tmp(datasz_max(pfileid, varid))) |
448 |
|
|
buff_tmp_sz = datasz_max(pfileid, varid) |
449 |
|
|
ENDIF |
450 |
|
|
|
451 |
guez |
31 |
!- We have to do the first operation anyway. |
452 |
|
|
!- Thus we do it here and change the ranke |
453 |
|
|
!- of the data at the same time. This should speed up things. |
454 |
guez |
30 |
|
455 |
|
|
nbpt_in(1:3) = datasz_in(pfileid, varid, 1:3) |
456 |
|
|
nbpt_out = datasz_max(pfileid, varid) |
457 |
|
|
CALL mathop (sopps(pfileid, varid, 1), nbpt_in, pdata, & |
458 |
|
|
& missing_val, nbindex, nindex, & |
459 |
|
|
& scal(pfileid, varid, 1), nbpt_out, buff_tmp) |
460 |
|
|
CALL histwrite_real (pfileid, varid, pitau, nbpt_out, & |
461 |
|
|
& buff_tmp, nbindex, nindex, do_oper, do_write) |
462 |
|
|
ENDIF |
463 |
|
|
|
464 |
|
|
! 6.0 Manage time steps |
465 |
|
|
|
466 |
|
|
IF ((TRIM(tmp_opp) /= "once").AND.(TRIM(tmp_opp) /= "never")) THEN |
467 |
|
|
last_opp_chk(pfileid, varid) = pitau |
468 |
|
|
last_wrt_chk(pfileid, varid) = pitau |
469 |
|
|
ELSE |
470 |
|
|
last_opp_chk(pfileid, varid) = -99 |
471 |
|
|
last_wrt_chk(pfileid, varid) = -99 |
472 |
|
|
ENDIF |
473 |
guez |
31 |
!-------------------------- |
474 |
guez |
30 |
END SUBROUTINE histwrite_r3d |
475 |
|
|
|
476 |
|
|
END MODULE histwrite_m |