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

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

Parent Directory Parent Directory | Revision Log Revision Log

Revision 62 - (hide annotations)
Thu Jul 26 14:37:37 2012 UTC (11 years, 9 months ago) by guez
File size: 16407 byte(s) 
Changed handling of compiler in compilation system.

Removed the prefix letters "y", "p", "t" or "z" in some names of variables.

Replaced calls to NetCDF by calls to NetCDF95.

Extracted "ioget_calendar" procedures from "calendar.f90" into a
separate file.

Extracted to a separate file, "mathop2.f90", procedures that were not
part of the generic interface "mathop" in "mathop.f90".

Removed computation of "dq" in "bilan_dyn", which was not used.

In "iniadvtrac", removed schemes 20 Slopes and 30 Prather. Was not
compatible with declarations of array sizes.

In "clcdrag", "ustarhb", "vdif_kcay", "yamada4" and "coefkz", changed
the size of some arrays from "klon" to "knon".

Removed possible call to "conema3" in "physiq".

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