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

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

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

revision 62 by guez, Thu Jul 26 14:37:37 2012 UTC revision 67 by guez, Tue Oct 2 15:50:56 2012 UTC
# Line 29  MODULE histwrite_m Line 29  MODULE histwrite_m
29       ! The difference between the procedures is the rank of "pdata".       ! The difference between the procedures is the rank of "pdata".
30    
31       MODULE PROCEDURE histwrite_r1d, histwrite_r2d, histwrite_r3d       MODULE PROCEDURE histwrite_r1d, histwrite_r2d, histwrite_r3d
32    END INTERFACE    END INTERFACE histwrite
33    
34    PRIVATE histwrite_r1d, histwrite_r2d, histwrite_r3d    PRIVATE histwrite_r1d, histwrite_r2d, histwrite_r3d
35    
# 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 ( (fileid < 1).OR.(fileid > 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', varname, ' ')              '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 (fileid, varname, varid)      CALL histvar_seq(fileid, varname, varid)
77    
78      ! 2.0 do nothing for never operation      ! 2.0 do nothing for never operation
79    
# Line 87  CONTAINS Line 87  CONTAINS
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(fileid, varid) == itau) 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(itau, date0(fileid), deltat(fileid), &      CALL isittime(itau, date0(fileid), deltat(fileid), &
# Line 99  CONTAINS Line 99  CONTAINS
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(fileid, varid) == itau) 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(itau, date0(fileid), deltat(fileid), &
108           &  (itau, date0(fileid), deltat(fileid), freq_wrt(fileid, varid), &           freq_wrt(fileid, varid), last_wrt(fileid, varid), &
109           &   last_wrt(fileid, varid), last_wrt_chk(fileid, varid), do_write)           last_wrt_chk(fileid, varid), do_write)
110    
111      ! 5.0 histwrite called      ! 5.0 histwrite called
112    
113      IF (do_oper.OR.do_write) THEN      IF (do_oper .OR. do_write) THEN
114           ! 5.1 Get the sizes of the data we will handle
        !- 5.1 Get the sizes of the data we will handle  
115    
116         IF (datasz_in(fileid, varid, 1) <= 0) THEN         IF (datasz_in(fileid, varid, 1) <= 0) THEN
117            !--- 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.
118            !--- But how can we catch this ?            ! But how can we catch this ?
119            !--- In the worst case we will do impossible operations            ! In the worst case we will do impossible operations
120            !--- on part of the data !            ! on part of the data !
121            datasz_in(fileid, varid, 1) = SIZE(pdata)            datasz_in(fileid, varid, 1) = SIZE(pdata)
122            datasz_in(fileid, varid, 2) = -1            datasz_in(fileid, varid, 2) = -1
123            datasz_in(fileid, varid, 3) = -1            datasz_in(fileid, varid, 3) = -1
124         ENDIF         ENDIF
125    
126         !- 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
127    
128         IF (datasz_max(fileid, varid) <= 0) THEN         IF (datasz_max(fileid, varid) <= 0) THEN
129            largebuf = .FALSE.            largebuf = .FALSE.
# Line 134  CONTAINS Line 133  CONTAINS
133               ENDIF               ENDIF
134            ENDDO            ENDDO
135            IF (largebuf) THEN            IF (largebuf) THEN
136               datasz_max(fileid, varid) = &               datasz_max(fileid, varid) = scsize(fileid, varid, 1) &
137                    &        scsize(fileid, varid, 1) &                    * scsize(fileid, varid, 2) *scsize(fileid, varid, 3)
                   &       *scsize(fileid, varid, 2) &  
                   &       *scsize(fileid, varid, 3)  
138            ELSE            ELSE
139               datasz_max(fileid, varid) = &               datasz_max(fileid, varid) = datasz_in(fileid, varid, 1)
                   &        datasz_in(fileid, varid, 1)  
140            ENDIF            ENDIF
141         ENDIF         ENDIF
142    
143         IF (.NOT.ALLOCATED(buff_tmp)) THEN         IF (.NOT.ALLOCATED(buff_tmp)) THEN
144            ALLOCATE (buff_tmp(datasz_max(fileid, varid)))            ALLOCATE(buff_tmp(datasz_max(fileid, varid)))
145            buff_tmp_sz = datasz_max(fileid, varid)            buff_tmp_sz = datasz_max(fileid, varid)
146         ELSE IF (datasz_max(fileid, varid) > buff_tmp_sz) THEN         ELSE IF (datasz_max(fileid, varid) > buff_tmp_sz) THEN
147            DEALLOCATE (buff_tmp)            DEALLOCATE(buff_tmp)
148            ALLOCATE (buff_tmp(datasz_max(fileid, varid)))            ALLOCATE(buff_tmp(datasz_max(fileid, varid)))
149            buff_tmp_sz = datasz_max(fileid, varid)            buff_tmp_sz = datasz_max(fileid, varid)
150         ENDIF         ENDIF
151    
152         !- We have to do the first operation anyway.         ! We have to do the first operation anyway. Thus we do it here
153         !- Thus we do it here and change the ranke         ! and change the ranke of the data at the same time. This
154         !- of the data at the same time. This should speed up things.         ! should speed up things.
155    
156         nbpt_in = datasz_in(fileid, varid, 1)         nbpt_in = datasz_in(fileid, varid, 1)
157         nbpt_out = datasz_max(fileid, varid)         nbpt_out = datasz_max(fileid, varid)
158         CALL mathop (sopps(fileid, varid, 1), nbpt_in, pdata, &         CALL mathop(sopps(fileid, varid, 1), nbpt_in, pdata, missing_val, &
159              &               missing_val, nbindex, nindex, &              nbindex, nindex, scal(fileid, varid, 1), nbpt_out, buff_tmp)
160              &               scal(fileid, varid, 1), nbpt_out, buff_tmp)         CALL histwrite_real(fileid, varid, itau, nbpt_out, buff_tmp, nbindex, &
161         CALL histwrite_real (fileid, varid, itau, nbpt_out, &              nindex, do_oper, do_write)
             &            buff_tmp, nbindex, nindex, do_oper, do_write)  
162      ENDIF      ENDIF
163    
164      ! 6.0 Manage time steps      ! 6.0 Manage time steps
165    
166      IF ((TRIM(tmp_opp) /= "once").AND.(TRIM(tmp_opp) /= "never")) THEN      IF ((TRIM(tmp_opp) /= "once") .AND. (TRIM(tmp_opp) /= "never")) THEN
167         last_opp_chk(fileid, varid) = itau         last_opp_chk(fileid, varid) = itau
168         last_wrt_chk(fileid, varid) = itau         last_wrt_chk(fileid, varid) = itau
169      ELSE      ELSE
# Line 212  CONTAINS Line 207  CONTAINS
207    
208      IF ( (fileid < 1).OR.(fileid > nb_files) ) THEN      IF ( (fileid < 1).OR.(fileid > nb_files) ) THEN
209         CALL histerr (3, "histwrite", &         CALL histerr (3, "histwrite", &
210              &    'Illegal file ID in the histwrite of variable', varname, ' ')              'Illegal file ID in the histwrite of variable', varname, ' ')
211      ENDIF      ENDIF
212    
213      ! 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
# Line 232  CONTAINS Line 227  CONTAINS
227    
228      IF (last_opp_chk(fileid, varid) == itau) THEN      IF (last_opp_chk(fileid, varid) == itau) THEN
229         CALL histerr (3, "histwrite", &         CALL histerr (3, "histwrite", &
230              &    'This variable as already been analysed at the present', &              'This variable as already been analysed at the present', &
231              &    'time step', ' ')              'time step', ' ')
232      ENDIF      ENDIF
233    
234      CALL isittime &      CALL isittime &
235           &  (itau, date0(fileid), deltat(fileid), freq_opp(fileid, varid), &           (itau, date0(fileid), deltat(fileid), freq_opp(fileid, varid), &
236           &   last_opp(fileid, varid), last_opp_chk(fileid, varid), do_oper)           last_opp(fileid, varid), last_opp_chk(fileid, varid), do_oper)
237    
238      ! 4.0 We check if we need to write the data      ! 4.0 We check if we need to write the data
239    
240      IF (last_wrt_chk(fileid, varid) == itau) THEN      IF (last_wrt_chk(fileid, varid) == itau) THEN
241         CALL histerr (3, "histwrite", &         CALL histerr (3, "histwrite", &
242              &    'This variable as already been written for the present', &              'This variable as already been written for the present', &
243              &    'time step', ' ')              'time step', ' ')
244      ENDIF      ENDIF
245    
246      CALL isittime &      CALL isittime &
247           &  (itau, date0(fileid), deltat(fileid), freq_wrt(fileid, varid), &           (itau, date0(fileid), deltat(fileid), freq_wrt(fileid, varid), &
248           &   last_wrt(fileid, varid), last_wrt_chk(fileid, varid), do_write)           last_wrt(fileid, varid), last_wrt_chk(fileid, varid), do_write)
249    
250      ! 5.0 histwrite called      ! 5.0 histwrite called
251    
# Line 279  CONTAINS Line 274  CONTAINS
274            ENDDO            ENDDO
275            IF (largebuf) THEN            IF (largebuf) THEN
276               datasz_max(fileid, varid) = &               datasz_max(fileid, varid) = &
277                    &        scsize(fileid, varid, 1) &                    scsize(fileid, varid, 1) &
278                    &       *scsize(fileid, varid, 2) &                    *scsize(fileid, varid, 2) &
279                    &       *scsize(fileid, varid, 3)                    *scsize(fileid, varid, 3)
280            ELSE            ELSE
281               datasz_max(fileid, varid) = &               datasz_max(fileid, varid) = &
282                    &        datasz_in(fileid, varid, 1) &                    datasz_in(fileid, varid, 1) &
283                    &       *datasz_in(fileid, varid, 2)                    *datasz_in(fileid, varid, 2)
284            ENDIF            ENDIF
285         ENDIF         ENDIF
286    
# Line 305  CONTAINS Line 300  CONTAINS
300         nbpt_in(1:2) = datasz_in(fileid, varid, 1:2)         nbpt_in(1:2) = datasz_in(fileid, varid, 1:2)
301         nbpt_out = datasz_max(fileid, varid)         nbpt_out = datasz_max(fileid, varid)
302         CALL mathop (sopps(fileid, varid, 1), nbpt_in, pdata, &         CALL mathop (sopps(fileid, varid, 1), nbpt_in, pdata, &
303              &               missing_val, nbindex, nindex, &              missing_val, nbindex, nindex, &
304              &               scal(fileid, varid, 1), nbpt_out, buff_tmp)              scal(fileid, varid, 1), nbpt_out, buff_tmp)
305         CALL histwrite_real (fileid, varid, itau, nbpt_out, &         CALL histwrite_real (fileid, varid, itau, nbpt_out, &
306              &            buff_tmp, nbindex, nindex, do_oper, do_write)              buff_tmp, nbindex, nindex, do_oper, do_write)
307      ENDIF      ENDIF
308    
309      ! 6.0 Manage time steps      ! 6.0 Manage time steps
# Line 358  CONTAINS Line 353  CONTAINS
353    
354      IF ( (fileid < 1).OR.(fileid > nb_files) ) THEN      IF ( (fileid < 1).OR.(fileid > nb_files) ) THEN
355         CALL histerr (3, "histwrite", &         CALL histerr (3, "histwrite", &
356              &    'Illegal file ID in the histwrite of variable', varname, ' ')              'Illegal file ID in the histwrite of variable', varname, ' ')
357      ENDIF      ENDIF
358    
359      ! 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
# Line 378  CONTAINS Line 373  CONTAINS
373    
374      IF (last_opp_chk(fileid, varid) == itau) THEN      IF (last_opp_chk(fileid, varid) == itau) THEN
375         CALL histerr (3, "histwrite", &         CALL histerr (3, "histwrite", &
376              &    'This variable as already been analysed at the present', &              'This variable as already been analysed at the present', &
377              &    'time step', ' ')              'time step', ' ')
378      ENDIF      ENDIF
379    
380      CALL isittime &      CALL isittime &
381           &  (itau, date0(fileid), deltat(fileid), freq_opp(fileid, varid), &           (itau, date0(fileid), deltat(fileid), freq_opp(fileid, varid), &
382           &   last_opp(fileid, varid), last_opp_chk(fileid, varid), do_oper)           last_opp(fileid, varid), last_opp_chk(fileid, varid), do_oper)
383    
384      ! 4.0 We check if we need to write the data      ! 4.0 We check if we need to write the data
385    
386      IF (last_wrt_chk(fileid, varid) == itau) THEN      IF (last_wrt_chk(fileid, varid) == itau) THEN
387         CALL histerr (3, "histwrite", &         CALL histerr (3, "histwrite", &
388              &    'This variable as already been written for the present', &              'This variable as already been written for the present', &
389              &    'time step', ' ')              'time step', ' ')
390      ENDIF      ENDIF
391    
392      CALL isittime &      CALL isittime &
393           &  (itau, date0(fileid), deltat(fileid), freq_wrt(fileid, varid), &           (itau, date0(fileid), deltat(fileid), freq_wrt(fileid, varid), &
394           &   last_wrt(fileid, varid), last_wrt_chk(fileid, varid), do_write)           last_wrt(fileid, varid), last_wrt_chk(fileid, varid), do_write)
395    
396      ! 5.0 histwrite called      ! 5.0 histwrite called
397    
# Line 425  CONTAINS Line 420  CONTAINS
420            ENDDO            ENDDO
421            IF (largebuf) THEN            IF (largebuf) THEN
422               datasz_max(fileid, varid) = &               datasz_max(fileid, varid) = &
423                    &        scsize(fileid, varid, 1) &                    scsize(fileid, varid, 1) &
424                    &       *scsize(fileid, varid, 2) &                    *scsize(fileid, varid, 2) &
425                    &       *scsize(fileid, varid, 3)                    *scsize(fileid, varid, 3)
426            ELSE            ELSE
427               datasz_max(fileid, varid) = &               datasz_max(fileid, varid) = &
428                    &        datasz_in(fileid, varid, 1) &                    datasz_in(fileid, varid, 1) &
429                    &       *datasz_in(fileid, varid, 2) &                    *datasz_in(fileid, varid, 2) &
430                    &       *datasz_in(fileid, varid, 3)                    *datasz_in(fileid, varid, 3)
431            ENDIF            ENDIF
432         ENDIF         ENDIF
433    
# Line 452  CONTAINS Line 447  CONTAINS
447         nbpt_in(1:3) = datasz_in(fileid, varid, 1:3)         nbpt_in(1:3) = datasz_in(fileid, varid, 1:3)
448         nbpt_out = datasz_max(fileid, varid)         nbpt_out = datasz_max(fileid, varid)
449         CALL mathop (sopps(fileid, varid, 1), nbpt_in, pdata, &         CALL mathop (sopps(fileid, varid, 1), nbpt_in, pdata, &
450              &               missing_val, nbindex, nindex, &              missing_val, nbindex, nindex, &
451              &               scal(fileid, varid, 1), nbpt_out, buff_tmp)              scal(fileid, varid, 1), nbpt_out, buff_tmp)
452         CALL histwrite_real (fileid, varid, itau, nbpt_out, &         CALL histwrite_real (fileid, varid, itau, nbpt_out, &
453              &            buff_tmp, nbindex, nindex, do_oper, do_write)              buff_tmp, nbindex, nindex, do_oper, do_write)
454      ENDIF      ENDIF
455    
456      ! 6.0 Manage time steps      ! 6.0 Manage time steps
Legend:
Removed from v.62  
changed lines
  Added in v.67
  ViewVC Help
Powered by ViewVC 1.1.21