/[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 45 by guez, Wed Apr 27 13:00:12 2011 UTC revision 56 by guez, Tue Jan 10 19:02:02 2012 UTC
# Line 26  MODULE histwrite_m Line 26  MODULE histwrite_m
26       ! REAL, INTENT(IN):: pdata(:) or (:, :) or (:, :, :)       ! REAL, INTENT(IN):: pdata(:) or (:, :) or (:, :, :)
27       ! values of the variable       ! values of the variable
28    
      ! INTEGER, INTENT(IN):: nbindex  
      ! number of indices provided  
      ! If it is equal to the size of the full field as provided in histdef  
      ! then nothing is done.  
   
      ! INTEGER, INTENT(IN):: nindex(nbindex)  
      ! The indices used to expand the variable (pdata) onto the full field  
   
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
# Line 48  CONTAINS Line 40  CONTAINS
40      USE errioipsl, ONLY : histerr      USE errioipsl, ONLY : histerr
41      use calendar, only: isittime      use calendar, only: isittime
42      USE mathop_m, ONLY : mathop      USE mathop_m, ONLY : mathop
43      use histcom_var      USE histcom_var, ONLY : datasz_in, datasz_max, date0, deltat, &
44             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      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):: pfileid, pitau
51      REAL, INTENT(IN) :: pdata(:)      REAL, INTENT(IN):: pdata(:)
52      CHARACTER(LEN=*), INTENT(IN) :: pvarname      CHARACTER(LEN=*), INTENT(IN):: pvarname
53    
54      ! Variables local to the procedure:      ! Variables local to the procedure:
55      integer nbindex, nindex(size(pdata))      integer nbindex, nindex(size(pdata))
56      LOGICAL :: do_oper, do_write, largebuf      LOGICAL:: do_oper, do_write, largebuf
57      INTEGER :: varid, io, nbpt_in, nbpt_out      INTEGER:: varid, io, nbpt_in, nbpt_out
58      REAL, ALLOCATABLE, SAVE :: buff_tmp(:)      REAL, ALLOCATABLE, SAVE:: buff_tmp(:)
59      INTEGER, SAVE :: buff_tmp_sz      INTEGER, SAVE:: buff_tmp_sz
60      CHARACTER(LEN=7) :: tmp_opp      CHARACTER(LEN=7):: tmp_opp
61    
62      !--------------------------------------------------------------------      !--------------------------------------------------------------------
63    
# Line 70  CONTAINS Line 65  CONTAINS
65      nindex = 0      nindex = 0
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.
     !     Thanks Marine for showing us what errors users can make !  
68    
69      IF ( (pfileid < 1).OR.(pfileid > nb_files) ) THEN      IF ( (pfileid < 1).OR.(pfileid > nb_files) ) THEN
70         CALL histerr (3, "histwrite", &         CALL histerr (3, "histwrite", &
# Line 181  CONTAINS Line 175  CONTAINS
175         last_opp_chk(pfileid, varid) = -99         last_opp_chk(pfileid, varid) = -99
176         last_wrt_chk(pfileid, varid) = -99         last_wrt_chk(pfileid, 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 (pfileid, pvarname, pitau, pdata)
     !--------------------------------------------------------------------  
184    
185      use calendar, only: isittime      use calendar, only: isittime
186      USE errioipsl, ONLY : histerr      USE errioipsl, ONLY : histerr
187      USE mathop_m, ONLY : mathop      USE mathop_m, ONLY : mathop
188      use histcom_var      USE histcom_var, ONLY : datasz_in, datasz_max, date0, deltat, &
189             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      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):: pfileid, pitau
196      REAL, DIMENSION(:, :), INTENT(IN) :: pdata      REAL, INTENT(IN):: pdata(:, :)
197      CHARACTER(LEN=*), INTENT(IN) :: pvarname      CHARACTER(LEN=*), INTENT(IN):: pvarname
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
201      INTEGER :: varid, io, nbpt_in(1:2), nbpt_out      INTEGER:: varid, io, nbpt_in(1:2), nbpt_out
202      REAL, ALLOCATABLE, SAVE :: buff_tmp(:)      REAL, ALLOCATABLE, SAVE:: buff_tmp(:)
203      INTEGER, SAVE :: buff_tmp_sz      INTEGER, SAVE:: buff_tmp_sz
204      CHARACTER(LEN=7) :: tmp_opp      CHARACTER(LEN=7):: tmp_opp
205    
206      !--------------------------------------------------------------------      !--------------------------------------------------------------------
207    
# Line 213  CONTAINS Line 209  CONTAINS
209      nindex = 0      nindex = 0
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.
     !     Thanks Marine for showing us what errors users can make !  
212    
213      IF ( (pfileid < 1).OR.(pfileid > nb_files) ) THEN      IF ( (pfileid < 1).OR.(pfileid > nb_files) ) THEN
214         CALL histerr (3, "histwrite", &         CALL histerr (3, "histwrite", &
# Line 325  CONTAINS Line 320  CONTAINS
320         last_opp_chk(pfileid, varid) = -99         last_opp_chk(pfileid, varid) = -99
321         last_wrt_chk(pfileid, varid) = -99         last_wrt_chk(pfileid, 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 (pfileid, pvarname, pitau, pdata)
     !--------------------------------------------------------------------  
329    
330      use calendar, only: isittime      use calendar, only: isittime
331      USE errioipsl, ONLY : histerr      USE errioipsl, ONLY : histerr
332      USE mathop_m, ONLY : mathop      USE mathop_m, ONLY : mathop
333      use histcom_var      USE histcom_var, ONLY : datasz_in, datasz_max, date0, deltat, &
334             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      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):: pfileid, pitau
341      REAL, DIMENSION(:, :, :), INTENT(IN) :: pdata      REAL, DIMENSION(:, :, :), INTENT(IN):: pdata
342      CHARACTER(LEN=*), INTENT(IN) :: pvarname      CHARACTER(LEN=*), INTENT(IN):: pvarname
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
346      INTEGER :: varid, io, nbpt_in(1:3), nbpt_out      INTEGER:: varid, io, nbpt_in(1:3), nbpt_out
347      REAL, ALLOCATABLE, SAVE :: buff_tmp(:)      REAL, ALLOCATABLE, SAVE:: buff_tmp(:)
348      INTEGER, SAVE :: buff_tmp_sz      INTEGER, SAVE:: buff_tmp_sz
349      CHARACTER(LEN=7) :: tmp_opp      CHARACTER(LEN=7):: tmp_opp
350    
351      !--------------------------------------------------------------------      !--------------------------------------------------------------------
352    
# Line 470  CONTAINS Line 467  CONTAINS
467         last_opp_chk(pfileid, varid) = -99         last_opp_chk(pfileid, varid) = -99
468         last_wrt_chk(pfileid, varid) = -99         last_wrt_chk(pfileid, varid) = -99
469      ENDIF      ENDIF
470      !--------------------------  
471    END SUBROUTINE histwrite_r3d    END SUBROUTINE histwrite_r3d
472    
473  END MODULE histwrite_m  END MODULE histwrite_m
Legend:
Removed from v.45  
changed lines
  Added in v.56
  ViewVC Help
Powered by ViewVC 1.1.21