Newer
Older
ENDDO
!
!*** 4.4 Mixing ratio change due to each process
!
IF(BUCONF%LBU_ENABLE) THEN
DO JL=1, IMICRO
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
ZTOT_RVHENI (JMICRO+JL-1)=ZTOT_RVHENI (JMICRO+JL-1)+ZRVHENI_MR(JL)
ZTOT_RCHONI (JMICRO+JL-1)=ZTOT_RCHONI (JMICRO+JL-1)+ZRCHONI (JL)*ZMAXTIME(JL)
ZTOT_RRHONG (JMICRO+JL-1)=ZTOT_RRHONG (JMICRO+JL-1)+ZRRHONG_MR(JL)
ZTOT_RVDEPS (JMICRO+JL-1)=ZTOT_RVDEPS (JMICRO+JL-1)+ZRVDEPS (JL)*ZMAXTIME(JL)
ZTOT_RIAGGS (JMICRO+JL-1)=ZTOT_RIAGGS (JMICRO+JL-1)+ZRIAGGS (JL)*ZMAXTIME(JL)
ZTOT_RIAUTS (JMICRO+JL-1)=ZTOT_RIAUTS (JMICRO+JL-1)+ZRIAUTS (JL)*ZMAXTIME(JL)
ZTOT_RVDEPG (JMICRO+JL-1)=ZTOT_RVDEPG (JMICRO+JL-1)+ZRVDEPG (JL)*ZMAXTIME(JL)
ZTOT_RCAUTR (JMICRO+JL-1)=ZTOT_RCAUTR (JMICRO+JL-1)+ZRCAUTR (JL)*ZMAXTIME(JL)
ZTOT_RCACCR (JMICRO+JL-1)=ZTOT_RCACCR (JMICRO+JL-1)+ZRCACCR (JL)*ZMAXTIME(JL)
ZTOT_RREVAV (JMICRO+JL-1)=ZTOT_RREVAV (JMICRO+JL-1)+ZRREVAV (JL)*ZMAXTIME(JL)
ZTOT_RCRIMSS(JMICRO+JL-1)=ZTOT_RCRIMSS(JMICRO+JL-1)+ZRCRIMSS (JL)*ZMAXTIME(JL)
ZTOT_RCRIMSG(JMICRO+JL-1)=ZTOT_RCRIMSG(JMICRO+JL-1)+ZRCRIMSG (JL)*ZMAXTIME(JL)
ZTOT_RSRIMCG(JMICRO+JL-1)=ZTOT_RSRIMCG(JMICRO+JL-1)+ZRSRIMCG (JL)*ZMAXTIME(JL)+ZRSRIMCG_MR(JL)
ZTOT_RRACCSS(JMICRO+JL-1)=ZTOT_RRACCSS(JMICRO+JL-1)+ZRRACCSS (JL)*ZMAXTIME(JL)
ZTOT_RRACCSG(JMICRO+JL-1)=ZTOT_RRACCSG(JMICRO+JL-1)+ZRRACCSG (JL)*ZMAXTIME(JL)
ZTOT_RSACCRG(JMICRO+JL-1)=ZTOT_RSACCRG(JMICRO+JL-1)+ZRSACCRG (JL)*ZMAXTIME(JL)
ZTOT_RSMLTG (JMICRO+JL-1)=ZTOT_RSMLTG (JMICRO+JL-1)+ZRSMLTG (JL)*ZMAXTIME(JL)
ZTOT_RCMLTSR(JMICRO+JL-1)=ZTOT_RCMLTSR(JMICRO+JL-1)+ZRCMLTSR (JL)*ZMAXTIME(JL)
ZTOT_RICFRRG(JMICRO+JL-1)=ZTOT_RICFRRG(JMICRO+JL-1)+ZRICFRRG (JL)*ZMAXTIME(JL)
ZTOT_RRCFRIG(JMICRO+JL-1)=ZTOT_RRCFRIG(JMICRO+JL-1)+ZRRCFRIG (JL)*ZMAXTIME(JL)
ZTOT_RICFRR (JMICRO+JL-1)=ZTOT_RICFRR (JMICRO+JL-1)+ZRICFRR (JL)*ZMAXTIME(JL)
ZTOT_RCWETG (JMICRO+JL-1)=ZTOT_RCWETG (JMICRO+JL-1)+ZRCWETG (JL)*ZMAXTIME(JL)
ZTOT_RIWETG (JMICRO+JL-1)=ZTOT_RIWETG (JMICRO+JL-1)+ZRIWETG (JL)*ZMAXTIME(JL)
ZTOT_RRWETG (JMICRO+JL-1)=ZTOT_RRWETG (JMICRO+JL-1)+ZRRWETG (JL)*ZMAXTIME(JL)
ZTOT_RSWETG (JMICRO+JL-1)=ZTOT_RSWETG (JMICRO+JL-1)+ZRSWETG (JL)*ZMAXTIME(JL)
ZTOT_RWETGH (JMICRO+JL-1)=ZTOT_RWETGH (JMICRO+JL-1)+ZRWETGH (JL)*ZMAXTIME(JL)+ZRWETGH_MR(JL)
ZTOT_RCDRYG (JMICRO+JL-1)=ZTOT_RCDRYG (JMICRO+JL-1)+ZRCDRYG (JL)*ZMAXTIME(JL)
ZTOT_RIDRYG (JMICRO+JL-1)=ZTOT_RIDRYG (JMICRO+JL-1)+ZRIDRYG (JL)*ZMAXTIME(JL)
ZTOT_RRDRYG (JMICRO+JL-1)=ZTOT_RRDRYG (JMICRO+JL-1)+ZRRDRYG (JL)*ZMAXTIME(JL)
ZTOT_RSDRYG (JMICRO+JL-1)=ZTOT_RSDRYG (JMICRO+JL-1)+ZRSDRYG (JL)*ZMAXTIME(JL)
ZTOT_RGMLTR (JMICRO+JL-1)=ZTOT_RGMLTR (JMICRO+JL-1)+ZRGMLTR (JL)*ZMAXTIME(JL)
ZTOT_RCWETH (JMICRO+JL-1)=ZTOT_RCWETH (JMICRO+JL-1)+ZRCWETH (JL)*ZMAXTIME(JL)
ZTOT_RIWETH (JMICRO+JL-1)=ZTOT_RIWETH (JMICRO+JL-1)+ZRIWETH (JL)*ZMAXTIME(JL)
ZTOT_RSWETH (JMICRO+JL-1)=ZTOT_RSWETH (JMICRO+JL-1)+ZRSWETH (JL)*ZMAXTIME(JL)
ZTOT_RGWETH (JMICRO+JL-1)=ZTOT_RGWETH (JMICRO+JL-1)+ZRGWETH (JL)*ZMAXTIME(JL)
ZTOT_RRWETH (JMICRO+JL-1)=ZTOT_RRWETH (JMICRO+JL-1)+ZRRWETH (JL)*ZMAXTIME(JL)
ZTOT_RCDRYH (JMICRO+JL-1)=ZTOT_RCDRYH (JMICRO+JL-1)+ZRCDRYH (JL)*ZMAXTIME(JL)
ZTOT_RIDRYH (JMICRO+JL-1)=ZTOT_RIDRYH (JMICRO+JL-1)+ZRIDRYH (JL)*ZMAXTIME(JL)
ZTOT_RSDRYH (JMICRO+JL-1)=ZTOT_RSDRYH (JMICRO+JL-1)+ZRSDRYH (JL)*ZMAXTIME(JL)
ZTOT_RRDRYH (JMICRO+JL-1)=ZTOT_RRDRYH (JMICRO+JL-1)+ZRRDRYH (JL)*ZMAXTIME(JL)
ZTOT_RGDRYH (JMICRO+JL-1)=ZTOT_RGDRYH (JMICRO+JL-1)+ZRGDRYH (JL)*ZMAXTIME(JL)
ZTOT_RDRYHG (JMICRO+JL-1)=ZTOT_RDRYHG (JMICRO+JL-1)+ZRDRYHG (JL)*ZMAXTIME(JL)
ZTOT_RHMLTR (JMICRO+JL-1)=ZTOT_RHMLTR (JMICRO+JL-1)+ZRHMLTR (JL)*ZMAXTIME(JL)
ZTOT_RIMLTC (JMICRO+JL-1)=ZTOT_RIMLTC (JMICRO+JL-1)+ZRIMLTC_MR(JL)
ZTOT_RCBERI (JMICRO+JL-1)=ZTOT_RCBERI (JMICRO+JL-1)+ZRCBERI (JL)*ZMAXTIME(JL)
ENDDO
ENDIF
!
!*** 4.5 Next loop
!
LSOFT=.TRUE. ! We try to adjust tendencies (inner while loop)
ENDDO
ENDDO
RIETTE Sébastien
committed
IF(GEXT_TEND) THEN
!Z..T variables contain the external tendency, we substract it
DO JL=1, IMICRO
ZVART(JL, JV) = ZVART(JL, JV) - ZEXTPK(JL, JV) * PTSTEP
ENDDO
ENDDO
ENDIF
!-------------------------------------------------------------------------------
!
!* 5. UNPACKING DIAGNOSTICS
! ---------------------
!
DO JL=1, IMICRO
ZCITOUT (I1(JL),I2(JL),I3(JL))=ZCIT (JL)
IF(OWARM) THEN
PEVAP3D(I1(JL),I2(JL),I3(JL))=ZRREVAV(JL)
ENDIF
ZWR(I1(JL),I2(JL),I3(JL),IRV)=ZVART(JL, IRV)
ZWR(I1(JL),I2(JL),I3(JL),IRC)=ZVART(JL, IRC)
ZWR(I1(JL),I2(JL),I3(JL),IRR)=ZVART(JL, IRR)
ZWR(I1(JL),I2(JL),I3(JL),IRI)=ZVART(JL, IRI)
ZWR(I1(JL),I2(JL),I3(JL),IRS)=ZVART(JL, IRS)
ZWR(I1(JL),I2(JL),I3(JL),IRG)=ZVART(JL, IRG)
IF (KRR==7) THEN
ZWR(I1(JL),I2(JL),I3(JL),IRH)=ZVART(JL, IRH)
ENDIF
ENDDO
ENDDO ! JMICRO
ENDIF ! KSIZE > 0
PCIT(:,:,:)=ZCITOUT(:,:,:)
!==========================================================================================================
RIETTE Sébastien
committed
!* 6. COMPUTES THE SLOW COLD PROCESS SOURCES OUTSIDE OF ODMICRO POINTS
! ----------------------------------------------------------------
!
DO JK=D%NKTB,D%NKTE
DO JJ=D%NJB,D%NJE
!DIR$ VECTOR ALWAYS
DO CONCURRENT (JI=D%NIB:D%NIE)
IF (.NOT. ODMICRO(JI, JJ, JK)) THEN
ZW0D=ZZ_LSFACT(JI, JJ, JK)/PEXN(JI, JJ, JK)
ENDIF
CALL ICE4_NUCLEATION_ELEM(CST, PARAMI, ICEP, ICED, .NOT. ODMICRO(JI, JJ, JK), &
PTHT(JI, JJ, JK), PPABST(JI, JJ, JK), PRHODREF(JI, JJ, JK), &
PEXN(JI, JJ, JK), ZW0D, ZT(JI, JJ, JK), &
PRVT(JI, JJ, JK), &
PCIT(JI, JJ, JK), ZZ_RVHENI_MR(JI, JJ, JK))
ENDDO
ENDDO
ENDDO
!
!-------------------------------------------------------------------------------
!
!* 7. TOTAL TENDENCIES
! ----------------
!
!
!*** 7.1 total tendencies limited by available species
!
DO JK = D%NKTB, D%NKTE
DO JJ = D%NJB, D%NJE
DO CONCURRENT (JI=D%NIB:D%NIE)
!LV/LS
ZZ_LSFACT(JI,JJ,JK)=ZZ_LSFACT(JI,JJ,JK)/PEXNREF(JI,JJ,JK)
ZZ_LVFACT(JI,JJ,JK)=ZZ_LVFACT(JI,JJ,JK)/PEXNREF(JI,JJ,JK)
!Tendency dure to nucleation on non ODMICRO points
ZZ_RVHENI(JI,JJ,JK) = MIN(PRVS(JI,JJ,JK), ZZ_RVHENI_MR(JI,JJ,JK)/PTSTEP)
!Hydrometeor tendencies is the difference between old state and new state (can be negative)
ZWR(JI,JJ,JK,IRV)=(ZWR(JI,JJ,JK,IRV)-PRVT(JI,JJ,JK))*ZINV_TSTEP
ZWR(JI,JJ,JK,IRC)=(ZWR(JI,JJ,JK,IRC)-PRCT(JI,JJ,JK))*ZINV_TSTEP
ZWR(JI,JJ,JK,IRR)=(ZWR(JI,JJ,JK,IRR)-PRRT(JI,JJ,JK))*ZINV_TSTEP
ZWR(JI,JJ,JK,IRI)=(ZWR(JI,JJ,JK,IRI)-PRIT(JI,JJ,JK))*ZINV_TSTEP
ZWR(JI,JJ,JK,IRS)=(ZWR(JI,JJ,JK,IRS)-PRST(JI,JJ,JK))*ZINV_TSTEP
ZWR(JI,JJ,JK,IRG)=(ZWR(JI,JJ,JK,IRG)-PRGT(JI,JJ,JK))*ZINV_TSTEP
IF(KRR==7) THEN
ZWR(JI,JJ,JK,IRH)=(ZWR(JI,JJ,JK,IRH)-PRHT(JI,JJ,JK))*ZINV_TSTEP
ENDIF
!Theta tendency computed from hydrometeors tendencies
ZWR(JI,JJ,JK, ITH) = (ZWR(JI,JJ,JK,IRC)+ZWR(JI,JJ,JK,IRR))*ZZ_LVFACT(JI,JJ,JK)+ &
& (ZWR(JI,JJ,JK,IRI)+ZWR(JI,JJ,JK,IRS)+ZWR(JI,JJ,JK,IRG)+ &
& ZWR(JI,JJ,JK,IRH))*ZZ_LSFACT(JI,JJ,JK)
!We apply these tendencies to the S variables
!including the nucleation part
PTHS(JI,JJ,JK) = PTHS(JI,JJ,JK) + ZWR(JI,JJ,JK,ITH)+ZZ_RVHENI(JI,JJ,JK)*ZZ_LSFACT(JI,JJ,JK)
PRVS(JI,JJ,JK) = PRVS(JI,JJ,JK) + ZWR(JI,JJ,JK,IRV)-ZZ_RVHENI(JI,JJ,JK)
PRCS(JI,JJ,JK) = PRCS(JI,JJ,JK) + ZWR(JI,JJ,JK,IRC)
PRRS(JI,JJ,JK) = PRRS(JI,JJ,JK) + ZWR(JI,JJ,JK,IRR)
PRIS(JI,JJ,JK) = PRIS(JI,JJ,JK) + ZWR(JI,JJ,JK,IRI)+ZZ_RVHENI(JI,JJ,JK)
PRSS(JI,JJ,JK) = PRSS(JI,JJ,JK) + ZWR(JI,JJ,JK,IRS)
PRGS(JI,JJ,JK) = PRGS(JI,JJ,JK) + ZWR(JI,JJ,JK,IRG)
IF (KRR==7) THEN
PRHS(JI,JJ,JK) = PRHS(JI,JJ,JK) + ZWR(JI,JJ,JK,IRH)
ENDIF
ENDDO
ENDDO
ENDDO
!
!*** 7.2 LBU_ENABLE case
!
IF(BUCONF%LBU_ENABLE) THEN
IF (BUCONF%LBUDGET_TH) THEN
ZZ_DIFF(:,:,:)=0.
DO JK = D%NKTB, D%NKTE
DO JJ = D%NJB, D%NJE
DO JI = D%NIB, D%NIE
ZZ_DIFF(JI, JJ, JK) = ZZ_LSFACT(JI, JJ, JK) - ZZ_LVFACT(JI, JJ, JK)
ENDDO
ENDDO
ENDDO
ZW(:,:,:) = 0.
DO JL=1, KSIZE
ZW(I1TOT(JL), I2TOT(JL), I3TOT(JL)) = ZTOT_RVHENI(JL) * ZINV_TSTEP
END DO
DO JK = D%NKTB, D%NKTE
DO JJ = D%NJB, D%NJE
DO JI = D%NIB, D%NIE
ZW(JI,JJ,JK)=ZW(JI,JJ,JK)+ZZ_RVHENI(JI,JJ,JK)
ENDDO
ENDDO
ENDDO
IF (BUCONF%LBUDGET_TH) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_TH), 'HENU', ZW(:, :, :)*ZZ_LSFACT(:, :, :)*PRHODJ(:, :, :))
IF (BUCONF%LBUDGET_RV) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RV), 'HENU', -ZW(:, :, :) *PRHODJ(:, :, :))
IF (BUCONF%LBUDGET_RI) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RI), 'HENU', ZW(:, :, :) *PRHODJ(:, :, :))
ZW(:,:,:) = 0.
DO JL=1, KSIZE
ZW(I1TOT(JL), I2TOT(JL), I3TOT(JL)) = ZTOT_RCHONI(JL) * ZINV_TSTEP
END DO
IF (BUCONF%LBUDGET_TH) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_TH), 'HON', ZW(:, :, :)*ZZ_DIFF(:, :, :)*PRHODJ(:, :, :))
IF (BUCONF%LBUDGET_RC) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RC), 'HON', -ZW(:, :, :) *PRHODJ(:, :, :))
IF (BUCONF%LBUDGET_RI) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RI), 'HON', ZW(:, :, :) *PRHODJ(:, :, :))
ZW(:,:,:) = 0.
DO JL=1, KSIZE
ZW(I1TOT(JL), I2TOT(JL), I3TOT(JL)) = ZTOT_RRHONG(JL) * ZINV_TSTEP
END DO
IF (BUCONF%LBUDGET_TH) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_TH), 'SFR', ZW(:, :, :)*ZZ_DIFF(:, :, :)*PRHODJ(:, :, :))
IF (BUCONF%LBUDGET_RR) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RR), 'SFR', -ZW(:, :, :) *PRHODJ(:, :, :))
IF (BUCONF%LBUDGET_RG) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RG), 'SFR', ZW(:, :, :) *PRHODJ(:, :, :))
ZW(:,:,:) = 0.
DO JL=1, KSIZE
ZW(I1TOT(JL), I2TOT(JL), I3TOT(JL)) = ZTOT_RVDEPS(JL) * ZINV_TSTEP
END DO
IF (BUCONF%LBUDGET_TH) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_TH), 'DEPS', ZW(:, :, :)*ZZ_LSFACT(:, :, :)*PRHODJ(:, :, :))
IF (BUCONF%LBUDGET_RV) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RV), 'DEPS', -ZW(:, :, :) *PRHODJ(:, :, :))
IF (BUCONF%LBUDGET_RS) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RS), 'DEPS', ZW(:, :, :) *PRHODJ(:, :, :))
ZW(:,:,:) = 0.
DO JL=1, KSIZE
ZW(I1TOT(JL), I2TOT(JL), I3TOT(JL)) = ZTOT_RIAGGS(JL) * ZINV_TSTEP
END DO
IF (BUCONF%LBUDGET_RI) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RI), 'AGGS', -ZW(:, :, :)*PRHODJ(:, :, :))
IF (BUCONF%LBUDGET_RS) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RS), 'AGGS', ZW(:, :, :)*PRHODJ(:, :, :))
ZW(:,:,:) = 0.
DO JL=1, KSIZE
ZW(I1TOT(JL), I2TOT(JL), I3TOT(JL)) = ZTOT_RIAUTS(JL) * ZINV_TSTEP
END DO
IF (BUCONF%LBUDGET_RI) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RI), 'AUTS', -ZW(:, :, :)*PRHODJ(:, :, :))
IF (BUCONF%LBUDGET_RS) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RS), 'AUTS', ZW(:, :, :)*PRHODJ(:, :, :))
ZW(:,:,:) = 0.
DO JL=1, KSIZE
ZW(I1TOT(JL), I2TOT(JL), I3TOT(JL)) = ZTOT_RVDEPG(JL) * ZINV_TSTEP
END DO
IF (BUCONF%LBUDGET_TH) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_TH), 'DEPG', ZW(:, :, :)*ZZ_LSFACT(:, :, :)*PRHODJ(:, :, :))
IF (BUCONF%LBUDGET_RV) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RV), 'DEPG', -ZW(:, :, :) *PRHODJ(:, :, :))
IF (BUCONF%LBUDGET_RG) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RG), 'DEPG', ZW(:, :, :) *PRHODJ(:, :, :))
IF(OWARM) THEN
ZW(:,:,:) = 0.
DO JL=1, KSIZE
ZW(I1TOT(JL), I2TOT(JL), I3TOT(JL)) = ZTOT_RCAUTR(JL) * ZINV_TSTEP
END DO
IF (BUCONF%LBUDGET_RC) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RC), 'AUTO', -ZW(:, :, :)*PRHODJ(:, :, :))
IF (BUCONF%LBUDGET_RR) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RR), 'AUTO', ZW(:, :, :)*PRHODJ(:, :, :))
ZW(:,:,:) = 0.
DO JL=1, KSIZE
ZW(I1TOT(JL), I2TOT(JL), I3TOT(JL)) = ZTOT_RCACCR(JL) * ZINV_TSTEP
END DO
IF (BUCONF%LBUDGET_RC) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RC), 'ACCR', -ZW(:, :, :)*PRHODJ(:, :, :))
IF (BUCONF%LBUDGET_RR) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RR), 'ACCR', ZW(:, :, :)*PRHODJ(:, :, :))
ZW(:,:,:) = 0.
DO JL=1, KSIZE
ZW(I1TOT(JL), I2TOT(JL), I3TOT(JL)) = ZTOT_RREVAV(JL) * ZINV_TSTEP
END DO
IF (BUCONF%LBUDGET_TH) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_TH), 'REVA', -ZW(:, :, :)*ZZ_LVFACT(:, :, :)*PRHODJ(:, :, :))
IF (BUCONF%LBUDGET_RV) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RV), 'REVA', ZW(:, :, :) *PRHODJ(:, :, :))
IF (BUCONF%LBUDGET_RR) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RR), 'REVA', -ZW(:, :, :) *PRHODJ(:, :, :))
ENDIF
ZW1(:,:,:) = 0.
DO JL=1, KSIZE
ZW1(I1TOT(JL), I2TOT(JL), I3TOT(JL)) = ZTOT_RCRIMSS(JL) * ZINV_TSTEP
END DO
ZW2(:,:,:) = 0.
DO JL=1, KSIZE
ZW2(I1TOT(JL), I2TOT(JL), I3TOT(JL)) = ZTOT_RCRIMSG(JL) * ZINV_TSTEP
END DO
ZW3(:,:,:) = 0.
DO JL=1, KSIZE
ZW3(I1TOT(JL), I2TOT(JL), I3TOT(JL)) = ZTOT_RSRIMCG(JL) * ZINV_TSTEP
END DO
IF (BUCONF%LBUDGET_TH) &
CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_TH), 'RIM', (ZW1(:, :, :)+ZW2(:, :, :))*ZZ_DIFF(:, :, :)*PRHODJ(:, :, :))
IF (BUCONF%LBUDGET_RC) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RC), 'RIM', (-ZW1(:, :, :)-ZW2(:, :, :))*PRHODJ(:, :, :))
IF (BUCONF%LBUDGET_RS) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RS), 'RIM', ( ZW1(:, :, :)-ZW3(:, :, :))*PRHODJ(:, :, :))
IF (BUCONF%LBUDGET_RG) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RG), 'RIM', ( ZW2(:, :, :)+ZW3(:, :, :))*PRHODJ(:, :, :))
ZW1(:,:,:) = 0.
DO JL=1, KSIZE
ZW1(I1TOT(JL), I2TOT(JL), I3TOT(JL)) = ZTOT_RRACCSS(JL) * ZINV_TSTEP
END DO
ZW2(:,:,:) = 0.
DO JL=1, KSIZE
ZW2(I1TOT(JL), I2TOT(JL), I3TOT(JL)) = ZTOT_RRACCSG(JL) * ZINV_TSTEP
END DO
ZW3(:,:,:) = 0.
DO JL=1, KSIZE
ZW3(I1TOT(JL), I2TOT(JL), I3TOT(JL)) = ZTOT_RSACCRG(JL) * ZINV_TSTEP
END DO
IF (BUCONF%LBUDGET_TH) &
CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_TH), 'ACC', (ZW1(:, :, :)+ZW2(:, :, :) )*ZZ_DIFF(:, :, :)*PRHODJ(:, :, :))
IF (BUCONF%LBUDGET_RR) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RR), 'ACC', (-ZW1(:, :, :)-ZW2(:, :, :))*PRHODJ(:, :, :))
IF (BUCONF%LBUDGET_RS) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RS), 'ACC', ( ZW1(:, :, :)-ZW3(:, :, :))*PRHODJ(:, :, :))
IF (BUCONF%LBUDGET_RG) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RG), 'ACC', ( ZW2(:, :, :)+ZW3(:, :, :))*PRHODJ(:, :, :))
ZW(:,:,:) = 0.
DO JL=1, KSIZE
ZW(I1TOT(JL), I2TOT(JL), I3TOT(JL)) = ZTOT_RSMLTG(JL) * ZINV_TSTEP
END DO
IF (BUCONF%LBUDGET_RS) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RS), 'CMEL', -ZW(:, :, :)*PRHODJ(:, :, :))
IF (BUCONF%LBUDGET_RG) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RG), 'CMEL', ZW(:, :, :)*PRHODJ(:, :, :))
ZW(:,:,:) = 0.
DO JL=1, KSIZE
ZW(I1TOT(JL), I2TOT(JL), I3TOT(JL)) = ZTOT_RCMLTSR(JL) * ZINV_TSTEP
END DO
IF (BUCONF%LBUDGET_RC) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RC), 'CMEL', -ZW(:, :, :)*PRHODJ(:, :, :))
IF (BUCONF%LBUDGET_RR) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RR), 'CMEL', ZW(:, :, :)*PRHODJ(:, :, :))
ZW1(:,:,:) = 0.
DO JL=1, KSIZE
ZW1(I1TOT(JL), I2TOT(JL), I3TOT(JL)) = ZTOT_RICFRRG(JL) * ZINV_TSTEP
END DO
ZW2(:,:,:) = 0.
DO JL=1, KSIZE
ZW2(I1TOT(JL), I2TOT(JL), I3TOT(JL)) = ZTOT_RRCFRIG(JL) * ZINV_TSTEP
END DO
ZW3(:,:,:) = 0.
DO JL=1, KSIZE
ZW3(I1TOT(JL), I2TOT(JL), I3TOT(JL)) = ZTOT_RICFRR(JL) * ZINV_TSTEP
END DO
IF (BUCONF%LBUDGET_TH) &
CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_TH), 'CFRZ', ZW2(:, :, :)*ZZ_DIFF(:, :, :)*PRHODJ(:, :, :))
IF (BUCONF%LBUDGET_RR) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RR), 'CFRZ', (-ZW2(:, :, :)+ZW3(:, :, :))*PRHODJ(:, :, :))
IF (BUCONF%LBUDGET_RI) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RI), 'CFRZ', (-ZW1(:, :, :)-ZW3(:, :, :))*PRHODJ(:, :, :))
IF (BUCONF%LBUDGET_RG) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RG), 'CFRZ', ( ZW1(:, :, :)+ZW2(:, :, :))*PRHODJ(:, :, :))
ZW1(:,:,:) = 0.
DO JL=1, KSIZE
ZW1(I1TOT(JL), I2TOT(JL), I3TOT(JL)) = ZTOT_RCWETG(JL) * ZINV_TSTEP
END DO
ZW2(:,:,:) = 0.
DO JL=1, KSIZE
ZW2(I1TOT(JL), I2TOT(JL), I3TOT(JL)) = ZTOT_RRWETG(JL) * ZINV_TSTEP
END DO
ZW3(:,:,:) = 0.
DO JL=1, KSIZE
ZW3(I1TOT(JL), I2TOT(JL), I3TOT(JL)) = ZTOT_RIWETG(JL) * ZINV_TSTEP
END DO
ZW4(:,:,:) = 0.
DO JL=1, KSIZE
ZW4(I1TOT(JL), I2TOT(JL), I3TOT(JL)) = ZTOT_RSWETG(JL) * ZINV_TSTEP
END DO
IF (BUCONF%LBUDGET_TH) &
CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_TH), 'WETG', (ZW1(:, :, :)+ZW2(:, :, :))*ZZ_DIFF(:, :, :)*PRHODJ(:, :, :))
IF (BUCONF%LBUDGET_RC) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RC), 'WETG', -zw1(:, :, :) *PRHODJ(:, :, :))
IF (BUCONF%LBUDGET_RR) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RR), 'WETG', -zw2(:, :, :) *PRHODJ(:, :, :))
IF (BUCONF%LBUDGET_RI) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RI), 'WETG', -zw3(:, :, :) *PRHODJ(:, :, :))
IF (BUCONF%LBUDGET_RS) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RS), 'WETG', -zw4(:, :, :) *PRHODJ(:, :, :))
IF (BUCONF%LBUDGET_RG) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RG), 'WETG', (ZW1(:, :, :)+ZW2(:, :, :)+ZW3(:, :, :)+ZW4(:, :, :)) &
& *PRHODJ(:, :, :))
IF(KRR==7) THEN
ZW(:,:,:) = 0.
DO JL=1, KSIZE
ZW(I1TOT(JL), I2TOT(JL), I3TOT(JL)) = ZTOT_RWETGH(JL) * ZINV_TSTEP
END DO
IF (BUCONF%LBUDGET_RG) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RG), 'GHCV', -ZW(:, :, :)*PRHODJ(:, :, :))
IF (BUCONF%LBUDGET_RH) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RH), 'GHCV', ZW(:, :, :)*PRHODJ(:, :, :))
END IF
ZW1(:,:,:) = 0.
DO JL=1, KSIZE
ZW1(I1TOT(JL), I2TOT(JL), I3TOT(JL)) = ZTOT_RCDRYG(JL) * ZINV_TSTEP
END DO
ZW2(:,:,:) = 0.
DO JL=1, KSIZE
ZW2(I1TOT(JL), I2TOT(JL), I3TOT(JL)) = ZTOT_RRDRYG(JL) * ZINV_TSTEP
END DO
ZW3(:,:,:) = 0.
DO JL=1, KSIZE
ZW3(I1TOT(JL), I2TOT(JL), I3TOT(JL)) = ZTOT_RIDRYG(JL) * ZINV_TSTEP
END DO
ZW4(:,:,:) = 0.
DO JL=1, KSIZE
ZW4(I1TOT(JL), I2TOT(JL), I3TOT(JL)) = ZTOT_RSDRYG(JL) * ZINV_TSTEP
END DO
IF (BUCONF%LBUDGET_TH) &
CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_TH), 'DRYG', (ZW1(:, :, :)+ZW2(:, :, :) )*ZZ_DIFF(:, :, :)*PRHODJ(:, :, :))
IF (BUCONF%LBUDGET_RC) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RC), 'DRYG', -zw1(:, :, :) *PRHODJ(:, :, :))
IF (BUCONF%LBUDGET_RR) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RR), 'DRYG', -zw2(:, :, :) *PRHODJ(:, :, :))
IF (BUCONF%LBUDGET_RI) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RI), 'DRYG', -zw3(:, :, :) *PRHODJ(:, :, :))
IF (BUCONF%LBUDGET_RS) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RS), 'DRYG', -zw4(:, :, :) *PRHODJ(:, :, :))
IF (BUCONF%LBUDGET_RG) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RG), 'DRYG', (ZW1(:, :, :)+ZW2(:, :, :)+ZW3(:, :, :)+ZW4(:, :, :)) &
& *PRHODJ(:, :, :))
ZW(:,:,:) = 0.
DO JL=1, KSIZE
ZW(I1TOT(JL), I2TOT(JL), I3TOT(JL)) = ZTOT_RGMLTR(JL) * ZINV_TSTEP
END DO
IF (BUCONF%LBUDGET_TH) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_TH), 'GMLT', -ZW(:, :, :)*ZZ_DIFF(:, :, :)*PRHODJ(:, :, :))
IF (BUCONF%LBUDGET_RR) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RR), 'GMLT', ZW(:, :, :) *PRHODJ(:, :, :))
IF (BUCONF%LBUDGET_RG) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RG), 'GMLT', -ZW(:, :, :) *PRHODJ(:, :, :))
IF(KRR==7) THEN
ZW1(:,:,:) = 0.
DO JL=1, KSIZE
ZW1(I1TOT(JL), I2TOT(JL), I3TOT(JL)) = ZTOT_RCWETH(JL) * ZINV_TSTEP
END DO
ZW2(:,:,:) = 0.
DO JL=1, KSIZE
ZW2(I1TOT(JL), I2TOT(JL), I3TOT(JL)) = ZTOT_RRWETH(JL) * ZINV_TSTEP
END DO
ZW3(:,:,:) = 0.
DO JL=1, KSIZE
ZW3(I1TOT(JL), I2TOT(JL), I3TOT(JL)) = ZTOT_RIWETH(JL) * ZINV_TSTEP
END DO
ZW4(:,:,:) = 0.
DO JL=1, KSIZE
ZW4(I1TOT(JL), I2TOT(JL), I3TOT(JL)) = ZTOT_RSWETH(JL) * ZINV_TSTEP
END DO
ZW5(:,:,:) = 0.
DO JL=1, KSIZE
ZW5(I1TOT(JL), I2TOT(JL), I3TOT(JL)) = ZTOT_RGWETH(JL) * ZINV_TSTEP
END DO
IF (BUCONF%LBUDGET_TH) &
CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_TH), 'WETH', (ZW1(:, :, :)+ZW2(:, :, :))*ZZ_DIFF(:, :, :)*PRHODJ(:, :, :))
IF (BUCONF%LBUDGET_RC) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RC), 'WETH', -ZW1(:, :, :) *PRHODJ(:, :, :))
IF (BUCONF%LBUDGET_RR) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RR), 'WETH', -ZW2(:, :, :) *PRHODJ(:, :, :))
IF (BUCONF%LBUDGET_RI) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RI), 'WETH', -ZW3(:, :, :) *PRHODJ(:, :, :))
IF (BUCONF%LBUDGET_RS) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RS), 'WETH', -ZW4(:, :, :) *PRHODJ(:, :, :))
#ifdef REPRO48
#else
IF (BUCONF%LBUDGET_RG) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RG), 'WETH', -ZW5(:, :, :) *PRHODJ(:, :, :))
IF (BUCONF%LBUDGET_RH) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RH), 'WETH', (ZW1(:, :, :)+ZW2(:, :, :)+ZW3(:, :, :)+ &
&ZW4(:, :, :)+ZW5(:, :, : )) *PRHODJ(:, :, :))
#if defined(REPRO48) || defined(REPRO55)
ZW(:,:,:) = 0.
DO JL=1, KSIZE
ZW(I1TOT(JL), I2TOT(JL), I3TOT(JL)) = ZTOT_RGWETH(JL) * ZINV_TSTEP
END DO
IF (BUCONF%LBUDGET_RG) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RG), 'HGCV', (-ZW5(:, :, :)-ZW(:, :, :))*PRHODJ(:, :, :))
IF (BUCONF%LBUDGET_RH) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RH), 'HGCV', ZW(:, :, :)*PRHODJ(:, :, :))
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
ZW1(:,:,:) = 0.
DO JL=1, KSIZE
ZW1(I1TOT(JL), I2TOT(JL), I3TOT(JL)) = ZTOT_RCDRYH(JL) * ZINV_TSTEP
END DO
ZW2(:,:,:) = 0.
DO JL=1, KSIZE
ZW2(I1TOT(JL), I2TOT(JL), I3TOT(JL)) = ZTOT_RRDRYH(JL) * ZINV_TSTEP
END DO
ZW3(:,:,:) = 0.
DO JL=1, KSIZE
ZW3(I1TOT(JL), I2TOT(JL), I3TOT(JL)) = ZTOT_RIDRYH(JL) * ZINV_TSTEP
END DO
ZW4(:,:,:) = 0.
DO JL=1, KSIZE
ZW4(I1TOT(JL), I2TOT(JL), I3TOT(JL)) = ZTOT_RSDRYH(JL) * ZINV_TSTEP
END DO
ZW5(:,:,:) = 0.
DO JL=1, KSIZE
ZW5(I1TOT(JL), I2TOT(JL), I3TOT(JL)) = ZTOT_RGDRYH(JL) * ZINV_TSTEP
END DO
ZW6(:,:,:) = 0.
#if defined(REPRO48) || defined(REPRO55)
!ZW6 must be removed when REPRO48 will be suppressed
DO JL=1, KSIZE
ZW6(I1TOT(JL), I2TOT(JL), I3TOT(JL)) = ZTOT_RDRYHG(JL) * ZINV_TSTEP
END DO
IF (BUCONF%LBUDGET_TH) &
CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_TH), 'DRYH', (ZW1(:, :, :)+ZW2(:, :, :))*ZZ_DIFF(:, :, :)*PRHODJ(:, :, :))
IF (BUCONF%LBUDGET_RC) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RC), 'DRYH', -ZW1(:, :, :) *PRHODJ(:, :, :))
IF (BUCONF%LBUDGET_RR) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RR), 'DRYH', -ZW2(:, :, :) *PRHODJ(:, :, :))
IF (BUCONF%LBUDGET_RI) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RI), 'DRYH', -ZW3(:, :, :) *PRHODJ(:, :, :))
IF (BUCONF%LBUDGET_RS) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RS), 'DRYH', -ZW4(:, :, :) *PRHODJ(:, :, :))
IF (BUCONF%LBUDGET_RG) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RG), 'DRYH', (-ZW5(:, :, :)+ZW6(:, :, : )) *PRHODJ(:, :, :))
IF (BUCONF%LBUDGET_RH) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RH), 'DRYH', (ZW1(:, :, :)+ZW2(:, :, :)+ZW3(:, :, :)+ &
&ZW4(:, :, :)+ZW5(:, :, : )-ZW6(:, :, :)) &
& *PRHODJ(:, :, :))
#if defined(REPRO48) || defined(REPRO55)
#else
!When REPRO48 will be suppressed, ZW6 must be removed
ZW(:,:,:) = 0.
DO JL=1, KSIZE
ZW(I1TOT(JL), I2TOT(JL), I3TOT(JL)) = ZTOT_RDRYHG(JL) * ZINV_TSTEP
END DO
IF (BUCONF%LBUDGET_RG) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RG), 'HGCV', -ZW(:, :, :)*PRHODJ(:, :, :))
IF (BUCONF%LBUDGET_RH) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RH), 'HGCV', ZW(:, :, :)*PRHODJ(:, :, :))
#endif
ZW(:,:,:) = 0.
DO JL=1, KSIZE
ZW(I1TOT(JL), I2TOT(JL), I3TOT(JL)) = ZTOT_RHMLTR(JL) * ZINV_TSTEP
END DO
IF (BUCONF%LBUDGET_TH) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_TH), 'HMLT', -ZW(:, :, :)*ZZ_DIFF(:, :, :)*PRHODJ(:, :, :))
IF (BUCONF%LBUDGET_RR) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RR), 'HMLT', ZW(:, :, :) *PRHODJ(:, :, :))
IF (BUCONF%LBUDGET_RH) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RH), 'HMLT', -ZW(:, :, :) *PRHODJ(:, :, :))
ENDIF
ZW(:,:,:) = 0.
DO JL=1, KSIZE
ZW(I1TOT(JL), I2TOT(JL), I3TOT(JL)) = ZTOT_RIMLTC(JL) * ZINV_TSTEP
END DO
IF (BUCONF%LBUDGET_TH) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_TH), 'IMLT', -ZW(:, :, :)*ZZ_DIFF(:, :, :)*PRHODJ(:, :, :))
IF (BUCONF%LBUDGET_RC) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RC), 'IMLT', ZW(:, :, :) *PRHODJ(:, :, :))
IF (BUCONF%LBUDGET_RI) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RI), 'IMLT', -ZW(:, :, :) *PRHODJ(:, :, :))
ZW(:,:,:) = 0.
DO JL=1, KSIZE
ZW(I1TOT(JL), I2TOT(JL), I3TOT(JL)) = ZTOT_RCBERI(JL) * ZINV_TSTEP
END DO
IF (BUCONF%LBUDGET_TH) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_TH), 'BERFI', ZW(:, :, :)*ZZ_DIFF(:, :, :)*PRHODJ(:, :, :))
IF (BUCONF%LBUDGET_RC) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RC), 'BERFI', -ZW(:, :, :) *PRHODJ(:, :, :))
IF (BUCONF%LBUDGET_RI) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RI), 'BERFI', ZW(:, :, :) *PRHODJ(:, :, :))
ENDIF
!
!*** 7.3 Final tendencies
!
IF (BUCONF%LBU_ENABLE) THEN
IF (BUCONF%LBUDGET_TH) CALL BUDGET_STORE_INIT(TBUDGETS(NBUDGET_TH), 'CORR', PTHS(:, :, :)*PRHODJ(:, :, :))
IF (BUCONF%LBUDGET_RV) CALL BUDGET_STORE_INIT(TBUDGETS(NBUDGET_RV), 'CORR', PRVS(:, :, :)*PRHODJ(:, :, :))
IF (BUCONF%LBUDGET_RC) CALL BUDGET_STORE_INIT(TBUDGETS(NBUDGET_RC), 'CORR', PRCS(:, :, :)*PRHODJ(:, :, :))
IF (BUCONF%LBUDGET_RR) CALL BUDGET_STORE_INIT(TBUDGETS(NBUDGET_RR), 'CORR', PRSS(:, :, :)*PRHODJ(:, :, :))
IF (BUCONF%LBUDGET_RI) CALL BUDGET_STORE_INIT(TBUDGETS(NBUDGET_RI), 'CORR', PRIS(:, :, :)*PRHODJ(:, :, :))
IF (BUCONF%LBUDGET_RS) CALL BUDGET_STORE_INIT(TBUDGETS(NBUDGET_RS), 'CORR', PRSS(:, :, :)*PRHODJ(:, :, :))
IF (BUCONF%LBUDGET_RG) CALL BUDGET_STORE_INIT(TBUDGETS(NBUDGET_RG), 'CORR', PRGS(:, :, :)*PRHODJ(:, :, :))
IF (BUCONF%LBUDGET_RH .AND. KRR==7) CALL BUDGET_STORE_INIT(TBUDGETS(NBUDGET_RH), 'CORR', PRHS(:, :, :)*PRHODJ(:, :, :))
!NOTE:
! This call cannot be moved before the preeceding budget calls because,
! with AROME, the BUDGET_STORE_INIT does nothing. The equivalent is done only
! once before the physics call and copies of the S variables evolve automatically
! internally to the budget (DDH) machinery at each BUDGET_STORE_ADD and
! BUDGET_STORE_END calls. Thus, the difference between the DDH internal version
! of the S variables and the S variables used in the folowing BUDGET_STORE_END
! call must only be due to the correction of negativities.
!
!We correct negativities with conservation
CALL CORRECT_NEGATIVITIES(D, KRR, PRVS, PRCS, PRRS, &
&PRIS, PRSS, PRGS, &
&PTHS, ZZ_LVFACT, ZZ_LSFACT, PRHS)
IF (BUCONF%LBU_ENABLE) THEN
IF (BUCONF%LBUDGET_TH) CALL BUDGET_STORE_END(TBUDGETS(NBUDGET_TH), 'CORR', PTHS(:, :, :)*PRHODJ(:, :, :))
IF (BUCONF%LBUDGET_RV) CALL BUDGET_STORE_END(TBUDGETS(NBUDGET_RV), 'CORR', PRVS(:, :, :)*PRHODJ(:, :, :))
IF (BUCONF%LBUDGET_RC) CALL BUDGET_STORE_END(TBUDGETS(NBUDGET_RC), 'CORR', PRCS(:, :, :)*PRHODJ(:, :, :))
IF (BUCONF%LBUDGET_RR) CALL BUDGET_STORE_END(TBUDGETS(NBUDGET_RR), 'CORR', PRRS(:, :, :)*PRHODJ(:, :, :))
IF (BUCONF%LBUDGET_RI) CALL BUDGET_STORE_END(TBUDGETS(NBUDGET_RI), 'CORR', PRIS(:, :, :)*PRHODJ(:, :, :))
IF (BUCONF%LBUDGET_RS) CALL BUDGET_STORE_END(TBUDGETS(NBUDGET_RS), 'CORR', PRSS(:, :, :)*PRHODJ(:, :, :))
IF (BUCONF%LBUDGET_RG) CALL BUDGET_STORE_END(TBUDGETS(NBUDGET_RG), 'CORR', PRGS(:, :, :)*PRHODJ(:, :, :))
IF (BUCONF%LBUDGET_RH .AND. KRR==7) CALL BUDGET_STORE_END(TBUDGETS(NBUDGET_RH), 'CORR', PRHS(:, :, :)*PRHODJ(:, :, :))
!
!-------------------------------------------------------------------------------
!
!* 8. COMPUTE THE SEDIMENTATION (RS) SOURCE
! -------------------------------------
!
IF(PARAMI%LSEDIM_AFTER) THEN
!
!* 8.1 sedimentation
!
IF (BUCONF%LBUDGET_RC .AND. OSEDIC) CALL BUDGET_STORE_INIT(TBUDGETS(NBUDGET_RC), 'SEDI', PRCS(:, :, :) * PRHODJ(:, :, :))
IF (BUCONF%LBUDGET_RR) CALL BUDGET_STORE_INIT(TBUDGETS(NBUDGET_RR), 'SEDI', PRRS(:, :, :) * PRHODJ(:, :, :))
IF (BUCONF%LBUDGET_RI) CALL BUDGET_STORE_INIT(TBUDGETS(NBUDGET_RI), 'SEDI', PRIS(:, :, :) * PRHODJ(:, :, :))
IF (BUCONF%LBUDGET_RS) CALL BUDGET_STORE_INIT(TBUDGETS(NBUDGET_RS), 'SEDI', PRSS(:, :, :) * PRHODJ(:, :, :))
IF (BUCONF%LBUDGET_RG) CALL BUDGET_STORE_INIT(TBUDGETS(NBUDGET_RG), 'SEDI', PRGS(:, :, :) * PRHODJ(:, :, :))
IF (BUCONF%LBUDGET_RH .AND. KRR==7) CALL BUDGET_STORE_INIT(TBUDGETS(NBUDGET_RH), 'SEDI', PRHS(:, :, :) * PRHODJ(:, :, :))
IF(HSEDIM=='STAT') THEN
IF (KRR==7) THEN
DO JK = D%NKTB,D%NKTE
DO JJ = D%NJB,D%NJE
DO JI = D%NIB,D%NIE
ZRCT(JI,JJ,JK)=PRCS(JI,JJ,JK)*PTSTEP
ZRRT(JI,JJ,JK)=PRRS(JI,JJ,JK)*PTSTEP
ZRIT(JI,JJ,JK)=PRIS(JI,JJ,JK)*PTSTEP
ZRST(JI,JJ,JK)=PRSS(JI,JJ,JK)*PTSTEP
ZRGT(JI,JJ,JK)=PRGS(JI,JJ,JK)*PTSTEP
ZRHT(JI,JJ,JK)=PRHS(JI,JJ,JK)*PTSTEP
ENDDO
ENDDO
ENDDO
CALL ICE4_SEDIMENTATION_STAT(D, CST, ICEP, ICED, &
&PTSTEP, KRR, OSEDIC, PDZZ, &
&PRHODREF, PPABST, PTHT, PRHODJ, &
&PRCS, ZRCT, PRRS, ZRRT, PRIS, ZRIT,&
&PRSS, ZRST, PRGS, ZRGT,&
&PINPRC, PINPRR, ZINPRI, PINPRS, PINPRG, &
&PSEA=PSEA, PTOWN=PTOWN, &
&PINPRH=PINPRH, PRHT=ZRHT, PRHS=PRHS, PFPR=PFPR)
ELSE
DO JK = D%NKTB,D%NKTE
DO JJ = D%NJB,D%NJE
DO JI = D%NIB,D%NIE
ZRCT(JI,JJ,JK)=PRCS(JI,JJ,JK)*PTSTEP
ZRRT(JI,JJ,JK)=PRRS(JI,JJ,JK)*PTSTEP
ZRIT(JI,JJ,JK)=PRIS(JI,JJ,JK)*PTSTEP
ZRST(JI,JJ,JK)=PRSS(JI,JJ,JK)*PTSTEP
ZRGT(JI,JJ,JK)=PRGS(JI,JJ,JK)*PTSTEP
ENDDO
ENDDO
ENDDO
CALL ICE4_SEDIMENTATION_STAT(D, CST, ICEP, ICED, &
&PTSTEP, KRR, OSEDIC, PDZZ, &
&PRHODREF, PPABST, PTHT, PRHODJ, &
&PRCS, ZRCT, PRRS, ZRRT, PRIS, ZRIT,&
&PRSS, ZRST, PRGS, ZRGT,&
&PINPRC, PINPRR, ZINPRI, PINPRS, PINPRG, &
&PSEA=PSEA, PTOWN=PTOWN, &
&PFPR=PFPR)
ENDIF
PINPRS(D%NIB:D%NIE, D%NJB:D%NJE) = PINPRS(D%NIB:D%NIE, D%NJB:D%NJE) + ZINPRI(D%NIB:D%NIE, D%NJB:D%NJE)
!No negativity correction here as we apply sedimentation on PR.S*PTSTEP variables
ELSEIF(HSEDIM=='SPLI') THEN
!SR: It *seems* that we must have two separate calls for ifort
IF(KRR==7) THEN
CALL ICE4_SEDIMENTATION_SPLIT(D, CST, ICEP, ICED, PARAMI, &
&PTSTEP, KRR, OSEDIC, PDZZ, &
&PRHODREF, PPABST, PTHT, PRHODJ, &
&PRCS, PRCT, PRRS, PRRT, PRIS, PRIT, PRSS, PRST, PRGS, PRGT,&
&PINPRC, PINPRR, ZINPRI, PINPRS, PINPRG, &
&PSEA=PSEA, PTOWN=PTOWN, &
&PINPRH=PINPRH, PRHT=PRHT, PRHS=PRHS, PFPR=PFPR)
ELSE
CALL ICE4_SEDIMENTATION_SPLIT(D, CST, ICEP, ICED, PARAMI, &
&PTSTEP, KRR, OSEDIC, PDZZ, &
&PRHODREF, PPABST, PTHT, PRHODJ, &
&PRCS, PRCT, PRRS, PRRT, PRIS, PRIT, PRSS, PRST, PRGS, PRGT,&
&PINPRC, PINPRR, ZINPRI, PINPRS, PINPRG, &
&PSEA=PSEA, PTOWN=PTOWN, &
&PFPR=PFPR)
ENDIF
PINPRS(D%NIB:D%NIE, D%NJB:D%NJE) = PINPRS(D%NIB:D%NIE, D%NJB:D%NJE) + ZINPRI(D%NIB:D%NIE, D%NJB:D%NJE)
!We correct negativities with conservation
!SPLI algorith uses a time-splitting. Inside the loop a temporary m.r. is used.
! It is initialized with the m.r. at T and is modified by two tendencies:
! sedimentation tendency and an external tendency which represents all other
! processes (mainly advection and microphysical processes). If both tendencies
! are negative, sedimentation can remove a species at a given sub-timestep. From
! this point sedimentation stops for the remaining sub-timesteps but the other tendency
! will be still active and will lead to negative values.
! We could prevent the algorithm to not consume too much a species, instead we apply
! a correction here.
CALL CORRECT_NEGATIVITIES(D, KRR, PRVS, PRCS, PRRS, &
&PRIS, PRSS, PRGS, &
&PTHS, ZZ_LVFACT, ZZ_LSFACT, PRHS)
ELSE
CALL PRINT_MSG(NVERB_FATAL, 'GEN', 'RAIN_ICE', 'no sedimentation scheme for HSEDIM='//HSEDIM)
END IF
!
!* 8.2 budget storage
!
IF (BUCONF%LBUDGET_RC .AND. OSEDIC) CALL BUDGET_STORE_END(TBUDGETS(NBUDGET_RC), 'SEDI', PRCS(:, :, :) * PRHODJ(:, :, :))
IF (BUCONF%LBUDGET_RR) CALL BUDGET_STORE_END(TBUDGETS(NBUDGET_RR), 'SEDI', PRRS(:, :, :) * PRHODJ(:, :, :))
IF (BUCONF%LBUDGET_RI) CALL BUDGET_STORE_END(TBUDGETS(NBUDGET_RI), 'SEDI', PRIS(:, :, :) * PRHODJ(:, :, :))
IF (BUCONF%LBUDGET_RS) CALL BUDGET_STORE_END(TBUDGETS(NBUDGET_RS), 'SEDI', PRSS(:, :, :) * PRHODJ(:, :, :))
IF (BUCONF%LBUDGET_RG) CALL BUDGET_STORE_END(TBUDGETS(NBUDGET_RG), 'SEDI', PRGS(:, :, :) * PRHODJ(:, :, :))
IF (BUCONF%LBUDGET_RH .AND. KRR==7) CALL BUDGET_STORE_END(TBUDGETS(NBUDGET_RH), 'SEDI', PRHS(:, :, :) * PRHODJ(:, :, :))
!"sedimentation" of rain fraction
IF (PRESENT(PRHS)) THEN
CALL ICE4_RAINFR_VERT(D, ICED, PRAINFR, PRRS(:,:,:)*PTSTEP, &
&PRSS(:,:,:)*PTSTEP, PRGS(:,:,:)*PTSTEP, PRHS(:,:,:)*PTSTEP)
ELSE
CALL ICE4_RAINFR_VERT(D, ICED, PRAINFR, PRRS(:,:,:)*PTSTEP, &
&PRSS(:,:,:)*PTSTEP, PRGS(:,:,:)*PTSTEP)
ENDIF
ENDIF
!
!-------------------------------------------------------------------------------
!
!* 9. COMPUTE THE FOG DEPOSITION TERM
! -------------------------------------
!
IF (PARAMI%LDEPOSC) THEN !cloud water deposition on vegetation
IF (BUCONF%LBU_ENABLE .AND. BUCONF%LBUDGET_RC) &
& CALL BUDGET_STORE_INIT(TBUDGETS(NBUDGET_RC), 'DEPO', PRCS(:, :, :)*PRHODJ(:, :, :))
PINDEP(:,:)=0.
DO JJ = D%NJB, D%NJE
!DEC$ IVDEP
DO JI = D%NIB, D%NIE
PINDEP(JI, JJ) = PARAMI%XVDEPOSC * PRCT(JI, JJ, D%NKB) * PRHODREF(JI, JJ, D%NKB) / CST%XRHOLW
PRCS(JI, JJ, D%NKB) = PRCS(JI, JJ, D%NKB) - PARAMI%XVDEPOSC * PRCT(JI, JJ, D%NKB) / PDZZ(JI, JJ, D%NKB)
PINPRC(JI, JJ) = PINPRC(JI, JJ) + PINDEP(JI, JJ)
ENDDO
ENDDO
IF (BUCONF%LBU_ENABLE .AND. BUCONF%LBUDGET_RC) &
& CALL BUDGET_STORE_END(TBUDGETS(NBUDGET_RC), 'DEPO', PRCS(:, :, :)*PRHODJ(:, :, :))
ENDIF
IF (LHOOK) CALL DR_HOOK('RAIN_ICE', 1, ZHOOK_HANDLE)
!
CONTAINS
!
SUBROUTINE CORRECT_NEGATIVITIES(D, KRR, PRV, PRC, PRR, &
&PRI, PRS, PRG, &
&PTH, PLVFACT, PLSFACT, PRH)
!
IMPLICIT NONE
!
TYPE(DIMPHYEX_t), INTENT(IN) :: D
INTEGER, INTENT(IN) :: KRR
REAL, DIMENSION(D%NIT, D%NJT, D%NKT), INTENT(INOUT) :: PRV, PRC, PRR, PRI, PRS, PRG, PTH
REAL, DIMENSION(D%NIT, D%NJT, D%NKT), INTENT(IN) :: PLVFACT, PLSFACT
REAL, DIMENSION(D%NIT, D%NJT, D%NKT), OPTIONAL, INTENT(INOUT) :: PRH
!
REAL :: ZW
INTEGER :: JI, JJ, JK
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('RAIN_ICE:CORRECT_NEGATIVITIES', 0, ZHOOK_HANDLE)
!
!We correct negativities with conservation
DO JK = D%NKTB, D%NKTE
DO JJ = D%NJB, D%NJE
DO JI = D%NIB, D%NIE
! 1) deal with negative values for mixing ratio, except for vapor
ZW =PRC(JI,JJ,JK)-MAX(PRC(JI,JJ,JK), 0.)
PRV(JI,JJ,JK)=PRV(JI,JJ,JK)+ZW
PTH(JI,JJ,JK)=PTH(JI,JJ,JK)-ZW*PLVFACT(JI,JJ,JK)
PRC(JI,JJ,JK)=PRC(JI,JJ,JK)-ZW
ZW =PRR(JI,JJ,JK)-MAX(PRR(JI,JJ,JK), 0.)
PRV(JI,JJ,JK)=PRV(JI,JJ,JK)+ZW
PTH(JI,JJ,JK)=PTH(JI,JJ,JK)-ZW*PLVFACT(JI,JJ,JK)
PRR(JI,JJ,JK)=PRR(JI,JJ,JK)-ZW
ZW =PRI(JI,JJ,JK)-MAX(PRI(JI,JJ,JK), 0.)
PRV(JI,JJ,JK)=PRV(JI,JJ,JK)+ZW
PTH(JI,JJ,JK)=PTH(JI,JJ,JK)-ZW*PLSFACT(JI,JJ,JK)
PRI(JI,JJ,JK)=PRI(JI,JJ,JK)-ZW
ZW =PRS(JI,JJ,JK)-MAX(PRS(JI,JJ,JK), 0.)
PRV(JI,JJ,JK)=PRV(JI,JJ,JK)+ZW
PTH(JI,JJ,JK)=PTH(JI,JJ,JK)-ZW*PLSFACT(JI,JJ,JK)
PRS(JI,JJ,JK)=PRS(JI,JJ,JK)-ZW
ZW =PRG(JI,JJ,JK)-MAX(PRG(JI,JJ,JK), 0.)
PRV(JI,JJ,JK)=PRV(JI,JJ,JK)+ZW
PTH(JI,JJ,JK)=PTH(JI,JJ,JK)-ZW*PLSFACT(JI,JJ,JK)
PRG(JI,JJ,JK)=PRG(JI,JJ,JK)-ZW
IF(KRR==7) THEN
ZW =PRH(JI,JJ,JK)-MAX(PRH(JI,JJ,JK), 0.)
PRV(JI,JJ,JK)=PRV(JI,JJ,JK)+ZW
PTH(JI,JJ,JK)=PTH(JI,JJ,JK)-ZW*PLSFACT(JI,JJ,JK)
PRH(JI,JJ,JK)=PRH(JI,JJ,JK)-ZW
ENDIF
! 2) deal with negative vapor mixing ratio
! for rc and ri, we keep ice fraction constant
ZW=MIN(1., MAX(ICED%XRTMIN(1)-PRV(JI,JJ,JK), 0.) / &
&MAX(PRC(JI,JJ,JK)+PRI(JI,JJ,JK), 1.E-20)) ! Proportion of rc+ri to convert into rv
PTH(JI,JJ,JK)=PTH(JI,JJ,JK)-ZW* &
&(PRC(JI,JJ,JK)*PLVFACT(JI,JJ,JK)+PRI(JI,JJ,JK)*PLSFACT(JI,JJ,JK))
PRV(JI,JJ,JK)=PRV(JI,JJ,JK)+ZW*(PRC(JI,JJ,JK)+PRI(JI,JJ,JK))
PRC(JI,JJ,JK)=(1.-ZW)*PRC(JI,JJ,JK)
PRI(JI,JJ,JK)=(1.-ZW)*PRI(JI,JJ,JK)
ZW=MIN(MAX(PRR(JI,JJ,JK), 0.), &
&MAX(ICED%XRTMIN(1)-PRV(JI,JJ,JK), 0.)) ! Quantity of rr to convert into rv
PRV(JI,JJ,JK)=PRV(JI,JJ,JK)+ZW
PRR(JI,JJ,JK)=PRR(JI,JJ,JK)-ZW
PTH(JI,JJ,JK)=PTH(JI,JJ,JK)-ZW*PLVFACT(JI,JJ,JK)
ZW=MIN(MAX(PRS(JI,JJ,JK), 0.), &
&MAX(ICED%XRTMIN(1)-PRV(JI,JJ,JK), 0.)) ! Quantity of rs to convert into rv
PRV(JI,JJ,JK)=PRV(JI,JJ,JK)+ZW
PRS(JI,JJ,JK)=PRS(JI,JJ,JK)-ZW
PTH(JI,JJ,JK)=PTH(JI,JJ,JK)-ZW*PLSFACT(JI,JJ,JK)
ZW=MIN(MAX(PRG(JI,JJ,JK), 0.), &
&MAX(ICED%XRTMIN(1)-PRV(JI,JJ,JK), 0.)) ! Quantity of rg to convert into rv
PRV(JI,JJ,JK)=PRV(JI,JJ,JK)+ZW
PRG(JI,JJ,JK)=PRG(JI,JJ,JK)-ZW
PTH(JI,JJ,JK)=PTH(JI,JJ,JK)-ZW*PLSFACT(JI,JJ,JK)
IF(KRR==7) THEN
ZW=MIN(MAX(PRH(JI,JJ,JK), 0.), &
&MAX(ICED%XRTMIN(1)-PRV(JI,JJ,JK), 0.)) ! Quantity of rh to convert into rv
PRV(JI,JJ,JK)=PRV(JI,JJ,JK)+ZW
PRH(JI,JJ,JK)=PRH(JI,JJ,JK)-ZW
PTH(JI,JJ,JK)=PTH(JI,JJ,JK)-ZW*PLSFACT(JI,JJ,JK)
ENDIF
ENDDO
ENDDO
ENDDO
!
IF (LHOOK) CALL DR_HOOK('RAIN_ICE:CORRECT_NEGATIVITIES', 1, ZHOOK_HANDLE)
!
END SUBROUTINE CORRECT_NEGATIVITIES
!
INCLUDE "ice4_nucleation_elem.func.h"
!
END SUBROUTINE RAIN_ICE