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

Diff of /trunk/IOIPSL/histwrite.f

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

trunk/libf/IOIPSL/histwrite.f90 revision 62 by guez, Thu Jul 26 14:37:37 2012 UTC trunk/Sources/IOIPSL/histwrite.f revision 134 by guez, Wed Apr 29 15:47:56 2015 UTC
# Line 2  MODULE histwrite_m Line 2  MODULE histwrite_m
2    
3    ! From histcom.f90, version 2.1 2004/04/21 09:27:10    ! From histcom.f90, version 2.1 2004/04/21 09:27:10
4    
5      USE errioipsl, ONLY: histerr
6      USE histcom_var, ONLY: datasz_in, datasz_max, date0, deltat, &
7           freq_opp, freq_wrt, fuchnbout, last_opp, last_opp_chk, last_wrt, &
8           last_wrt_chk, missing_val, nbopp, nb_files, scal, scsize, sopps, &
9           topp
10      use histvar_seq_m, only: histvar_seq
11      use histwrite_real_m, only: histwrite_real
12      use isittime_m, only: isittime
13      USE mathop_m, ONLY: mathop
14    
15    implicit none    implicit none
16    
17    INTERFACE histwrite    INTERFACE histwrite
# Line 29  MODULE histwrite_m Line 39  MODULE histwrite_m
39       ! The difference between the procedures is the rank of "pdata".       ! The difference between the procedures is the rank of "pdata".
40    
41       MODULE PROCEDURE histwrite_r1d, histwrite_r2d, histwrite_r3d       MODULE PROCEDURE histwrite_r1d, histwrite_r2d, histwrite_r3d
42    END INTERFACE    END INTERFACE histwrite
43    
44    PRIVATE histwrite_r1d, histwrite_r2d, histwrite_r3d    PRIVATE
45      public histwrite
46    
47  CONTAINS  CONTAINS
48    
49    SUBROUTINE histwrite_r1d(fileid, varname, itau, pdata)    SUBROUTINE histwrite_r1d(fileid, varname, itau, pdata)
50    
     USE errioipsl, ONLY: histerr  
     use calendar, only: isittime  
     USE mathop_m, ONLY: mathop  
     USE histcom_var, ONLY: datasz_in, datasz_max, date0, deltat, &  
          freq_opp, freq_wrt, fuchnbout, last_opp, last_opp_chk, last_wrt, &  
          last_wrt_chk, missing_val, nbopp, nb_files, scal, scsize, sopps, &  
          topp  
     use histvar_seq_m, only: histvar_seq  
     use histwrite_real_m, only: histwrite_real  
   
51      INTEGER, INTENT(IN):: fileid, itau      INTEGER, INTENT(IN):: fileid, itau
52      CHARACTER(LEN=*), INTENT(IN):: varname      CHARACTER(LEN=*), INTENT(IN):: varname
53      REAL, INTENT(IN):: pdata(:)      REAL, INTENT(IN):: pdata(:)
# Line 66  CONTAINS Line 67  CONTAINS
67    
68      ! 1.0 Try to catch errors like specifying the wrong file ID.      ! 1.0 Try to catch errors like specifying the wrong file ID.
69    
70      IF ( (fileid < 1).OR.(fileid > nb_files) ) THEN      IF ((fileid < 1) .OR. (fileid > nb_files)) THEN
71         CALL histerr (3, "histwrite", &         CALL histerr(3, "histwrite", &
72              &    'Illegal file ID in the histwrite of variable', varname, ' ')              'Illegal file ID in the histwrite of variable', varname, ' ')
73      ENDIF      ENDIF
74    
75      ! 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
76    
77      CALL histvar_seq (fileid, varname, varid)      CALL histvar_seq(fileid, varname, varid)
78    
79      ! 2.0 do nothing for never operation      ! 2.0 do nothing for never operation
80    
# Line 87  CONTAINS Line 88  CONTAINS
88      ! 3.0 We check if we need to do an operation      ! 3.0 We check if we need to do an operation
89    
90      IF (last_opp_chk(fileid, varid) == itau) THEN      IF (last_opp_chk(fileid, varid) == itau) THEN
91         CALL histerr (3, "histwrite", &         CALL histerr(3, "histwrite", &
92              &    'This variable as already been analysed at the present', &              'This variable as already been analysed at the present', &
93              &    'time step', ' ')              'time step', ' ')
94      ENDIF      ENDIF
95    
96      CALL isittime(itau, date0(fileid), deltat(fileid), &      CALL isittime(itau, date0(fileid), deltat(fileid), &
# Line 99  CONTAINS Line 100  CONTAINS
100      ! 4.0 We check if we need to write the data      ! 4.0 We check if we need to write the data
101    
102      IF (last_wrt_chk(fileid, varid) == itau) THEN      IF (last_wrt_chk(fileid, varid) == itau) THEN
103         CALL histerr (3, "histwrite", &         CALL histerr(3, "histwrite", &
104              &    'This variable as already been written for the present', &              'This variable as already been written for the present', &
105              &    'time step', ' ')              'time step', ' ')
106      ENDIF      ENDIF
107    
108      CALL isittime &      CALL isittime(itau, date0(fileid), deltat(fileid), &
109           &  (itau, date0(fileid), deltat(fileid), freq_wrt(fileid, varid), &           freq_wrt(fileid, varid), last_wrt(fileid, varid), &
110           &   last_wrt(fileid, varid), last_wrt_chk(fileid, varid), do_write)           last_wrt_chk(fileid, varid), do_write)
111    
112      ! 5.0 histwrite called      ! 5.0 histwrite called
113    
114      IF (do_oper.OR.do_write) THEN      IF (do_oper .OR. do_write) THEN
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(fileid, 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(fileid, varid, 1) = SIZE(pdata)            datasz_in(fileid, varid, 1) = SIZE(pdata)
123            datasz_in(fileid, varid, 2) = -1            datasz_in(fileid, varid, 2) = -1
124            datasz_in(fileid, 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(fileid, varid) <= 0) THEN         IF (datasz_max(fileid, varid) <= 0) THEN
130            largebuf = .FALSE.            largebuf = .FALSE.
# Line 134  CONTAINS Line 134  CONTAINS
134               ENDIF               ENDIF
135            ENDDO            ENDDO
136            IF (largebuf) THEN            IF (largebuf) THEN
137               datasz_max(fileid, varid) = &               datasz_max(fileid, varid) = scsize(fileid, varid, 1) &
138                    &        scsize(fileid, varid, 1) &                    * scsize(fileid, varid, 2) *scsize(fileid, varid, 3)
                   &       *scsize(fileid, varid, 2) &  
                   &       *scsize(fileid, varid, 3)  
139            ELSE            ELSE
140               datasz_max(fileid, varid) = &               datasz_max(fileid, varid) = datasz_in(fileid, varid, 1)
                   &        datasz_in(fileid, varid, 1)  
141            ENDIF            ENDIF
142         ENDIF         ENDIF
143    
144         IF (.NOT.ALLOCATED(buff_tmp)) THEN         IF (.NOT.ALLOCATED(buff_tmp)) THEN
145            ALLOCATE (buff_tmp(datasz_max(fileid, varid)))            ALLOCATE(buff_tmp(datasz_max(fileid, varid)))
146            buff_tmp_sz = datasz_max(fileid, varid)            buff_tmp_sz = datasz_max(fileid, varid)
147         ELSE IF (datasz_max(fileid, varid) > buff_tmp_sz) THEN         ELSE IF (datasz_max(fileid, varid) > buff_tmp_sz) THEN
148            DEALLOCATE (buff_tmp)            DEALLOCATE(buff_tmp)
149            ALLOCATE (buff_tmp(datasz_max(fileid, varid)))            ALLOCATE(buff_tmp(datasz_max(fileid, varid)))
150            buff_tmp_sz = datasz_max(fileid, varid)            buff_tmp_sz = datasz_max(fileid, varid)
151         ENDIF         ENDIF
152    
153         !- We have to do the first operation anyway.         ! We have to do the first operation anyway. Thus we do it here
154         !- Thus we do it here and change the ranke         ! and change the ranke of the data at the same time. This
155         !- of the data at the same time. This should speed up things.         ! should speed up things.
156    
157         nbpt_in = datasz_in(fileid, varid, 1)         nbpt_in = datasz_in(fileid, varid, 1)
158         nbpt_out = datasz_max(fileid, varid)         nbpt_out = datasz_max(fileid, varid)
159         CALL mathop (sopps(fileid, varid, 1), nbpt_in, pdata, &         CALL mathop(sopps(fileid, varid, 1), nbpt_in, pdata, missing_val, &
160              &               missing_val, nbindex, nindex, &              nbindex, nindex, scal(fileid, varid, 1), nbpt_out, buff_tmp)
161              &               scal(fileid, varid, 1), nbpt_out, buff_tmp)         CALL histwrite_real(fileid, varid, itau, nbpt_out, buff_tmp, nbindex, &
162         CALL histwrite_real (fileid, varid, itau, nbpt_out, &              nindex, do_oper, do_write)
             &            buff_tmp, nbindex, nindex, do_oper, do_write)  
163      ENDIF      ENDIF
164    
165      ! 6.0 Manage time steps      ! 6.0 Manage time steps
166    
167      IF ((TRIM(tmp_opp) /= "once").AND.(TRIM(tmp_opp) /= "never")) THEN      IF ((TRIM(tmp_opp) /= "once") .AND. (TRIM(tmp_opp) /= "never")) THEN
168         last_opp_chk(fileid, varid) = itau         last_opp_chk(fileid, varid) = itau
169         last_wrt_chk(fileid, varid) = itau         last_wrt_chk(fileid, varid) = itau
170      ELSE      ELSE
# Line 182  CONTAINS Line 178  CONTAINS
178    
179    SUBROUTINE histwrite_r2d (fileid, varname, itau, pdata)    SUBROUTINE histwrite_r2d (fileid, varname, itau, pdata)
180    
     use calendar, only: isittime  
     USE errioipsl, ONLY: histerr  
     USE mathop_m, ONLY: mathop  
     USE histcom_var, ONLY: datasz_in, datasz_max, date0, deltat, &  
          freq_opp, freq_wrt, fuchnbout, last_opp, last_opp_chk, last_wrt, &  
          last_wrt_chk, missing_val, nbopp, nb_files, scal, scsize, sopps, &  
          topp  
     use histvar_seq_m, only: histvar_seq  
     use histwrite_real_m, only: histwrite_real  
   
181      INTEGER, INTENT(IN):: fileid, itau      INTEGER, INTENT(IN):: fileid, itau
182      REAL, INTENT(IN):: pdata(:, :)      REAL, INTENT(IN):: pdata(:, :)
183      CHARACTER(LEN=*), INTENT(IN):: varname      CHARACTER(LEN=*), INTENT(IN):: varname
# Line 212  CONTAINS Line 198  CONTAINS
198    
199      IF ( (fileid < 1).OR.(fileid > nb_files) ) THEN      IF ( (fileid < 1).OR.(fileid > nb_files) ) THEN
200         CALL histerr (3, "histwrite", &         CALL histerr (3, "histwrite", &
201              &    'Illegal file ID in the histwrite of variable', varname, ' ')              'Illegal file ID in the histwrite of variable', varname, ' ')
202      ENDIF      ENDIF
203    
204      ! 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 230  CONTAINS Line 216  CONTAINS
216    
217      ! 3.0 We check if we need to do an operation      ! 3.0 We check if we need to do an operation
218    
219      IF (last_opp_chk(fileid, varid) == itau) THEN      IF (last_opp_chk(fileid, varid) == itau) CALL histerr (3, "histwrite", &
220         CALL histerr (3, "histwrite", &           'This variable as already been analysed at the present', &
221              &    'This variable as already been analysed at the present', &           'time step', ' ')
             &    'time step', ' ')  
     ENDIF  
222    
223      CALL isittime &      CALL isittime(itau, date0(fileid), deltat(fileid), &
224           &  (itau, date0(fileid), deltat(fileid), freq_opp(fileid, varid), &           freq_opp(fileid, varid), last_opp(fileid, varid), &
225           &   last_opp(fileid, varid), last_opp_chk(fileid, varid), do_oper)           last_opp_chk(fileid, varid), do_oper)
226    
227      ! 4.0 We check if we need to write the data      ! 4.0 We check if we need to write the data
228    
229      IF (last_wrt_chk(fileid, varid) == itau) THEN      IF (last_wrt_chk(fileid, varid) == itau) THEN
230         CALL histerr (3, "histwrite", &         CALL histerr (3, "histwrite", &
231              &    'This variable as already been written for the present', &              'This variable as already been written for the present', &
232              &    'time step', ' ')              'time step', ' ')
233      ENDIF      ENDIF
234    
235      CALL isittime &      CALL isittime &
236           &  (itau, date0(fileid), deltat(fileid), freq_wrt(fileid, varid), &           (itau, date0(fileid), deltat(fileid), freq_wrt(fileid, varid), &
237           &   last_wrt(fileid, varid), last_wrt_chk(fileid, varid), do_write)           last_wrt(fileid, varid), last_wrt_chk(fileid, varid), do_write)
238    
239      ! 5.0 histwrite called      ! 5.0 histwrite called
240    
# Line 279  CONTAINS Line 263  CONTAINS
263            ENDDO            ENDDO
264            IF (largebuf) THEN            IF (largebuf) THEN
265               datasz_max(fileid, varid) = &               datasz_max(fileid, varid) = &
266                    &        scsize(fileid, varid, 1) &                    scsize(fileid, varid, 1) &
267                    &       *scsize(fileid, varid, 2) &                    *scsize(fileid, varid, 2) &
268                    &       *scsize(fileid, varid, 3)                    *scsize(fileid, varid, 3)
269            ELSE            ELSE
270               datasz_max(fileid, varid) = &               datasz_max(fileid, varid) = &
271                    &        datasz_in(fileid, varid, 1) &                    datasz_in(fileid, varid, 1) &
272                    &       *datasz_in(fileid, varid, 2)                    *datasz_in(fileid, varid, 2)
273            ENDIF            ENDIF
274         ENDIF         ENDIF
275    
# Line 305  CONTAINS Line 289  CONTAINS
289         nbpt_in(1:2) = datasz_in(fileid, varid, 1:2)         nbpt_in(1:2) = datasz_in(fileid, varid, 1:2)
290         nbpt_out = datasz_max(fileid, varid)         nbpt_out = datasz_max(fileid, varid)
291         CALL mathop (sopps(fileid, varid, 1), nbpt_in, pdata, &         CALL mathop (sopps(fileid, varid, 1), nbpt_in, pdata, &
292              &               missing_val, nbindex, nindex, &              missing_val, nbindex, nindex, &
293              &               scal(fileid, varid, 1), nbpt_out, buff_tmp)              scal(fileid, varid, 1), nbpt_out, buff_tmp)
294         CALL histwrite_real (fileid, varid, itau, nbpt_out, &         CALL histwrite_real (fileid, varid, itau, nbpt_out, &
295              &            buff_tmp, nbindex, nindex, do_oper, do_write)              buff_tmp, nbindex, nindex, do_oper, do_write)
296      ENDIF      ENDIF
297    
298      ! 6.0 Manage time steps      ! 6.0 Manage time steps
# Line 327  CONTAINS Line 311  CONTAINS
311    
312    SUBROUTINE histwrite_r3d (fileid, varname, itau, pdata)    SUBROUTINE histwrite_r3d (fileid, varname, itau, pdata)
313    
     use calendar, only: isittime  
     USE errioipsl, ONLY: histerr  
     USE mathop_m, ONLY: mathop  
     USE histcom_var, ONLY: datasz_in, datasz_max, date0, deltat, &  
          freq_opp, freq_wrt, fuchnbout, last_opp, last_opp_chk, last_wrt, &  
          last_wrt_chk, missing_val, nbopp, nb_files, scal, scsize, sopps, &  
          topp  
     use histvar_seq_m, only: histvar_seq  
     use histwrite_real_m, only: histwrite_real  
   
314      INTEGER, INTENT(IN):: fileid, itau      INTEGER, INTENT(IN):: fileid, itau
315      REAL, DIMENSION(:, :, :), INTENT(IN):: pdata      REAL, DIMENSION(:, :, :), INTENT(IN):: pdata
316      CHARACTER(LEN=*), INTENT(IN):: varname      CHARACTER(LEN=*), INTENT(IN):: varname
# Line 358  CONTAINS Line 332  CONTAINS
332    
333      IF ( (fileid < 1).OR.(fileid > nb_files) ) THEN      IF ( (fileid < 1).OR.(fileid > nb_files) ) THEN
334         CALL histerr (3, "histwrite", &         CALL histerr (3, "histwrite", &
335              &    'Illegal file ID in the histwrite of variable', varname, ' ')              'Illegal file ID in the histwrite of variable', varname, ' ')
336      ENDIF      ENDIF
337    
338      ! 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 352  CONTAINS
352    
353      IF (last_opp_chk(fileid, varid) == itau) THEN      IF (last_opp_chk(fileid, varid) == itau) THEN
354         CALL histerr (3, "histwrite", &         CALL histerr (3, "histwrite", &
355              &    'This variable as already been analysed at the present', &              'This variable as already been analysed at the present', &
356              &    'time step', ' ')              'time step', ' ')
357      ENDIF      ENDIF
358    
359      CALL isittime &      CALL isittime &
360           &  (itau, date0(fileid), deltat(fileid), freq_opp(fileid, varid), &           (itau, date0(fileid), deltat(fileid), freq_opp(fileid, varid), &
361           &   last_opp(fileid, varid), last_opp_chk(fileid, varid), do_oper)           last_opp(fileid, varid), last_opp_chk(fileid, varid), do_oper)
362    
363      ! 4.0 We check if we need to write the data      ! 4.0 We check if we need to write the data
364    
365      IF (last_wrt_chk(fileid, varid) == itau) THEN      IF (last_wrt_chk(fileid, varid) == itau) THEN
366         CALL histerr (3, "histwrite", &         CALL histerr (3, "histwrite", &
367              &    'This variable as already been written for the present', &              'This variable as already been written for the present', &
368              &    'time step', ' ')              'time step', ' ')
369      ENDIF      ENDIF
370    
371      CALL isittime &      CALL isittime &
372           &  (itau, date0(fileid), deltat(fileid), freq_wrt(fileid, varid), &           (itau, date0(fileid), deltat(fileid), freq_wrt(fileid, varid), &
373           &   last_wrt(fileid, varid), last_wrt_chk(fileid, varid), do_write)           last_wrt(fileid, varid), last_wrt_chk(fileid, varid), do_write)
374    
375      ! 5.0 histwrite called      ! 5.0 histwrite called
376    
# Line 425  CONTAINS Line 399  CONTAINS
399            ENDDO            ENDDO
400            IF (largebuf) THEN            IF (largebuf) THEN
401               datasz_max(fileid, varid) = &               datasz_max(fileid, varid) = &
402                    &        scsize(fileid, varid, 1) &                    scsize(fileid, varid, 1) &
403                    &       *scsize(fileid, varid, 2) &                    *scsize(fileid, varid, 2) &
404                    &       *scsize(fileid, varid, 3)                    *scsize(fileid, varid, 3)
405            ELSE            ELSE
406               datasz_max(fileid, varid) = &               datasz_max(fileid, varid) = &
407                    &        datasz_in(fileid, varid, 1) &                    datasz_in(fileid, varid, 1) &
408                    &       *datasz_in(fileid, varid, 2) &                    *datasz_in(fileid, varid, 2) &
409                    &       *datasz_in(fileid, varid, 3)                    *datasz_in(fileid, varid, 3)
410            ENDIF            ENDIF
411         ENDIF         ENDIF
412    
# Line 452  CONTAINS Line 426  CONTAINS
426         nbpt_in(1:3) = datasz_in(fileid, varid, 1:3)         nbpt_in(1:3) = datasz_in(fileid, varid, 1:3)
427         nbpt_out = datasz_max(fileid, varid)         nbpt_out = datasz_max(fileid, varid)
428         CALL mathop (sopps(fileid, varid, 1), nbpt_in, pdata, &         CALL mathop (sopps(fileid, varid, 1), nbpt_in, pdata, &
429              &               missing_val, nbindex, nindex, &              missing_val, nbindex, nindex, &
430              &               scal(fileid, varid, 1), nbpt_out, buff_tmp)              scal(fileid, varid, 1), nbpt_out, buff_tmp)
431         CALL histwrite_real (fileid, varid, itau, nbpt_out, &         CALL histwrite_real (fileid, varid, itau, nbpt_out, &
432              &            buff_tmp, nbindex, nindex, do_oper, do_write)              buff_tmp, nbindex, nindex, do_oper, do_write)
433      ENDIF      ENDIF
434    
435      ! 6.0 Manage time steps      ! 6.0 Manage time steps
Legend:
Removed from v.62  
changed lines
  Added in v.134
  ViewVC Help
Powered by ViewVC 1.1.21