/[lmdze]/trunk/Sources/IOIPSL/histwrite.f
ViewVC logotype

Annotation of /trunk/Sources/IOIPSL/histwrite.f

Parent Directory Parent Directory | Revision Log Revision Log

Revision 68 - (hide annotations)
Wed Nov 14 16:59:30 2012 UTC (11 years, 6 months ago) by guez
Original Path: trunk/libf/IOIPSL/histwrite.f90
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 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 guez 62 ! INTEGER, INTENT(IN):: fileid
17 guez 30 ! 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 guez 62 ! CHARACTER(LEN=*), INTENT(IN):: varname
21 guez 30 ! short name of the variable
22    
23 guez 62 ! INTEGER, INTENT(IN):: itau
24 guez 30 ! 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 guez 67 END INTERFACE histwrite
33 guez 30
34 guez 45 PRIVATE histwrite_r1d, histwrite_r2d, histwrite_r3d
35    
36 guez 30 CONTAINS
37    
38 guez 62 SUBROUTINE histwrite_r1d(fileid, varname, itau, pdata)
39 guez 30
40 guez 57 USE errioipsl, ONLY: histerr
41 guez 30 use calendar, only: isittime
42 guez 57 USE mathop_m, ONLY: mathop
43     USE histcom_var, ONLY: datasz_in, datasz_max, date0, deltat, &
44 guez 56 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 guez 45 use histvar_seq_m, only: histvar_seq
48     use histwrite_real_m, only: histwrite_real
49 guez 30
50 guez 62 INTEGER, INTENT(IN):: fileid, itau
51     CHARACTER(LEN=*), INTENT(IN):: varname
52 guez 56 REAL, INTENT(IN):: pdata(:)
53 guez 30
54     ! Variables local to the procedure:
55     integer nbindex, nindex(size(pdata))
56 guez 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 guez 30
62 guez 31 !--------------------------------------------------------------------
63 guez 30
64     nbindex = size(nindex)
65     nindex = 0
66    
67     ! 1.0 Try to catch errors like specifying the wrong file ID.
68    
69 guez 67 IF ((fileid < 1) .OR. (fileid > nb_files)) THEN
70     CALL histerr(3, "histwrite", &
71     'Illegal file ID in the histwrite of variable', varname, ' ')
72 guez 30 ENDIF
73    
74     ! 1.1 Find the id of the variable to be written and the real time
75    
76 guez 67 CALL histvar_seq(fileid, varname, varid)
77 guez 30
78     ! 2.0 do nothing for never operation
79    
80 guez 62 tmp_opp = topp(fileid, varid)
81 guez 30
82     IF (TRIM(tmp_opp) == "never") THEN
83 guez 62 last_opp_chk(fileid, varid) = -99
84     last_wrt_chk(fileid, varid) = -99
85 guez 30 ENDIF
86    
87     ! 3.0 We check if we need to do an operation
88    
89 guez 62 IF (last_opp_chk(fileid, varid) == itau) THEN
90 guez 67 CALL histerr(3, "histwrite", &
91     'This variable as already been analysed at the present', &
92     'time step', ' ')
93 guez 30 ENDIF
94    
95 guez 62 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 guez 30
99     ! 4.0 We check if we need to write the data
100    
101 guez 62 IF (last_wrt_chk(fileid, varid) == itau) THEN
102 guez 67 CALL histerr(3, "histwrite", &
103     'This variable as already been written for the present', &
104     'time step', ' ')
105 guez 30 ENDIF
106    
107 guez 67 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 guez 30
111     ! 5.0 histwrite called
112    
113 guez 67 IF (do_oper .OR. do_write) THEN
114     ! 5.1 Get the sizes of the data we will handle
115 guez 30
116 guez 62 IF (datasz_in(fileid, varid, 1) <= 0) THEN
117 guez 67 ! 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 guez 62 datasz_in(fileid, varid, 1) = SIZE(pdata)
122     datasz_in(fileid, varid, 2) = -1
123     datasz_in(fileid, varid, 3) = -1
124 guez 30 ENDIF
125    
126 guez 67 ! 5.2 The maximum size of the data will give the size of the buffer
127 guez 30
128 guez 62 IF (datasz_max(fileid, varid) <= 0) THEN
129 guez 30 largebuf = .FALSE.
130 guez 62 DO io=1, nbopp(fileid, varid)
131     IF (INDEX(fuchnbout, sopps(fileid, varid, io)) > 0) THEN
132 guez 30 largebuf = .TRUE.
133     ENDIF
134     ENDDO
135     IF (largebuf) THEN
136 guez 67 datasz_max(fileid, varid) = scsize(fileid, varid, 1) &
137     * scsize(fileid, varid, 2) *scsize(fileid, varid, 3)
138 guez 30 ELSE
139 guez 67 datasz_max(fileid, varid) = datasz_in(fileid, varid, 1)
140 guez 30 ENDIF
141     ENDIF
142    
143     IF (.NOT.ALLOCATED(buff_tmp)) THEN
144 guez 67 ALLOCATE(buff_tmp(datasz_max(fileid, varid)))
145 guez 62 buff_tmp_sz = datasz_max(fileid, varid)
146     ELSE IF (datasz_max(fileid, varid) > buff_tmp_sz) THEN
147 guez 67 DEALLOCATE(buff_tmp)
148     ALLOCATE(buff_tmp(datasz_max(fileid, varid)))
149 guez 62 buff_tmp_sz = datasz_max(fileid, varid)
150 guez 30 ENDIF
151    
152 guez 67 ! 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 guez 30
156 guez 62 nbpt_in = datasz_in(fileid, varid, 1)
157     nbpt_out = datasz_max(fileid, varid)
158 guez 67 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 guez 30 ENDIF
163    
164     ! 6.0 Manage time steps
165    
166 guez 67 IF ((TRIM(tmp_opp) /= "once") .AND. (TRIM(tmp_opp) /= "never")) THEN
167 guez 62 last_opp_chk(fileid, varid) = itau
168     last_wrt_chk(fileid, varid) = itau
169 guez 30 ELSE
170 guez 62 last_opp_chk(fileid, varid) = -99
171     last_wrt_chk(fileid, varid) = -99
172 guez 30 ENDIF
173 guez 56
174 guez 30 END SUBROUTINE histwrite_r1d
175    
176 guez 56 !************************************************************************
177 guez 30
178 guez 62 SUBROUTINE histwrite_r2d (fileid, varname, itau, pdata)
179 guez 30
180     use calendar, only: isittime
181 guez 57 USE errioipsl, ONLY: histerr
182     USE mathop_m, ONLY: mathop
183     USE histcom_var, ONLY: datasz_in, datasz_max, date0, deltat, &
184 guez 56 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 guez 45 use histvar_seq_m, only: histvar_seq
188     use histwrite_real_m, only: histwrite_real
189 guez 30
190 guez 62 INTEGER, INTENT(IN):: fileid, itau
191 guez 56 REAL, INTENT(IN):: pdata(:, :)
192 guez 62 CHARACTER(LEN=*), INTENT(IN):: varname
193 guez 30
194     integer nbindex, nindex(size(pdata))
195 guez 56 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 guez 30
201 guez 31 !--------------------------------------------------------------------
202 guez 30
203     nbindex = size(nindex)
204     nindex = 0
205    
206     ! 1.0 Try to catch errors like specifying the wrong file ID.
207    
208 guez 62 IF ( (fileid < 1).OR.(fileid > nb_files) ) THEN
209 guez 30 CALL histerr (3, "histwrite", &
210 guez 67 'Illegal file ID in the histwrite of variable', varname, ' ')
211 guez 30 ENDIF
212    
213     ! 1.1 Find the id of the variable to be written and the real time
214    
215 guez 62 CALL histvar_seq (fileid, varname, varid)
216 guez 30
217     ! 2.0 do nothing for never operation
218    
219 guez 62 tmp_opp = topp(fileid, varid)
220 guez 30
221     IF (TRIM(tmp_opp) == "never") THEN
222 guez 62 last_opp_chk(fileid, varid) = -99
223     last_wrt_chk(fileid, varid) = -99
224 guez 30 ENDIF
225    
226     ! 3.0 We check if we need to do an operation
227    
228 guez 68 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 guez 30
232 guez 68 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 guez 30
236     ! 4.0 We check if we need to write the data
237    
238 guez 62 IF (last_wrt_chk(fileid, varid) == itau) THEN
239 guez 30 CALL histerr (3, "histwrite", &
240 guez 67 'This variable as already been written for the present', &
241     'time step', ' ')
242 guez 30 ENDIF
243    
244     CALL isittime &
245 guez 67 (itau, date0(fileid), deltat(fileid), freq_wrt(fileid, varid), &
246     last_wrt(fileid, varid), last_wrt_chk(fileid, varid), do_write)
247 guez 30
248     ! 5.0 histwrite called
249    
250     IF (do_oper.OR.do_write) THEN
251    
252 guez 31 !- 5.1 Get the sizes of the data we will handle
253 guez 30
254 guez 62 IF (datasz_in(fileid, varid, 1) <= 0) THEN
255 guez 31 !--- 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 guez 62 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 guez 30 ENDIF
263    
264 guez 31 !- 5.2 The maximum size of the data will give the size of the buffer
265 guez 30
266 guez 62 IF (datasz_max(fileid, varid) <= 0) THEN
267 guez 30 largebuf = .FALSE.
268 guez 62 DO io=1, nbopp(fileid, varid)
269     IF (INDEX(fuchnbout, sopps(fileid, varid, io)) > 0) THEN
270 guez 30 largebuf = .TRUE.
271     ENDIF
272     ENDDO
273     IF (largebuf) THEN
274 guez 62 datasz_max(fileid, varid) = &
275 guez 67 scsize(fileid, varid, 1) &
276     *scsize(fileid, varid, 2) &
277     *scsize(fileid, varid, 3)
278 guez 30 ELSE
279 guez 62 datasz_max(fileid, varid) = &
280 guez 67 datasz_in(fileid, varid, 1) &
281     *datasz_in(fileid, varid, 2)
282 guez 30 ENDIF
283     ENDIF
284    
285     IF (.NOT.ALLOCATED(buff_tmp)) THEN
286 guez 62 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 guez 30 DEALLOCATE (buff_tmp)
290 guez 62 ALLOCATE (buff_tmp(datasz_max(fileid, varid)))
291     buff_tmp_sz = datasz_max(fileid, varid)
292 guez 30 ENDIF
293    
294 guez 31 !- 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 guez 30
298 guez 62 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 guez 67 missing_val, nbindex, nindex, &
302     scal(fileid, varid, 1), nbpt_out, buff_tmp)
303 guez 62 CALL histwrite_real (fileid, varid, itau, nbpt_out, &
304 guez 67 buff_tmp, nbindex, nindex, do_oper, do_write)
305 guez 30 ENDIF
306    
307     ! 6.0 Manage time steps
308    
309     IF ((TRIM(tmp_opp) /= "once").AND.(TRIM(tmp_opp) /= "never")) THEN
310 guez 62 last_opp_chk(fileid, varid) = itau
311     last_wrt_chk(fileid, varid) = itau
312 guez 30 ELSE
313 guez 62 last_opp_chk(fileid, varid) = -99
314     last_wrt_chk(fileid, varid) = -99
315 guez 30 ENDIF
316 guez 56
317 guez 30 END SUBROUTINE histwrite_r2d
318    
319 guez 56 !************************************************************************
320 guez 30
321 guez 62 SUBROUTINE histwrite_r3d (fileid, varname, itau, pdata)
322 guez 30
323     use calendar, only: isittime
324 guez 57 USE errioipsl, ONLY: histerr
325     USE mathop_m, ONLY: mathop
326     USE histcom_var, ONLY: datasz_in, datasz_max, date0, deltat, &
327 guez 56 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 guez 45 use histvar_seq_m, only: histvar_seq
331     use histwrite_real_m, only: histwrite_real
332 guez 30
333 guez 62 INTEGER, INTENT(IN):: fileid, itau
334 guez 56 REAL, DIMENSION(:, :, :), INTENT(IN):: pdata
335 guez 62 CHARACTER(LEN=*), INTENT(IN):: varname
336 guez 30
337     integer nbindex, nindex(size(pdata))
338 guez 56 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 guez 30
344 guez 31 !--------------------------------------------------------------------
345 guez 30
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 guez 62 IF ( (fileid < 1).OR.(fileid > nb_files) ) THEN
353 guez 30 CALL histerr (3, "histwrite", &
354 guez 67 'Illegal file ID in the histwrite of variable', varname, ' ')
355 guez 30 ENDIF
356    
357     ! 1.1 Find the id of the variable to be written and the real time
358    
359 guez 62 CALL histvar_seq (fileid, varname, varid)
360 guez 30
361     ! 2.0 do nothing for never operation
362    
363 guez 62 tmp_opp = topp(fileid, varid)
364 guez 30
365     IF (TRIM(tmp_opp) == "never") THEN
366 guez 62 last_opp_chk(fileid, varid) = -99
367     last_wrt_chk(fileid, varid) = -99
368 guez 30 ENDIF
369    
370     ! 3.0 We check if we need to do an operation
371    
372 guez 62 IF (last_opp_chk(fileid, varid) == itau) THEN
373 guez 30 CALL histerr (3, "histwrite", &
374 guez 67 'This variable as already been analysed at the present', &
375     'time step', ' ')
376 guez 30 ENDIF
377    
378     CALL isittime &
379 guez 67 (itau, date0(fileid), deltat(fileid), freq_opp(fileid, varid), &
380     last_opp(fileid, varid), last_opp_chk(fileid, varid), do_oper)
381 guez 30
382     ! 4.0 We check if we need to write the data
383    
384 guez 62 IF (last_wrt_chk(fileid, varid) == itau) THEN
385 guez 30 CALL histerr (3, "histwrite", &
386 guez 67 'This variable as already been written for the present', &
387     'time step', ' ')
388 guez 30 ENDIF
389    
390     CALL isittime &
391 guez 67 (itau, date0(fileid), deltat(fileid), freq_wrt(fileid, varid), &
392     last_wrt(fileid, varid), last_wrt_chk(fileid, varid), do_write)
393 guez 30
394     ! 5.0 histwrite called
395    
396     IF (do_oper.OR.do_write) THEN
397    
398 guez 31 !- 5.1 Get the sizes of the data we will handle
399 guez 30
400 guez 62 IF (datasz_in(fileid, varid, 1) <= 0) THEN
401 guez 31 !--- 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 guez 62 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 guez 30 ENDIF
409    
410 guez 31 !- 5.2 The maximum size of the data will give the size of the buffer
411 guez 30
412 guez 62 IF (datasz_max(fileid, varid) <= 0) THEN
413 guez 30 largebuf = .FALSE.
414 guez 62 DO io =1, nbopp(fileid, varid)
415     IF (INDEX(fuchnbout, sopps(fileid, varid, io)) > 0) THEN
416 guez 30 largebuf = .TRUE.
417     ENDIF
418     ENDDO
419     IF (largebuf) THEN
420 guez 62 datasz_max(fileid, varid) = &
421 guez 67 scsize(fileid, varid, 1) &
422     *scsize(fileid, varid, 2) &
423     *scsize(fileid, varid, 3)
424 guez 30 ELSE
425 guez 62 datasz_max(fileid, varid) = &
426 guez 67 datasz_in(fileid, varid, 1) &
427     *datasz_in(fileid, varid, 2) &
428     *datasz_in(fileid, varid, 3)
429 guez 30 ENDIF
430     ENDIF
431    
432     IF (.NOT.ALLOCATED(buff_tmp)) THEN
433 guez 62 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 guez 30 DEALLOCATE (buff_tmp)
437 guez 62 ALLOCATE (buff_tmp(datasz_max(fileid, varid)))
438     buff_tmp_sz = datasz_max(fileid, varid)
439 guez 30 ENDIF
440    
441 guez 31 !- 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 guez 30
445 guez 62 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 guez 67 missing_val, nbindex, nindex, &
449     scal(fileid, varid, 1), nbpt_out, buff_tmp)
450 guez 62 CALL histwrite_real (fileid, varid, itau, nbpt_out, &
451 guez 67 buff_tmp, nbindex, nindex, do_oper, do_write)
452 guez 30 ENDIF
453    
454     ! 6.0 Manage time steps
455    
456     IF ((TRIM(tmp_opp) /= "once").AND.(TRIM(tmp_opp) /= "never")) THEN
457 guez 62 last_opp_chk(fileid, varid) = itau
458     last_wrt_chk(fileid, varid) = itau
459 guez 30 ELSE
460 guez 62 last_opp_chk(fileid, varid) = -99
461     last_wrt_chk(fileid, varid) = -99
462 guez 30 ENDIF
463 guez 56
464 guez 30 END SUBROUTINE histwrite_r3d
465    
466     END MODULE histwrite_m
  ViewVC Help
Powered by ViewVC 1.1.21