--- trunk/libf/IOIPSL/histwrite.f90 2011/04/27 13:00:12 45 +++ trunk/libf/IOIPSL/histwrite.f90 2012/07/26 14:37:37 62 @@ -13,27 +13,19 @@ ! later stage we can call different operations and write subroutines ! for the REAL and INTEGER interfaces. - ! INTEGER, INTENT(IN):: pfileid + ! INTEGER, INTENT(IN):: fileid ! The ID of the file on which this variable is to be written. ! The variable should have been defined in this file before. - ! CHARACTER(LEN=*), INTENT(IN):: pvarname + ! CHARACTER(LEN=*), INTENT(IN):: varname ! short name of the variable - ! INTEGER, INTENT(IN):: pitau + ! INTEGER, INTENT(IN):: itau ! current timestep ! REAL, INTENT(IN):: pdata(:) or (:, :) or (:, :, :) ! values of the variable - ! 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 - ! The difference between the procedures is the rank of "pdata". MODULE PROCEDURE histwrite_r1d, histwrite_r2d, histwrite_r3d @@ -43,26 +35,29 @@ CONTAINS - SUBROUTINE histwrite_r1d(pfileid, pvarname, pitau, pdata) + SUBROUTINE histwrite_r1d(fileid, varname, itau, pdata) - USE errioipsl, ONLY : histerr + USE errioipsl, ONLY: histerr use calendar, only: isittime - USE mathop_m, ONLY : mathop - use histcom_var + 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 - INTEGER, INTENT(IN) :: pfileid, pitau - REAL, INTENT(IN) :: pdata(:) - CHARACTER(LEN=*), INTENT(IN) :: pvarname + INTEGER, INTENT(IN):: fileid, itau + CHARACTER(LEN=*), INTENT(IN):: varname + REAL, INTENT(IN):: pdata(:) ! Variables local to the procedure: integer nbindex, nindex(size(pdata)) - LOGICAL :: do_oper, do_write, largebuf - INTEGER :: varid, io, nbpt_in, nbpt_out - REAL, ALLOCATABLE, SAVE :: buff_tmp(:) - INTEGER, SAVE :: buff_tmp_sz - CHARACTER(LEN=7) :: tmp_opp + LOGICAL:: do_oper, do_write, largebuf + INTEGER:: varid, io, nbpt_in, nbpt_out + REAL, ALLOCATABLE, SAVE:: buff_tmp(:) + INTEGER, SAVE:: buff_tmp_sz + CHARACTER(LEN=7):: tmp_opp !-------------------------------------------------------------------- @@ -70,49 +65,48 @@ nindex = 0 ! 1.0 Try to catch errors like specifying the wrong file ID. - ! Thanks Marine for showing us what errors users can make ! - IF ( (pfileid < 1).OR.(pfileid > nb_files) ) THEN + IF ( (fileid < 1).OR.(fileid > nb_files) ) THEN CALL histerr (3, "histwrite", & - & 'Illegal file ID in the histwrite of variable', pvarname, ' ') + & 'Illegal file ID in the histwrite of variable', varname, ' ') ENDIF ! 1.1 Find the id of the variable to be written and the real time - CALL histvar_seq (pfileid, pvarname, varid) + CALL histvar_seq (fileid, varname, varid) ! 2.0 do nothing for never operation - tmp_opp = topp(pfileid, varid) + tmp_opp = topp(fileid, varid) IF (TRIM(tmp_opp) == "never") THEN - last_opp_chk(pfileid, varid) = -99 - last_wrt_chk(pfileid, varid) = -99 + last_opp_chk(fileid, varid) = -99 + last_wrt_chk(fileid, varid) = -99 ENDIF ! 3.0 We check if we need to do an operation - IF (last_opp_chk(pfileid, varid) == pitau) THEN + IF (last_opp_chk(fileid, varid) == itau) THEN CALL histerr (3, "histwrite", & & 'This variable as already been analysed at the present', & & 'time step', ' ') ENDIF - CALL isittime & - & (pitau, date0(pfileid), deltat(pfileid), freq_opp(pfileid, varid), & - & last_opp(pfileid, varid), last_opp_chk(pfileid, varid), do_oper) + CALL isittime(itau, date0(fileid), deltat(fileid), & + freq_opp(fileid, varid), last_opp(fileid, varid), & + last_opp_chk(fileid, varid), do_oper) ! 4.0 We check if we need to write the data - IF (last_wrt_chk(pfileid, varid) == pitau) THEN + IF (last_wrt_chk(fileid, varid) == itau) THEN CALL histerr (3, "histwrite", & & 'This variable as already been written for the present', & & 'time step', ' ') ENDIF CALL isittime & - & (pitau, date0(pfileid), deltat(pfileid), freq_wrt(pfileid, varid), & - & last_wrt(pfileid, varid), last_wrt_chk(pfileid, varid), do_write) + & (itau, date0(fileid), deltat(fileid), freq_wrt(fileid, varid), & + & last_wrt(fileid, varid), last_wrt_chk(fileid, varid), do_write) ! 5.0 histwrite called @@ -120,92 +114,94 @@ !- 5.1 Get the sizes of the data we will handle - IF (datasz_in(pfileid, varid, 1) <= 0) THEN + IF (datasz_in(fileid, varid, 1) <= 0) THEN !--- There is the risk here that the user has over-sized the array. !--- But how can we catch this ? !--- In the worst case we will do impossible operations !--- on part of the data ! - datasz_in(pfileid, varid, 1) = SIZE(pdata) - datasz_in(pfileid, varid, 2) = -1 - datasz_in(pfileid, varid, 3) = -1 + datasz_in(fileid, varid, 1) = SIZE(pdata) + datasz_in(fileid, varid, 2) = -1 + datasz_in(fileid, varid, 3) = -1 ENDIF !- 5.2 The maximum size of the data will give the size of the buffer - IF (datasz_max(pfileid, varid) <= 0) THEN + IF (datasz_max(fileid, varid) <= 0) THEN largebuf = .FALSE. - DO io=1, nbopp(pfileid, varid) - IF (INDEX(fuchnbout, sopps(pfileid, varid, io)) > 0) THEN + DO io=1, nbopp(fileid, varid) + IF (INDEX(fuchnbout, sopps(fileid, varid, io)) > 0) THEN largebuf = .TRUE. ENDIF ENDDO IF (largebuf) THEN - datasz_max(pfileid, varid) = & - & scsize(pfileid, varid, 1) & - & *scsize(pfileid, varid, 2) & - & *scsize(pfileid, varid, 3) + datasz_max(fileid, varid) = & + & scsize(fileid, varid, 1) & + & *scsize(fileid, varid, 2) & + & *scsize(fileid, varid, 3) ELSE - datasz_max(pfileid, varid) = & - & datasz_in(pfileid, varid, 1) + datasz_max(fileid, varid) = & + & datasz_in(fileid, varid, 1) ENDIF ENDIF IF (.NOT.ALLOCATED(buff_tmp)) THEN - ALLOCATE (buff_tmp(datasz_max(pfileid, varid))) - buff_tmp_sz = datasz_max(pfileid, varid) - ELSE IF (datasz_max(pfileid, varid) > buff_tmp_sz) THEN + ALLOCATE (buff_tmp(datasz_max(fileid, varid))) + buff_tmp_sz = datasz_max(fileid, varid) + ELSE IF (datasz_max(fileid, varid) > buff_tmp_sz) THEN DEALLOCATE (buff_tmp) - ALLOCATE (buff_tmp(datasz_max(pfileid, varid))) - buff_tmp_sz = datasz_max(pfileid, varid) + ALLOCATE (buff_tmp(datasz_max(fileid, varid))) + buff_tmp_sz = datasz_max(fileid, varid) ENDIF !- We have to do the first operation anyway. !- Thus we do it here and change the ranke !- of the data at the same time. This should speed up things. - nbpt_in = datasz_in(pfileid, varid, 1) - nbpt_out = datasz_max(pfileid, varid) - CALL mathop (sopps(pfileid, varid, 1), nbpt_in, pdata, & + nbpt_in = datasz_in(fileid, varid, 1) + nbpt_out = datasz_max(fileid, varid) + CALL mathop (sopps(fileid, varid, 1), nbpt_in, pdata, & & missing_val, nbindex, nindex, & - & scal(pfileid, varid, 1), nbpt_out, buff_tmp) - CALL histwrite_real (pfileid, varid, pitau, nbpt_out, & + & scal(fileid, varid, 1), nbpt_out, buff_tmp) + CALL histwrite_real (fileid, varid, itau, nbpt_out, & & buff_tmp, nbindex, nindex, do_oper, do_write) ENDIF ! 6.0 Manage time steps IF ((TRIM(tmp_opp) /= "once").AND.(TRIM(tmp_opp) /= "never")) THEN - last_opp_chk(pfileid, varid) = pitau - last_wrt_chk(pfileid, varid) = pitau + last_opp_chk(fileid, varid) = itau + last_wrt_chk(fileid, varid) = itau ELSE - last_opp_chk(pfileid, varid) = -99 - last_wrt_chk(pfileid, varid) = -99 + last_opp_chk(fileid, varid) = -99 + last_wrt_chk(fileid, varid) = -99 ENDIF - !-------------------------- + END SUBROUTINE histwrite_r1d - !=== + !************************************************************************ - SUBROUTINE histwrite_r2d (pfileid, pvarname, pitau, pdata) - !-------------------------------------------------------------------- + SUBROUTINE histwrite_r2d (fileid, varname, itau, pdata) use calendar, only: isittime - USE errioipsl, ONLY : histerr - USE mathop_m, ONLY : mathop - use histcom_var + 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 - INTEGER, INTENT(IN) :: pfileid, pitau - REAL, DIMENSION(:, :), INTENT(IN) :: pdata - CHARACTER(LEN=*), INTENT(IN) :: pvarname + INTEGER, INTENT(IN):: fileid, itau + REAL, INTENT(IN):: pdata(:, :) + CHARACTER(LEN=*), INTENT(IN):: varname integer nbindex, nindex(size(pdata)) - LOGICAL :: do_oper, do_write, largebuf - INTEGER :: varid, io, nbpt_in(1:2), nbpt_out - REAL, ALLOCATABLE, SAVE :: buff_tmp(:) - INTEGER, SAVE :: buff_tmp_sz - CHARACTER(LEN=7) :: tmp_opp + LOGICAL:: do_oper, do_write, largebuf + INTEGER:: varid, io, nbpt_in(1:2), nbpt_out + REAL, ALLOCATABLE, SAVE:: buff_tmp(:) + INTEGER, SAVE:: buff_tmp_sz + CHARACTER(LEN=7):: tmp_opp !-------------------------------------------------------------------- @@ -213,49 +209,48 @@ nindex = 0 ! 1.0 Try to catch errors like specifying the wrong file ID. - ! Thanks Marine for showing us what errors users can make ! - IF ( (pfileid < 1).OR.(pfileid > nb_files) ) THEN + IF ( (fileid < 1).OR.(fileid > nb_files) ) THEN CALL histerr (3, "histwrite", & - & 'Illegal file ID in the histwrite of variable', pvarname, ' ') + & 'Illegal file ID in the histwrite of variable', varname, ' ') ENDIF ! 1.1 Find the id of the variable to be written and the real time - CALL histvar_seq (pfileid, pvarname, varid) + CALL histvar_seq (fileid, varname, varid) ! 2.0 do nothing for never operation - tmp_opp = topp(pfileid, varid) + tmp_opp = topp(fileid, varid) IF (TRIM(tmp_opp) == "never") THEN - last_opp_chk(pfileid, varid) = -99 - last_wrt_chk(pfileid, varid) = -99 + last_opp_chk(fileid, varid) = -99 + last_wrt_chk(fileid, varid) = -99 ENDIF ! 3.0 We check if we need to do an operation - IF (last_opp_chk(pfileid, varid) == pitau) THEN + IF (last_opp_chk(fileid, varid) == itau) THEN CALL histerr (3, "histwrite", & & 'This variable as already been analysed at the present', & & 'time step', ' ') ENDIF CALL isittime & - & (pitau, date0(pfileid), deltat(pfileid), freq_opp(pfileid, varid), & - & last_opp(pfileid, varid), last_opp_chk(pfileid, varid), do_oper) + & (itau, date0(fileid), deltat(fileid), freq_opp(fileid, varid), & + & last_opp(fileid, varid), last_opp_chk(fileid, varid), do_oper) ! 4.0 We check if we need to write the data - IF (last_wrt_chk(pfileid, varid) == pitau) THEN + IF (last_wrt_chk(fileid, varid) == itau) THEN CALL histerr (3, "histwrite", & & 'This variable as already been written for the present', & & 'time step', ' ') ENDIF CALL isittime & - & (pitau, date0(pfileid), deltat(pfileid), freq_wrt(pfileid, varid), & - & last_wrt(pfileid, varid), last_wrt_chk(pfileid, varid), do_write) + & (itau, date0(fileid), deltat(fileid), freq_wrt(fileid, varid), & + & last_wrt(fileid, varid), last_wrt_chk(fileid, varid), do_write) ! 5.0 histwrite called @@ -263,93 +258,95 @@ !- 5.1 Get the sizes of the data we will handle - IF (datasz_in(pfileid, varid, 1) <= 0) THEN + IF (datasz_in(fileid, varid, 1) <= 0) THEN !--- There is the risk here that the user has over-sized the array. !--- But how can we catch this ? !--- In the worst case we will do impossible operations !--- on part of the data ! - datasz_in(pfileid, varid, 1) = SIZE(pdata, DIM=1) - datasz_in(pfileid, varid, 2) = SIZE(pdata, DIM=2) - datasz_in(pfileid, varid, 3) = -1 + datasz_in(fileid, varid, 1) = SIZE(pdata, DIM=1) + datasz_in(fileid, varid, 2) = SIZE(pdata, DIM=2) + datasz_in(fileid, varid, 3) = -1 ENDIF !- 5.2 The maximum size of the data will give the size of the buffer - IF (datasz_max(pfileid, varid) <= 0) THEN + IF (datasz_max(fileid, varid) <= 0) THEN largebuf = .FALSE. - DO io=1, nbopp(pfileid, varid) - IF (INDEX(fuchnbout, sopps(pfileid, varid, io)) > 0) THEN + DO io=1, nbopp(fileid, varid) + IF (INDEX(fuchnbout, sopps(fileid, varid, io)) > 0) THEN largebuf = .TRUE. ENDIF ENDDO IF (largebuf) THEN - datasz_max(pfileid, varid) = & - & scsize(pfileid, varid, 1) & - & *scsize(pfileid, varid, 2) & - & *scsize(pfileid, varid, 3) + datasz_max(fileid, varid) = & + & scsize(fileid, varid, 1) & + & *scsize(fileid, varid, 2) & + & *scsize(fileid, varid, 3) ELSE - datasz_max(pfileid, varid) = & - & datasz_in(pfileid, varid, 1) & - & *datasz_in(pfileid, varid, 2) + datasz_max(fileid, varid) = & + & datasz_in(fileid, varid, 1) & + & *datasz_in(fileid, varid, 2) ENDIF ENDIF IF (.NOT.ALLOCATED(buff_tmp)) THEN - ALLOCATE (buff_tmp(datasz_max(pfileid, varid))) - buff_tmp_sz = datasz_max(pfileid, varid) - ELSE IF (datasz_max(pfileid, varid) > buff_tmp_sz) THEN + ALLOCATE (buff_tmp(datasz_max(fileid, varid))) + buff_tmp_sz = datasz_max(fileid, varid) + ELSE IF (datasz_max(fileid, varid) > buff_tmp_sz) THEN DEALLOCATE (buff_tmp) - ALLOCATE (buff_tmp(datasz_max(pfileid, varid))) - buff_tmp_sz = datasz_max(pfileid, varid) + ALLOCATE (buff_tmp(datasz_max(fileid, varid))) + buff_tmp_sz = datasz_max(fileid, varid) ENDIF !- We have to do the first operation anyway. !- Thus we do it here and change the ranke !- of the data at the same time. This should speed up things. - nbpt_in(1:2) = datasz_in(pfileid, varid, 1:2) - nbpt_out = datasz_max(pfileid, varid) - CALL mathop (sopps(pfileid, varid, 1), nbpt_in, pdata, & + nbpt_in(1:2) = datasz_in(fileid, varid, 1:2) + nbpt_out = datasz_max(fileid, varid) + CALL mathop (sopps(fileid, varid, 1), nbpt_in, pdata, & & missing_val, nbindex, nindex, & - & scal(pfileid, varid, 1), nbpt_out, buff_tmp) - CALL histwrite_real (pfileid, varid, pitau, nbpt_out, & + & scal(fileid, varid, 1), nbpt_out, buff_tmp) + CALL histwrite_real (fileid, varid, itau, nbpt_out, & & buff_tmp, nbindex, nindex, do_oper, do_write) ENDIF ! 6.0 Manage time steps IF ((TRIM(tmp_opp) /= "once").AND.(TRIM(tmp_opp) /= "never")) THEN - last_opp_chk(pfileid, varid) = pitau - last_wrt_chk(pfileid, varid) = pitau + last_opp_chk(fileid, varid) = itau + last_wrt_chk(fileid, varid) = itau ELSE - last_opp_chk(pfileid, varid) = -99 - last_wrt_chk(pfileid, varid) = -99 + last_opp_chk(fileid, varid) = -99 + last_wrt_chk(fileid, varid) = -99 ENDIF - !-------------------------- + END SUBROUTINE histwrite_r2d - !=== + !************************************************************************ - SUBROUTINE histwrite_r3d (pfileid, pvarname, pitau, pdata) - !-------------------------------------------------------------------- + SUBROUTINE histwrite_r3d (fileid, varname, itau, pdata) use calendar, only: isittime - USE errioipsl, ONLY : histerr - USE mathop_m, ONLY : mathop - use histcom_var + 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 - INTEGER, INTENT(IN) :: pfileid, pitau - REAL, DIMENSION(:, :, :), INTENT(IN) :: pdata - CHARACTER(LEN=*), INTENT(IN) :: pvarname + INTEGER, INTENT(IN):: fileid, itau + REAL, DIMENSION(:, :, :), INTENT(IN):: pdata + CHARACTER(LEN=*), INTENT(IN):: varname integer nbindex, nindex(size(pdata)) - LOGICAL :: do_oper, do_write, largebuf - INTEGER :: varid, io, nbpt_in(1:3), nbpt_out - REAL, ALLOCATABLE, SAVE :: buff_tmp(:) - INTEGER, SAVE :: buff_tmp_sz - CHARACTER(LEN=7) :: tmp_opp + LOGICAL:: do_oper, do_write, largebuf + INTEGER:: varid, io, nbpt_in(1:3), nbpt_out + REAL, ALLOCATABLE, SAVE:: buff_tmp(:) + INTEGER, SAVE:: buff_tmp_sz + CHARACTER(LEN=7):: tmp_opp !-------------------------------------------------------------------- @@ -359,47 +356,47 @@ ! 1.0 Try to catch errors like specifying the wrong file ID. ! Thanks Marine for showing us what errors users can make ! - IF ( (pfileid < 1).OR.(pfileid > nb_files) ) THEN + IF ( (fileid < 1).OR.(fileid > nb_files) ) THEN CALL histerr (3, "histwrite", & - & 'Illegal file ID in the histwrite of variable', pvarname, ' ') + & 'Illegal file ID in the histwrite of variable', varname, ' ') ENDIF ! 1.1 Find the id of the variable to be written and the real time - CALL histvar_seq (pfileid, pvarname, varid) + CALL histvar_seq (fileid, varname, varid) ! 2.0 do nothing for never operation - tmp_opp = topp(pfileid, varid) + tmp_opp = topp(fileid, varid) IF (TRIM(tmp_opp) == "never") THEN - last_opp_chk(pfileid, varid) = -99 - last_wrt_chk(pfileid, varid) = -99 + last_opp_chk(fileid, varid) = -99 + last_wrt_chk(fileid, varid) = -99 ENDIF ! 3.0 We check if we need to do an operation - IF (last_opp_chk(pfileid, varid) == pitau) THEN + IF (last_opp_chk(fileid, varid) == itau) THEN CALL histerr (3, "histwrite", & & 'This variable as already been analysed at the present', & & 'time step', ' ') ENDIF CALL isittime & - & (pitau, date0(pfileid), deltat(pfileid), freq_opp(pfileid, varid), & - & last_opp(pfileid, varid), last_opp_chk(pfileid, varid), do_oper) + & (itau, date0(fileid), deltat(fileid), freq_opp(fileid, varid), & + & last_opp(fileid, varid), last_opp_chk(fileid, varid), do_oper) ! 4.0 We check if we need to write the data - IF (last_wrt_chk(pfileid, varid) == pitau) THEN + IF (last_wrt_chk(fileid, varid) == itau) THEN CALL histerr (3, "histwrite", & & 'This variable as already been written for the present', & & 'time step', ' ') ENDIF CALL isittime & - & (pitau, date0(pfileid), deltat(pfileid), freq_wrt(pfileid, varid), & - & last_wrt(pfileid, varid), last_wrt_chk(pfileid, varid), do_write) + & (itau, date0(fileid), deltat(fileid), freq_wrt(fileid, varid), & + & last_wrt(fileid, varid), last_wrt_chk(fileid, varid), do_write) ! 5.0 histwrite called @@ -407,70 +404,70 @@ !- 5.1 Get the sizes of the data we will handle - IF (datasz_in(pfileid, varid, 1) <= 0) THEN + IF (datasz_in(fileid, varid, 1) <= 0) THEN !--- There is the risk here that the user has over-sized the array. !--- But how can we catch this ? !--- In the worst case we will do impossible operations !--- on part of the data ! - datasz_in(pfileid, varid, 1) = SIZE(pdata, DIM=1) - datasz_in(pfileid, varid, 2) = SIZE(pdata, DIM=2) - datasz_in(pfileid, varid, 3) = SIZE(pdata, DIM=3) + datasz_in(fileid, varid, 1) = SIZE(pdata, DIM=1) + datasz_in(fileid, varid, 2) = SIZE(pdata, DIM=2) + datasz_in(fileid, varid, 3) = SIZE(pdata, DIM=3) ENDIF !- 5.2 The maximum size of the data will give the size of the buffer - IF (datasz_max(pfileid, varid) <= 0) THEN + IF (datasz_max(fileid, varid) <= 0) THEN largebuf = .FALSE. - DO io =1, nbopp(pfileid, varid) - IF (INDEX(fuchnbout, sopps(pfileid, varid, io)) > 0) THEN + DO io =1, nbopp(fileid, varid) + IF (INDEX(fuchnbout, sopps(fileid, varid, io)) > 0) THEN largebuf = .TRUE. ENDIF ENDDO IF (largebuf) THEN - datasz_max(pfileid, varid) = & - & scsize(pfileid, varid, 1) & - & *scsize(pfileid, varid, 2) & - & *scsize(pfileid, varid, 3) + datasz_max(fileid, varid) = & + & scsize(fileid, varid, 1) & + & *scsize(fileid, varid, 2) & + & *scsize(fileid, varid, 3) ELSE - datasz_max(pfileid, varid) = & - & datasz_in(pfileid, varid, 1) & - & *datasz_in(pfileid, varid, 2) & - & *datasz_in(pfileid, varid, 3) + datasz_max(fileid, varid) = & + & datasz_in(fileid, varid, 1) & + & *datasz_in(fileid, varid, 2) & + & *datasz_in(fileid, varid, 3) ENDIF ENDIF IF (.NOT.ALLOCATED(buff_tmp)) THEN - ALLOCATE (buff_tmp(datasz_max(pfileid, varid))) - buff_tmp_sz = datasz_max(pfileid, varid) - ELSE IF (datasz_max(pfileid, varid) > buff_tmp_sz) THEN + ALLOCATE (buff_tmp(datasz_max(fileid, varid))) + buff_tmp_sz = datasz_max(fileid, varid) + ELSE IF (datasz_max(fileid, varid) > buff_tmp_sz) THEN DEALLOCATE (buff_tmp) - ALLOCATE (buff_tmp(datasz_max(pfileid, varid))) - buff_tmp_sz = datasz_max(pfileid, varid) + ALLOCATE (buff_tmp(datasz_max(fileid, varid))) + buff_tmp_sz = datasz_max(fileid, varid) ENDIF !- We have to do the first operation anyway. !- Thus we do it here and change the ranke !- of the data at the same time. This should speed up things. - nbpt_in(1:3) = datasz_in(pfileid, varid, 1:3) - nbpt_out = datasz_max(pfileid, varid) - CALL mathop (sopps(pfileid, varid, 1), nbpt_in, pdata, & + nbpt_in(1:3) = datasz_in(fileid, varid, 1:3) + nbpt_out = datasz_max(fileid, varid) + CALL mathop (sopps(fileid, varid, 1), nbpt_in, pdata, & & missing_val, nbindex, nindex, & - & scal(pfileid, varid, 1), nbpt_out, buff_tmp) - CALL histwrite_real (pfileid, varid, pitau, nbpt_out, & + & scal(fileid, varid, 1), nbpt_out, buff_tmp) + CALL histwrite_real (fileid, varid, itau, nbpt_out, & & buff_tmp, nbindex, nindex, do_oper, do_write) ENDIF ! 6.0 Manage time steps IF ((TRIM(tmp_opp) /= "once").AND.(TRIM(tmp_opp) /= "never")) THEN - last_opp_chk(pfileid, varid) = pitau - last_wrt_chk(pfileid, varid) = pitau + last_opp_chk(fileid, varid) = itau + last_wrt_chk(fileid, varid) = itau ELSE - last_opp_chk(pfileid, varid) = -99 - last_wrt_chk(pfileid, varid) = -99 + last_opp_chk(fileid, varid) = -99 + last_wrt_chk(fileid, varid) = -99 ENDIF - !-------------------------- + END SUBROUTINE histwrite_r3d END MODULE histwrite_m