--- trunk/libf/IOIPSL/histwrite.f90 2012/01/30 12:54:02 57 +++ trunk/libf/IOIPSL/histwrite.f90 2012/07/26 14:37:37 62 @@ -13,14 +13,14 @@ ! 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 (:, :, :) @@ -35,7 +35,7 @@ CONTAINS - SUBROUTINE histwrite_r1d(pfileid, pvarname, pitau, pdata) + SUBROUTINE histwrite_r1d(fileid, varname, itau, pdata) USE errioipsl, ONLY: histerr use calendar, only: isittime @@ -47,8 +47,8 @@ use histvar_seq_m, only: histvar_seq use histwrite_real_m, only: histwrite_real - INTEGER, INTENT(IN):: pfileid, pitau - CHARACTER(LEN=*), INTENT(IN):: pvarname + INTEGER, INTENT(IN):: fileid, itau + CHARACTER(LEN=*), INTENT(IN):: varname REAL, INTENT(IN):: pdata(:) ! Variables local to the procedure: @@ -66,47 +66,47 @@ ! 1.0 Try to catch errors like specifying the wrong file ID. - 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 @@ -114,73 +114,73 @@ !- 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 @@ -192,9 +192,9 @@ use histvar_seq_m, only: histvar_seq use histwrite_real_m, only: histwrite_real - INTEGER, INTENT(IN):: pfileid, pitau + INTEGER, INTENT(IN):: fileid, itau REAL, INTENT(IN):: pdata(:, :) - CHARACTER(LEN=*), INTENT(IN):: pvarname + CHARACTER(LEN=*), INTENT(IN):: varname integer nbindex, nindex(size(pdata)) LOGICAL:: do_oper, do_write, largebuf @@ -210,47 +210,47 @@ ! 1.0 Try to catch errors like specifying the wrong file ID. - 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 @@ -258,74 +258,74 @@ !- 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 @@ -337,9 +337,9 @@ use histvar_seq_m, only: histvar_seq use histwrite_real_m, only: histwrite_real - INTEGER, INTENT(IN):: pfileid, pitau + INTEGER, INTENT(IN):: fileid, itau REAL, DIMENSION(:, :, :), INTENT(IN):: pdata - CHARACTER(LEN=*), INTENT(IN):: pvarname + CHARACTER(LEN=*), INTENT(IN):: varname integer nbindex, nindex(size(pdata)) LOGICAL:: do_oper, do_write, largebuf @@ -356,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 @@ -404,68 +404,68 @@ !- 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