Skip to content
Snippets Groups Projects
Commit b7fc7808 authored by RIETTE Sébastien's avatar RIETTE Sébastien
Browse files

S. Riette 13 Jan 2023: budget pack/unpack and computation separation

parent 51e54955
No related branches found
No related tags found
No related merge requests found
...@@ -44,4 +44,50 @@ INTEGER, PARAMETER :: & ! pointer of fields in microphysic species arrays : ...@@ -44,4 +44,50 @@ INTEGER, PARAMETER :: & ! pointer of fields in microphysic species arrays :
& IRG=6, & ! Graupel & IRG=6, & ! Graupel
& IRH=7 ! Hail & IRH=7 ! Hail
! !
! Pointers for tendency arrays
! Tendencies are computed either directly as a tendency or as a mixing ratio change that is transformed, afterwards, in a tendency
! The second type is suffixed by _MR
! Some final tendencies can have two contributions (one from a tendency, one from a mixing ratio change).
! In the following list, order matters:
! - first are the normal tendencies directly computed as tendencies
! - second are the tendencies computed only from a mixing ratio change
! - third are the indexes used to designate the mising ratio change part of double-contribution tendencies
INTEGER, PARAMETER :: IBUNUM=47, & ! Total number
IBUNUM_MR=3, & ! Number of tendencies computed only from a mixing ratio change
IBUNUM_EXTRA=2 ! Extra terms
INTEGER, PARAMETER :: &
!normal tendencies directly computed as tendencies
& IRCHONI=1, & ! Homogeneous nucleation
& IRVDEPS=2, & ! Deposition on r_s,
& IRIAGGS=3, & ! Aggregation on r_s
& IRIAUTS=4, & ! Autoconversion of r_i for r_s production
& IRVDEPG=5, & ! Deposition on r_g
& IRCAUTR=6, & ! Autoconversion of r_c for r_r production
& IRCACCR=7, & ! Accretion of r_c for r_r production
& IRREVAV=8, & ! Evaporation of r_r
& IRCBERI=9, & ! Bergeron-Findeisen effect
& IRHMLTR=10, & ! Melting of the hailstones
& IRSMLTG=11, & ! Conversion-Melting of the aggregates
& IRCMLTSR=12, & ! Cloud droplet collection onto aggregates by positive temperature
& IRRACCSS=13, IRRACCSG=14, IRSACCRG=15, & ! Rain accretion onto the aggregates
& IRCRIMSS=16, IRCRIMSG=17, IRSRIMCG=18, & ! Cloud droplet riming of the aggregates
& IRICFRRG=19, IRRCFRIG=20, IRICFRR=21, & ! Rain contact freezing
& IRCWETG=22, IRIWETG=23, IRRWETG=24, IRSWETG=25, & ! Graupel wet growth
& IRCDRYG=26, IRIDRYG=27, IRRDRYG=28, IRSDRYG=29, & ! Graupel dry growth
& IRWETGH=30, & ! Conversion of graupel into hail
& IRGMLTR=31, & ! Melting of the graupel
& IRCWETH=32, IRIWETH=33, IRSWETH=34, IRGWETH=35, IRRWETH=36, & ! Dry growth of hailstone
& IRCDRYH=37, IRIDRYH=38, IRSDRYH=39, IRRDRYH=40, IRGDRYH=41, & ! Wet growth of hailstone
& IRDRYHG=42, &
!tendencies computed only with a mixing ratio change
& IRVHENI_MR=43, & ! heterogeneous nucleation mixing ratio change
& IRRHONG_MR=44, & ! Spontaneous freezing mixing ratio change
& IRIMLTC_MR=45, & ! Cloud ice melting mixing ratio change
!Extra term computed as a mixing ratio change, to be added to other term
& IRSRIMCG_MR=46,& ! Cloud droplet riming of the aggregates
& IRWETGH_MR=47 ! Conversion of graupel into hail
INTEGER, PARAMETER, DIMENSION(IBUNUM-IBUNUM_EXTRA+1:IBUNUM) :: IBUEXTRAIND=(/18, 30/)
!
END MODULE MODD_FIELDS_ADDRESS END MODULE MODD_FIELDS_ADDRESS
!MNH_LIC Copyright 1995-2021 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.
!-----------------------------------------------------------------
! ######spl
MODULE MODE_ICE4_BUDGETS
IMPLICIT NONE
CONTAINS
SUBROUTINE ICE4_BUDGETS(D, PARAMI, BUCONF, KSIZE, KPROMA, PTSTEP, KRR, K1, K2, &
PLVFACT, PLSFACT, PRHODJ, &
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, 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
INTEGER, INTENT(IN) :: KPROMA
REAL, INTENT(IN) :: PTSTEP
INTEGER, INTENT(IN) :: KRR
INTEGER, DIMENSION(KPROMA), INTENT(IN) :: K1
INTEGER, DIMENSION(KPROMA), 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) :: 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
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.
DO JK = IKTB, IKTE
DO JIJ = IIJB, IIJE
ZZ_DIFF(JIJ, JK) = PLSFACT(JIJ, JK) - PLVFACT(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(:, :)*PLSFACT(:, :)*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(:, :)*PLSFACT(:, :)*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(:, :)*PLSFACT(:, :)*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(:, :)*PLSFACT(:, :)*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(:, :)*PLVFACT(:, :)*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) || defined(REPRO55)
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
#ifdef REPRO55
IF (BUCONF%LBUDGET_RG) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RG), 'HGCV', -ZW1(:, :)*PRHODJ(:, :))
#endif
#if defined(REPRO48) || defined(REPRO55)
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) || defined(REPRO55)
!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) || defined(REPRO55)
#else
!When REPRO48 will be suppressed, ZW6 must be removed
ZW(:,:) = 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
This diff is collapsed.
This diff is collapsed.
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment