!MNH_LIC Copyright 1995-2023 CNRS, Meteo-France and Universite Paul Sabatier !MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence !MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt !MNH_LIC for details. version 1. !----------------------------------------------------------------- ! Modifications: ! P. Wautelet 14/04/2023: initialize ZZ_LSFACT and ZZ_LVFACT !----------------------------------------------------------------- MODULE MODE_ICE4_BUDGETS IMPLICIT NONE CONTAINS SUBROUTINE ICE4_BUDGETS(D, PARAMI, BUCONF, KSIZE, PTSTEP, KRR, K1, K2, & PLVFACT, PLSFACT, PRHODJ, PEXNREF, & PRVHENI, PBU_PACK, & TBUDGETS, KBUDGETS) ! !* 0. DECLARATIONS ! ------------ ! USE PARKIND1, ONLY : JPRB USE YOMHOOK , ONLY : LHOOK, DR_HOOK USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t USE MODD_BUDGET, ONLY: TBUDGETDATA, TBUDGETCONF_t, NBUDGET_TH, NBUDGET_RV, NBUDGET_RC, & NBUDGET_RI, NBUDGET_RR, NBUDGET_RS, NBUDGET_RG, NBUDGET_RH USE MODD_PARAM_ICE, ONLY: PARAM_ICE_t ! USE MODD_FIELDS_ADDRESS ! index number for prognostic (theta and mixing ratios) and budgets ! USE MODE_BUDGET_PHY, ONLY: BUDGET_STORE_ADD_PHY, BUDGET_STORE_INIT_PHY, BUDGET_STORE_END_PHY ! ! IMPLICIT NONE ! !* 0.1 Declarations of dummy arguments : ! ! ! TYPE(DIMPHYEX_t), INTENT(IN) :: D TYPE(PARAM_ICE_t), INTENT(IN) :: PARAMI TYPE(TBUDGETCONF_t), INTENT(IN) :: BUCONF INTEGER, INTENT(IN) :: KSIZE REAL, INTENT(IN) :: PTSTEP INTEGER, INTENT(IN) :: KRR INTEGER, DIMENSION(KSIZE), INTENT(IN) :: K1 INTEGER, DIMENSION(KSIZE), INTENT(IN) :: K2 REAL, DIMENSION(D%NIJT, D%NKT), INTENT(IN) :: PLVFACT REAL, DIMENSION(D%NIJT, D%NKT), INTENT(IN) :: PLSFACT REAL, DIMENSION(D%NIJT, D%NKT), INTENT(IN) :: PRHODJ REAL, DIMENSION(D%NIJT, D%NKT), INTENT(IN) :: PEXNREF REAL, DIMENSION(D%NIJT, D%NKT), INTENT(IN) :: PRVHENI REAL, DIMENSION(KSIZE, IBUNUM-IBUNUM_EXTRA), INTENT(IN) :: PBU_PACK TYPE(TBUDGETDATA), DIMENSION(KBUDGETS), INTENT(INOUT) :: TBUDGETS INTEGER, INTENT(IN) :: KBUDGETS ! ! !* 0.2 Declarations of local variables : ! REAL(KIND=JPRB) :: ZHOOK_HANDLE ! INTEGER :: JIJ, JK, JL INTEGER :: IKTB, IKTE, IKB, IIJB, IIJE REAL, DIMENSION(D%NIJT, D%NKT) :: ZW1, ZW2, ZW3, ZW4, ZW5, ZW6 ! work array REAL, DIMENSION(D%NIJT, D%NKT) :: ZZ_DIFF, ZZ_LVFACT, ZZ_LSFACT REAL :: ZINV_TSTEP ! !------------------------------------------------------------------------------- IF (LHOOK) CALL DR_HOOK('ICE4_BUDGETS', 0, ZHOOK_HANDLE) ! IKTB=D%NKTB IKTE=D%NKTE IKB=D%NKB IIJB=D%NIJB IIJE=D%NIJE ZINV_TSTEP=1./PTSTEP ! IF (BUCONF%LBUDGET_TH) THEN ZZ_DIFF(:,:) = 0. ZZ_LSFACT(:,:) = 0. ZZ_LVFACT(:,:) = 0. DO JK = IKTB, IKTE DO JIJ = IIJB, IIJE ZZ_LVFACT(JIJ, JK) = PLVFACT(JIJ, JK) / PEXNREF(JIJ, JK) ZZ_LSFACT(JIJ, JK) = PLSFACT(JIJ, JK) / PEXNREF(JIJ, JK) ZZ_DIFF(JIJ, JK) = ZZ_LSFACT(JIJ, JK) - ZZ_LVFACT(JIJ, JK) ENDDO ENDDO END IF ZW1(:,:) = 0. DO JL=1, KSIZE ZW1(K1(JL), K2(JL)) = PBU_PACK(JL, IRVHENI_MR) * ZINV_TSTEP END DO DO JK = IKTB, IKTE DO JIJ = IIJB, IIJE ZW1(JIJ,JK)=ZW1(JIJ,JK)+PRVHENI(JIJ,JK) ENDDO ENDDO #ifdef REPRO48 IF (BUCONF%LBUDGET_TH) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_TH), 'HENU', ZW1(:, :)*ZZ_LSFACT(:, :)*PRHODJ(:, :)) IF (BUCONF%LBUDGET_RV) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RV), 'HENU', -ZW1(:, :) *PRHODJ(:, :)) IF (BUCONF%LBUDGET_RI) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RI), 'HENU', ZW1(:, :) *PRHODJ(:, :)) #else IF (BUCONF%LBUDGET_TH) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_TH), 'HIN', ZW1(:, :)*ZZ_LSFACT(:, :)*PRHODJ(:, :)) IF (BUCONF%LBUDGET_RV) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RV), 'HIN', -ZW1(:, :) *PRHODJ(:, :)) IF (BUCONF%LBUDGET_RI) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RI), 'HIN', ZW1(:, :) *PRHODJ(:, :)) #endif ZW1(:,:) = 0. DO JL=1, KSIZE ZW1(K1(JL), K2(JL)) = PBU_PACK(JL, IRCHONI) * ZINV_TSTEP END DO IF (BUCONF%LBUDGET_TH) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_TH), 'HON', ZW1(:, :)*ZZ_DIFF(:, :)*PRHODJ(:, :)) IF (BUCONF%LBUDGET_RC) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RC), 'HON', -ZW1(:, :) *PRHODJ(:, :)) IF (BUCONF%LBUDGET_RI) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RI), 'HON', ZW1(:, :) *PRHODJ(:, :)) ZW1(:,:) = 0. DO JL=1, KSIZE ZW1(K1(JL), K2(JL)) = PBU_PACK(JL, IRRHONG_MR) * ZINV_TSTEP END DO IF (BUCONF%LBUDGET_TH) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_TH), 'SFR', ZW1(:, :)*ZZ_DIFF(:, :)*PRHODJ(:, :)) IF (BUCONF%LBUDGET_RR) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RR), 'SFR', -ZW1(:, :) *PRHODJ(:, :)) IF (BUCONF%LBUDGET_RG) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RG), 'SFR', ZW1(:, :) *PRHODJ(:, :)) ZW1(:,:) = 0. DO JL=1, KSIZE ZW1(K1(JL), K2(JL)) = PBU_PACK(JL, IRVDEPS) * ZINV_TSTEP END DO IF (BUCONF%LBUDGET_TH) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_TH), 'DEPS', ZW1(:, :)*ZZ_LSFACT(:, :)*PRHODJ(:, :)) IF (BUCONF%LBUDGET_RV) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RV), 'DEPS', -ZW1(:, :) *PRHODJ(:, :)) IF (BUCONF%LBUDGET_RS) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RS), 'DEPS', ZW1(:, :) *PRHODJ(:, :)) ZW1(:,:) = 0. DO JL=1, KSIZE ZW1(K1(JL), K2(JL)) = PBU_PACK(JL, IRIAGGS) * ZINV_TSTEP END DO IF (BUCONF%LBUDGET_RI) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RI), 'AGGS', -ZW1(:, :)*PRHODJ(:, :)) IF (BUCONF%LBUDGET_RS) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RS), 'AGGS', ZW1(:, :)*PRHODJ(:, :)) ZW1(:,:) = 0. DO JL=1, KSIZE ZW1(K1(JL), K2(JL)) = PBU_PACK(JL, IRIAUTS) * ZINV_TSTEP END DO IF (BUCONF%LBUDGET_RI) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RI), 'AUTS', -ZW1(:, :)*PRHODJ(:, :)) IF (BUCONF%LBUDGET_RS) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RS), 'AUTS', ZW1(:, :)*PRHODJ(:, :)) ZW1(:,:) = 0. DO JL=1, KSIZE ZW1(K1(JL), K2(JL)) = PBU_PACK(JL, IRVDEPG) * ZINV_TSTEP END DO IF (BUCONF%LBUDGET_TH) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_TH), 'DEPG', ZW1(:, :)*ZZ_LSFACT(:, :)*PRHODJ(:, :)) IF (BUCONF%LBUDGET_RV) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RV), 'DEPG', -ZW1(:, :) *PRHODJ(:, :)) IF (BUCONF%LBUDGET_RG) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RG), 'DEPG', ZW1(:, :) *PRHODJ(:, :)) IF(PARAMI%LWARM) THEN ZW1(:,:) = 0. DO JL=1, KSIZE ZW1(K1(JL), K2(JL)) = PBU_PACK(JL, IRCAUTR) * ZINV_TSTEP END DO IF (BUCONF%LBUDGET_RC) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RC), 'AUTO', -ZW1(:, :)*PRHODJ(:, :)) IF (BUCONF%LBUDGET_RR) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RR), 'AUTO', ZW1(:, :)*PRHODJ(:, :)) ZW1(:,:) = 0. DO JL=1, KSIZE ZW1(K1(JL), K2(JL)) = PBU_PACK(JL, IRCACCR) * ZINV_TSTEP END DO IF (BUCONF%LBUDGET_RC) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RC), 'ACCR', -ZW1(:, :)*PRHODJ(:, :)) IF (BUCONF%LBUDGET_RR) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RR), 'ACCR', ZW1(:, :)*PRHODJ(:, :)) ZW1(:,:) = 0. DO JL=1, KSIZE ZW1(K1(JL), K2(JL)) = PBU_PACK(JL, IRREVAV) * ZINV_TSTEP END DO IF (BUCONF%LBUDGET_TH) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_TH), 'REVA', -ZW1(:, :)*ZZ_LVFACT(:, :)*PRHODJ(:, :)) IF (BUCONF%LBUDGET_RV) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RV), 'REVA', ZW1(:, :) *PRHODJ(:, :)) IF (BUCONF%LBUDGET_RR) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RR), 'REVA', -ZW1(:, :) *PRHODJ(:, :)) ENDIF ZW1(:,:) = 0. DO JL=1, KSIZE ZW1(K1(JL), K2(JL)) = PBU_PACK(JL, IRCRIMSS) * ZINV_TSTEP END DO ZW2(:,:) = 0. DO JL=1, KSIZE ZW2(K1(JL), K2(JL)) = PBU_PACK(JL, IRCRIMSG) * ZINV_TSTEP END DO ZW3(:,:) = 0. DO JL=1, KSIZE ZW3(K1(JL), K2(JL)) = PBU_PACK(JL, IRSRIMCG) * ZINV_TSTEP END DO IF (BUCONF%LBUDGET_TH) & CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_TH), 'RIM', (ZW1(:, :)+ZW2(:, :))*ZZ_DIFF(:, :)*PRHODJ(:, :)) IF (BUCONF%LBUDGET_RC) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RC), 'RIM', (-ZW1(:, :)-ZW2(:, :))*PRHODJ(:, :)) IF (BUCONF%LBUDGET_RS) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RS), 'RIM', ( ZW1(:, :)-ZW3(:, :))*PRHODJ(:, :)) IF (BUCONF%LBUDGET_RG) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RG), 'RIM', ( ZW2(:, :)+ZW3(:, :))*PRHODJ(:, :)) ZW1(:,:) = 0. DO JL=1, KSIZE ZW1(K1(JL), K2(JL)) = PBU_PACK(JL, IRRACCSS) * ZINV_TSTEP END DO ZW2(:,:) = 0. DO JL=1, KSIZE ZW2(K1(JL), K2(JL)) = PBU_PACK(JL, IRRACCSG) * ZINV_TSTEP END DO ZW3(:,:) = 0. DO JL=1, KSIZE ZW3(K1(JL), K2(JL)) = PBU_PACK(JL, IRSACCRG) * ZINV_TSTEP END DO IF (BUCONF%LBUDGET_TH) & CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_TH), 'ACC', (ZW1(:, :)+ZW2(:, :) )*ZZ_DIFF(:, :)*PRHODJ(:, :)) IF (BUCONF%LBUDGET_RR) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RR), 'ACC', (-ZW1(:, :)-ZW2(:, :))*PRHODJ(:, :)) IF (BUCONF%LBUDGET_RS) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RS), 'ACC', ( ZW1(:, :)-ZW3(:, :))*PRHODJ(:, :)) IF (BUCONF%LBUDGET_RG) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RG), 'ACC', ( ZW2(:, :)+ZW3(:, :))*PRHODJ(:, :)) ZW1(:,:) = 0. DO JL=1, KSIZE ZW1(K1(JL), K2(JL)) = PBU_PACK(JL, IRSMLTG) * ZINV_TSTEP END DO IF (BUCONF%LBUDGET_RS) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RS), 'CMEL', -ZW1(:, :)*PRHODJ(:, :)) IF (BUCONF%LBUDGET_RG) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RG), 'CMEL', ZW1(:, :)*PRHODJ(:, :)) ZW1(:,:) = 0. DO JL=1, KSIZE ZW1(K1(JL), K2(JL)) = PBU_PACK(JL, IRCMLTSR) * ZINV_TSTEP END DO IF (BUCONF%LBUDGET_RC) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RC), 'CMEL', -ZW1(:, :)*PRHODJ(:, :)) IF (BUCONF%LBUDGET_RR) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RR), 'CMEL', ZW1(:, :)*PRHODJ(:, :)) ZW1(:,:) = 0. DO JL=1, KSIZE ZW1(K1(JL), K2(JL)) = PBU_PACK(JL, IRICFRRG) * ZINV_TSTEP END DO ZW2(:,:) = 0. DO JL=1, KSIZE ZW2(K1(JL), K2(JL)) = PBU_PACK(JL, IRRCFRIG) * ZINV_TSTEP END DO ZW3(:,:) = 0. DO JL=1, KSIZE ZW3(K1(JL), K2(JL)) = PBU_PACK(JL, IRICFRR) * ZINV_TSTEP END DO IF (BUCONF%LBUDGET_TH) & CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_TH), 'CFRZ', ZW2(:, :)*ZZ_DIFF(:, :)*PRHODJ(:, :)) IF (BUCONF%LBUDGET_RR) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RR), 'CFRZ', (-ZW2(:, :)+ZW3(:, :))*PRHODJ(:, :)) IF (BUCONF%LBUDGET_RI) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RI), 'CFRZ', (-ZW1(:, :)-ZW3(:, :))*PRHODJ(:, :)) IF (BUCONF%LBUDGET_RG) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RG), 'CFRZ', ( ZW1(:, :)+ZW2(:, :))*PRHODJ(:, :)) ZW1(:,:) = 0. DO JL=1, KSIZE ZW1(K1(JL), K2(JL)) = PBU_PACK(JL, IRCWETG) * ZINV_TSTEP END DO ZW2(:,:) = 0. DO JL=1, KSIZE ZW2(K1(JL), K2(JL)) = PBU_PACK(JL, IRRWETG) * ZINV_TSTEP END DO ZW3(:,:) = 0. DO JL=1, KSIZE ZW3(K1(JL), K2(JL)) = PBU_PACK(JL, IRIWETG) * ZINV_TSTEP END DO ZW4(:,:) = 0. DO JL=1, KSIZE ZW4(K1(JL), K2(JL)) = PBU_PACK(JL, IRSWETG) * ZINV_TSTEP END DO IF (BUCONF%LBUDGET_TH) & CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_TH), 'WETG', (ZW1(:, :)+ZW2(:, :))*ZZ_DIFF(:, :)*PRHODJ(:, :)) IF (BUCONF%LBUDGET_RC) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RC), 'WETG', -ZW1(:, :) *PRHODJ(:, :)) IF (BUCONF%LBUDGET_RR) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RR), 'WETG', -ZW2(:, :) *PRHODJ(:, :)) IF (BUCONF%LBUDGET_RI) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RI), 'WETG', -ZW3(:, :) *PRHODJ(:, :)) IF (BUCONF%LBUDGET_RS) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RS), 'WETG', -ZW4(:, :) *PRHODJ(:, :)) IF (BUCONF%LBUDGET_RG) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RG), 'WETG', (ZW1(:, :)+ZW2(:, :)+ZW3(:, :)+ZW4(:, :)) & & *PRHODJ(:, :)) IF(KRR==7) THEN ZW1(:,:) = 0. DO JL=1, KSIZE ZW1(K1(JL), K2(JL)) = PBU_PACK(JL, IRWETGH) * ZINV_TSTEP END DO IF (BUCONF%LBUDGET_RG) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RG), 'GHCV', -ZW1(:, :)*PRHODJ(:, :)) IF (BUCONF%LBUDGET_RH) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RH), 'GHCV', ZW1(:, :)*PRHODJ(:, :)) END IF ZW1(:,:) = 0. DO JL=1, KSIZE ZW1(K1(JL), K2(JL)) = PBU_PACK(JL, IRCDRYG) * ZINV_TSTEP END DO ZW2(:,:) = 0. DO JL=1, KSIZE ZW2(K1(JL), K2(JL)) = PBU_PACK(JL, IRRDRYG) * ZINV_TSTEP END DO ZW3(:,:) = 0. DO JL=1, KSIZE ZW3(K1(JL), K2(JL)) = PBU_PACK(JL, IRIDRYG) * ZINV_TSTEP END DO ZW4(:,:) = 0. DO JL=1, KSIZE ZW4(K1(JL), K2(JL)) = PBU_PACK(JL, IRSDRYG) * ZINV_TSTEP END DO IF (BUCONF%LBUDGET_TH) & CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_TH), 'DRYG', (ZW1(:, :)+ZW2(:, :) )*ZZ_DIFF(:, :)*PRHODJ(:, :)) IF (BUCONF%LBUDGET_RC) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RC), 'DRYG', -ZW1(:, :) *PRHODJ(:, :)) IF (BUCONF%LBUDGET_RR) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RR), 'DRYG', -ZW2(:, :) *PRHODJ(:, :)) IF (BUCONF%LBUDGET_RI) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RI), 'DRYG', -ZW3(:, :) *PRHODJ(:, :)) IF (BUCONF%LBUDGET_RS) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RS), 'DRYG', -ZW4(:, :) *PRHODJ(:, :)) IF (BUCONF%LBUDGET_RG) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RG), 'DRYG', (ZW1(:, :)+ZW2(:, :)+ZW3(:, :)+ZW4(:, :)) & & *PRHODJ(:, :)) ZW1(:,:) = 0. DO JL=1, KSIZE ZW1(K1(JL), K2(JL)) = PBU_PACK(JL, IRGMLTR) * ZINV_TSTEP END DO IF (BUCONF%LBUDGET_TH) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_TH), 'GMLT', -ZW1(:, :)*ZZ_DIFF(:, :)*PRHODJ(:, :)) IF (BUCONF%LBUDGET_RR) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RR), 'GMLT', ZW1(:, :) *PRHODJ(:, :)) IF (BUCONF%LBUDGET_RG) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RG), 'GMLT', -ZW1(:, :) *PRHODJ(:, :)) IF(KRR==7) THEN ZW1(:,:) = 0. DO JL=1, KSIZE ZW1(K1(JL), K2(JL)) = PBU_PACK(JL, IRCWETH) * ZINV_TSTEP END DO ZW2(:,:) = 0. DO JL=1, KSIZE ZW2(K1(JL), K2(JL)) = PBU_PACK(JL, IRRWETH) * ZINV_TSTEP END DO ZW3(:,:) = 0. DO JL=1, KSIZE ZW3(K1(JL), K2(JL)) = PBU_PACK(JL, IRIWETH) * ZINV_TSTEP END DO ZW4(:,:) = 0. DO JL=1, KSIZE ZW4(K1(JL), K2(JL)) = PBU_PACK(JL, IRSWETH) * ZINV_TSTEP END DO ZW5(:,:) = 0. DO JL=1, KSIZE ZW5(K1(JL), K2(JL)) = PBU_PACK(JL, IRGWETH) * ZINV_TSTEP END DO IF (BUCONF%LBUDGET_TH) & CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_TH), 'WETH', (ZW1(:, :)+ZW2(:, :))*ZZ_DIFF(:, :)*PRHODJ(:, :)) IF (BUCONF%LBUDGET_RC) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RC), 'WETH', -ZW1(:, :) *PRHODJ(:, :)) IF (BUCONF%LBUDGET_RR) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RR), 'WETH', -ZW2(:, :) *PRHODJ(:, :)) IF (BUCONF%LBUDGET_RI) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RI), 'WETH', -ZW3(:, :) *PRHODJ(:, :)) IF (BUCONF%LBUDGET_RS) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RS), 'WETH', -ZW4(:, :) *PRHODJ(:, :)) #ifdef REPRO48 #else IF (BUCONF%LBUDGET_RG) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RG), 'WETH', -ZW5(:, :) *PRHODJ(:, :)) #endif IF (BUCONF%LBUDGET_RH) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RH), 'WETH', (ZW1(:, :)+ZW2(:, :)+ZW3(:, :)+ & &ZW4(:, :)+ZW5(:, : )) *PRHODJ(:, :)) #if defined(REPRO48) ZW1(:,:) = 0. DO JL=1, KSIZE ZW1(K1(JL), K2(JL)) = PBU_PACK(JL, IRGWETH) * ZINV_TSTEP END DO #endif #ifdef REPRO48 IF (BUCONF%LBUDGET_RG) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RG), 'HGCV', (-ZW5(:, :)-ZW1(:, :))*PRHODJ(:, :)) #endif #if defined(REPRO48) IF (BUCONF%LBUDGET_RH) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RH), 'HGCV', ZW1(:, :)*PRHODJ(:, :)) #endif ZW1(:,:) = 0. DO JL=1, KSIZE ZW1(K1(JL), K2(JL)) = PBU_PACK(JL, IRCDRYH) * ZINV_TSTEP END DO ZW2(:,:) = 0. DO JL=1, KSIZE ZW2(K1(JL), K2(JL)) = PBU_PACK(JL, IRRDRYH) * ZINV_TSTEP END DO ZW3(:,:) = 0. DO JL=1, KSIZE ZW3(K1(JL), K2(JL)) = PBU_PACK(JL, IRIDRYH) * ZINV_TSTEP END DO ZW4(:,:) = 0. DO JL=1, KSIZE ZW4(K1(JL), K2(JL)) = PBU_PACK(JL, IRSDRYH) * ZINV_TSTEP END DO ZW5(:,:) = 0. DO JL=1, KSIZE ZW5(K1(JL), K2(JL)) = PBU_PACK(JL, IRGDRYH) * ZINV_TSTEP END DO ZW6(:,:) = 0. #if defined(REPRO48) !ZW6 must be removed when REPRO* will be suppressed DO JL=1, KSIZE ZW6(K1(JL), K2(JL)) = PBU_PACK(JL, IRDRYHG) * ZINV_TSTEP END DO #endif IF (BUCONF%LBUDGET_TH) & CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_TH), 'DRYH', (ZW1(:, :)+ZW2(:, :))*ZZ_DIFF(:, :)*PRHODJ(:, :)) IF (BUCONF%LBUDGET_RC) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RC), 'DRYH', -ZW1(:, :) *PRHODJ(:, :)) IF (BUCONF%LBUDGET_RR) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RR), 'DRYH', -ZW2(:, :) *PRHODJ(:, :)) IF (BUCONF%LBUDGET_RI) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RI), 'DRYH', -ZW3(:, :) *PRHODJ(:, :)) IF (BUCONF%LBUDGET_RS) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RS), 'DRYH', -ZW4(:, :) *PRHODJ(:, :)) IF (BUCONF%LBUDGET_RG) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RG), 'DRYH', (-ZW5(:, :)+ZW6(:, :)) *PRHODJ(:, :)) IF (BUCONF%LBUDGET_RH) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RH), 'DRYH', (ZW1(:, :)+ZW2(:, :)+ZW3(:, :)+ & &ZW4(:, :)+ZW5(:, :)-ZW6(:, :)) & & *PRHODJ(:, :)) #if defined(REPRO48) #else !When REPRO48 will be suppressed, ZW6 must be removed ZW1(:,:) = 0. DO JL=1, KSIZE ZW1(K1(JL), K2(JL)) = PBU_PACK(JL, IRDRYHG) * ZINV_TSTEP END DO IF (BUCONF%LBUDGET_RG) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RG), 'HGCV', -ZW1(:, :)*PRHODJ(:, :)) IF (BUCONF%LBUDGET_RH) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RH), 'HGCV', ZW1(:, :)*PRHODJ(:, :)) #endif ZW1(:,:) = 0. DO JL=1, KSIZE ZW1(K1(JL), K2(JL)) = PBU_PACK(JL, IRHMLTR) * ZINV_TSTEP END DO IF (BUCONF%LBUDGET_TH) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_TH), 'HMLT', -ZW1(:, :)*ZZ_DIFF(:, :)*PRHODJ(:, :)) IF (BUCONF%LBUDGET_RR) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RR), 'HMLT', ZW1(:, :) *PRHODJ(:, :)) IF (BUCONF%LBUDGET_RH) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RH), 'HMLT', -ZW1(:, :) *PRHODJ(:, :)) ENDIF ZW1(:,:) = 0. DO JL=1, KSIZE ZW1(K1(JL), K2(JL)) = PBU_PACK(JL, IRIMLTC_MR) * ZINV_TSTEP END DO IF (BUCONF%LBUDGET_TH) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_TH), 'IMLT', -ZW1(:, :)*ZZ_DIFF(:, :)*PRHODJ(:, :)) IF (BUCONF%LBUDGET_RC) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RC), 'IMLT', ZW1(:, :) *PRHODJ(:, :)) IF (BUCONF%LBUDGET_RI) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RI), 'IMLT', -ZW1(:, :) *PRHODJ(:, :)) ZW1(:,:) = 0. DO JL=1, KSIZE ZW1(K1(JL), K2(JL)) = PBU_PACK(JL, IRCBERI) * ZINV_TSTEP END DO IF (BUCONF%LBUDGET_TH) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_TH), 'BERFI', ZW1(:, :)*ZZ_DIFF(:, :)*PRHODJ(:, :)) IF (BUCONF%LBUDGET_RC) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RC), 'BERFI', -ZW1(:, :) *PRHODJ(:, :)) IF (BUCONF%LBUDGET_RI) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RI), 'BERFI', ZW1(:, :) *PRHODJ(:, :)) ! IF (LHOOK) CALL DR_HOOK('ICE4_BUDGETS', 1, ZHOOK_HANDLE) ! END SUBROUTINE ICE4_BUDGETS ! END MODULE MODE_ICE4_BUDGETS