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

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

Parent Directory Parent Directory | Revision Log Revision Log

Revision 57 - (hide annotations)
Mon Jan 30 12:54:02 2012 UTC (12 years, 3 months ago) by guez
Original Path: trunk/libf/IOIPSL/histwrite.f90
File size: 16601 byte(s) 
Write used namelists to file "" instead of standard output.

Avoid aliasing in "inidissip" in calls to "divgrad2", "divgrad",
"gradiv2", "gradiv", "nxgraro2" and "nxgrarot". Add a degenerate
dimension to arrays so they have rank 3, like the dummy arguments in
"divgrad2", "divgrad", "gradiv2", "gradiv", "nxgraro2" and "nxgrarot".

Extract the initialization part from "bilan_dyn" and make a separate
procedure, "init_dynzon", from it.

Move variables from modules "iniprint" and "logic" to module
"conf_gcm_m".

Promote internal procedures of "fxy" to private procedures of module
"fxy_m".

Extracted documentation from "inigeom". Removed useless "save"
attributes. Removed useless intermediate variables. Extracted
processing of poles from loop on latitudes. Write coordinates to file
"longitude_latitude.txt" instead of standard output.

Do not use ozone tracer for radiative transfer.
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     ! 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     SUBROUTINE histwrite_r1d(pfileid, pvarname, pitau, pdata)
39    
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 56 INTEGER, INTENT(IN):: pfileid, pitau
51 guez 57 CHARACTER(LEN=*), INTENT(IN):: pvarname
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     IF ( (pfileid < 1).OR.(pfileid > nb_files) ) THEN
70     CALL histerr (3, "histwrite", &
71     & 'Illegal file ID in the histwrite of variable', pvarname, ' ')
72     ENDIF
73    
74     ! 1.1 Find the id of the variable to be written and the real time
75    
76     CALL histvar_seq (pfileid, pvarname, varid)
77    
78     ! 2.0 do nothing for never operation
79    
80     tmp_opp = topp(pfileid, varid)
81    
82     IF (TRIM(tmp_opp) == "never") THEN
83     last_opp_chk(pfileid, varid) = -99
84     last_wrt_chk(pfileid, varid) = -99
85     ENDIF
86    
87     ! 3.0 We check if we need to do an operation
88    
89     IF (last_opp_chk(pfileid, varid) == pitau) 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 &
96     & (pitau, date0(pfileid), deltat(pfileid), freq_opp(pfileid, varid), &
97     & last_opp(pfileid, varid), last_opp_chk(pfileid, varid), do_oper)
98    
99     ! 4.0 We check if we need to write the data
100    
101     IF (last_wrt_chk(pfileid, varid) == pitau) 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 &
108     & (pitau, date0(pfileid), deltat(pfileid), freq_wrt(pfileid, varid), &
109     & last_wrt(pfileid, varid), last_wrt_chk(pfileid, varid), do_write)
110    
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     IF (datasz_in(pfileid, 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 30 datasz_in(pfileid, varid, 1) = SIZE(pdata)
123     datasz_in(pfileid, varid, 2) = -1
124     datasz_in(pfileid, varid, 3) = -1
125     ENDIF
126    
127 guez 31 !- 5.2 The maximum size of the data will give the size of the buffer
128 guez 30
129     IF (datasz_max(pfileid, varid) <= 0) THEN
130     largebuf = .FALSE.
131     DO io=1, nbopp(pfileid, varid)
132     IF (INDEX(fuchnbout, sopps(pfileid, varid, io)) > 0) THEN
133     largebuf = .TRUE.
134     ENDIF
135     ENDDO
136     IF (largebuf) THEN
137     datasz_max(pfileid, varid) = &
138     & scsize(pfileid, varid, 1) &
139     & *scsize(pfileid, varid, 2) &
140     & *scsize(pfileid, varid, 3)
141     ELSE
142     datasz_max(pfileid, varid) = &
143     & datasz_in(pfileid, varid, 1)
144     ENDIF
145     ENDIF
146    
147     IF (.NOT.ALLOCATED(buff_tmp)) THEN
148     ALLOCATE (buff_tmp(datasz_max(pfileid, varid)))
149     buff_tmp_sz = datasz_max(pfileid, varid)
150     ELSE IF (datasz_max(pfileid, varid) > buff_tmp_sz) THEN
151     DEALLOCATE (buff_tmp)
152     ALLOCATE (buff_tmp(datasz_max(pfileid, varid)))
153     buff_tmp_sz = datasz_max(pfileid, varid)
154     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     nbpt_in = datasz_in(pfileid, varid, 1)
161     nbpt_out = datasz_max(pfileid, varid)
162     CALL mathop (sopps(pfileid, varid, 1), nbpt_in, pdata, &
163     & missing_val, nbindex, nindex, &
164     & scal(pfileid, varid, 1), nbpt_out, buff_tmp)
165     CALL histwrite_real (pfileid, varid, pitau, nbpt_out, &
166     & 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     last_opp_chk(pfileid, varid) = pitau
173     last_wrt_chk(pfileid, varid) = pitau
174     ELSE
175     last_opp_chk(pfileid, varid) = -99
176     last_wrt_chk(pfileid, varid) = -99
177     ENDIF
178 guez 56
179 guez 30 END SUBROUTINE histwrite_r1d
180    
181 guez 56 !************************************************************************
182 guez 30
183     SUBROUTINE histwrite_r2d (pfileid, pvarname, pitau, pdata)
184    
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 56 INTEGER, INTENT(IN):: pfileid, pitau
196     REAL, INTENT(IN):: pdata(:, :)
197     CHARACTER(LEN=*), INTENT(IN):: pvarname
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     IF ( (pfileid < 1).OR.(pfileid > nb_files) ) THEN
214     CALL histerr (3, "histwrite", &
215     & 'Illegal file ID in the histwrite of variable', pvarname, ' ')
216     ENDIF
217    
218     ! 1.1 Find the id of the variable to be written and the real time
219    
220     CALL histvar_seq (pfileid, pvarname, varid)
221    
222     ! 2.0 do nothing for never operation
223    
224     tmp_opp = topp(pfileid, varid)
225    
226     IF (TRIM(tmp_opp) == "never") THEN
227     last_opp_chk(pfileid, varid) = -99
228     last_wrt_chk(pfileid, varid) = -99
229     ENDIF
230    
231     ! 3.0 We check if we need to do an operation
232    
233     IF (last_opp_chk(pfileid, varid) == pitau) THEN
234     CALL histerr (3, "histwrite", &
235     & 'This variable as already been analysed at the present', &
236     & 'time step', ' ')
237     ENDIF
238    
239     CALL isittime &
240     & (pitau, date0(pfileid), deltat(pfileid), freq_opp(pfileid, varid), &
241     & last_opp(pfileid, varid), last_opp_chk(pfileid, varid), do_oper)
242    
243     ! 4.0 We check if we need to write the data
244    
245     IF (last_wrt_chk(pfileid, varid) == pitau) THEN
246     CALL histerr (3, "histwrite", &
247     & 'This variable as already been written for the present', &
248     & 'time step', ' ')
249     ENDIF
250    
251     CALL isittime &
252     & (pitau, date0(pfileid), deltat(pfileid), freq_wrt(pfileid, varid), &
253     & last_wrt(pfileid, varid), last_wrt_chk(pfileid, varid), do_write)
254    
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     IF (datasz_in(pfileid, 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 30 datasz_in(pfileid, varid, 1) = SIZE(pdata, DIM=1)
267     datasz_in(pfileid, varid, 2) = SIZE(pdata, DIM=2)
268     datasz_in(pfileid, varid, 3) = -1
269     ENDIF
270    
271 guez 31 !- 5.2 The maximum size of the data will give the size of the buffer
272 guez 30
273     IF (datasz_max(pfileid, varid) <= 0) THEN
274     largebuf = .FALSE.
275     DO io=1, nbopp(pfileid, varid)
276     IF (INDEX(fuchnbout, sopps(pfileid, varid, io)) > 0) THEN
277     largebuf = .TRUE.
278     ENDIF
279     ENDDO
280     IF (largebuf) THEN
281     datasz_max(pfileid, varid) = &
282     & scsize(pfileid, varid, 1) &
283     & *scsize(pfileid, varid, 2) &
284     & *scsize(pfileid, varid, 3)
285     ELSE
286     datasz_max(pfileid, varid) = &
287     & datasz_in(pfileid, varid, 1) &
288     & *datasz_in(pfileid, varid, 2)
289     ENDIF
290     ENDIF
291    
292     IF (.NOT.ALLOCATED(buff_tmp)) THEN
293     ALLOCATE (buff_tmp(datasz_max(pfileid, varid)))
294     buff_tmp_sz = datasz_max(pfileid, varid)
295     ELSE IF (datasz_max(pfileid, varid) > buff_tmp_sz) THEN
296     DEALLOCATE (buff_tmp)
297     ALLOCATE (buff_tmp(datasz_max(pfileid, varid)))
298     buff_tmp_sz = datasz_max(pfileid, varid)
299     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     nbpt_in(1:2) = datasz_in(pfileid, varid, 1:2)
306     nbpt_out = datasz_max(pfileid, varid)
307     CALL mathop (sopps(pfileid, varid, 1), nbpt_in, pdata, &
308     & missing_val, nbindex, nindex, &
309     & scal(pfileid, varid, 1), nbpt_out, buff_tmp)
310     CALL histwrite_real (pfileid, varid, pitau, nbpt_out, &
311     & 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     last_opp_chk(pfileid, varid) = pitau
318     last_wrt_chk(pfileid, varid) = pitau
319     ELSE
320     last_opp_chk(pfileid, varid) = -99
321     last_wrt_chk(pfileid, varid) = -99
322     ENDIF
323 guez 56
324 guez 30 END SUBROUTINE histwrite_r2d
325    
326 guez 56 !************************************************************************
327 guez 30
328     SUBROUTINE histwrite_r3d (pfileid, pvarname, pitau, pdata)
329    
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 56 INTEGER, INTENT(IN):: pfileid, pitau
341     REAL, DIMENSION(:, :, :), INTENT(IN):: pdata
342     CHARACTER(LEN=*), INTENT(IN):: pvarname
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     IF ( (pfileid < 1).OR.(pfileid > nb_files) ) THEN
360     CALL histerr (3, "histwrite", &
361     & 'Illegal file ID in the histwrite of variable', pvarname, ' ')
362     ENDIF
363    
364     ! 1.1 Find the id of the variable to be written and the real time
365    
366     CALL histvar_seq (pfileid, pvarname, varid)
367    
368     ! 2.0 do nothing for never operation
369    
370     tmp_opp = topp(pfileid, varid)
371    
372     IF (TRIM(tmp_opp) == "never") THEN
373     last_opp_chk(pfileid, varid) = -99
374     last_wrt_chk(pfileid, varid) = -99
375     ENDIF
376    
377     ! 3.0 We check if we need to do an operation
378    
379     IF (last_opp_chk(pfileid, varid) == pitau) THEN
380     CALL histerr (3, "histwrite", &
381     & 'This variable as already been analysed at the present', &
382     & 'time step', ' ')
383     ENDIF
384    
385     CALL isittime &
386     & (pitau, date0(pfileid), deltat(pfileid), freq_opp(pfileid, varid), &
387     & last_opp(pfileid, varid), last_opp_chk(pfileid, varid), do_oper)
388    
389     ! 4.0 We check if we need to write the data
390    
391     IF (last_wrt_chk(pfileid, varid) == pitau) THEN
392     CALL histerr (3, "histwrite", &
393     & 'This variable as already been written for the present', &
394     & 'time step', ' ')
395     ENDIF
396    
397     CALL isittime &
398     & (pitau, date0(pfileid), deltat(pfileid), freq_wrt(pfileid, varid), &
399     & last_wrt(pfileid, varid), last_wrt_chk(pfileid, varid), do_write)
400    
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     IF (datasz_in(pfileid, 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 30 datasz_in(pfileid, varid, 1) = SIZE(pdata, DIM=1)
413     datasz_in(pfileid, varid, 2) = SIZE(pdata, DIM=2)
414     datasz_in(pfileid, varid, 3) = SIZE(pdata, DIM=3)
415     ENDIF
416    
417 guez 31 !- 5.2 The maximum size of the data will give the size of the buffer
418 guez 30
419     IF (datasz_max(pfileid, varid) <= 0) THEN
420     largebuf = .FALSE.
421     DO io =1, nbopp(pfileid, varid)
422     IF (INDEX(fuchnbout, sopps(pfileid, varid, io)) > 0) THEN
423     largebuf = .TRUE.
424     ENDIF
425     ENDDO
426     IF (largebuf) THEN
427     datasz_max(pfileid, varid) = &
428     & scsize(pfileid, varid, 1) &
429     & *scsize(pfileid, varid, 2) &
430     & *scsize(pfileid, varid, 3)
431     ELSE
432     datasz_max(pfileid, varid) = &
433     & datasz_in(pfileid, varid, 1) &
434     & *datasz_in(pfileid, varid, 2) &
435     & *datasz_in(pfileid, varid, 3)
436     ENDIF
437     ENDIF
438    
439     IF (.NOT.ALLOCATED(buff_tmp)) THEN
440     ALLOCATE (buff_tmp(datasz_max(pfileid, varid)))
441     buff_tmp_sz = datasz_max(pfileid, varid)
442     ELSE IF (datasz_max(pfileid, varid) > buff_tmp_sz) THEN
443     DEALLOCATE (buff_tmp)
444     ALLOCATE (buff_tmp(datasz_max(pfileid, varid)))
445     buff_tmp_sz = datasz_max(pfileid, varid)
446     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     nbpt_in(1:3) = datasz_in(pfileid, varid, 1:3)
453     nbpt_out = datasz_max(pfileid, varid)
454     CALL mathop (sopps(pfileid, varid, 1), nbpt_in, pdata, &
455     & missing_val, nbindex, nindex, &
456     & scal(pfileid, varid, 1), nbpt_out, buff_tmp)
457     CALL histwrite_real (pfileid, varid, pitau, nbpt_out, &
458     & 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     last_opp_chk(pfileid, varid) = pitau
465     last_wrt_chk(pfileid, varid) = pitau
466     ELSE
467     last_opp_chk(pfileid, varid) = -99
468     last_wrt_chk(pfileid, varid) = -99
469     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