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

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

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

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