/[lmdze]/trunk/libf/IOIPSL/histwrite.f90
ViewVC logotype

Contents of /trunk/libf/IOIPSL/histwrite.f90

Parent Directory Parent Directory | Revision Log Revision Log

Revision 68 - (show annotations)
Wed Nov 14 16:59:30 2012 UTC (11 years, 6 months ago) by guez
File size: 15920 byte(s) 
Split "flincom.f90" into "flinclo.f90", "flinfindcood.f90",
"flininfo.f90" and "flinopen_nozoom.f90", in directory
"IOIPSL/Flincom".

Renamed "etat0_lim" to "ce0l", as in LMDZ.

Split "readsulfate.f" into "readsulfate.f90", "readsulfate_preind.f90"
and "getso4fromfile.f90".

In etat0, renamed variable q3d to q, as in "dynredem1". Replaced calls
to Flicom procedures by calls to NetCDF95.

In leapfrog, added call to writehist.

Extracted ASCII art from "grid_noro" into a file
"grid_noro.txt". Transformed explicit-shape local arrays into
automatic arrays, so that test on values of iim and jjm is no longer
needed. Test on weight:
          IF (weight(ii, jj) /= 0.) THEN
is useless. There is already a test before:
    if (any(weight == 0.)) stop "zero weight in grid_noro"

In "aeropt", replaced duplicated lines with different values of inu by
a loop on inu.

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