diff --git a/src/MNH/adv_forcingn.f90 b/src/MNH/adv_forcingn.f90
index 71b55df3e4679a7d95c47ee1381916682dee33b5..4c41fa7834836468fe2f00aea3d9eaf35fd155aa 100644
--- a/src/MNH/adv_forcingn.f90
+++ b/src/MNH/adv_forcingn.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 2010-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2010-2020 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.
@@ -95,22 +95,22 @@ END MODULE MODI_ADV_FORCING_n
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
!! 28/03/2018 P. Wautelet: replace TEMPORAL_DIST by DATETIME_DISTANCE
!! use overloaded comparison operator for date_time
-!!
+! P. Wautelet 02/2020: use the new data structures and subroutines for budgets
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
USE MODD_ADVFRC_n ! Modules for time evolving advfrc
-USE MODD_BUDGET
+use modd_budget, only: lbudget_rv, lbudget_th, NBUDGET_RV, NBUDGET_TH, tbudgets
USE MODD_DYN
USE MODD_LUNIT, ONLY: TLUOUT0
USE MODD_PARAMETERS
USE MODD_TIME
!
+use mode_budget, only: Budget_store_init, Budget_store_end
USE MODE_DATETIME
!
-USE MODI_BUDGET
USE MODI_SHUMAN
!
IMPLICIT NONE
@@ -147,7 +147,10 @@ LOGICAL,DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2),SIZE(PTHM,3)) :: GRELAX_MASK_FRC ! M
!
!* 1. PREPARATION OF FORCING
! ----------------------
-!
+
+if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), '2DADV', prths(:, :, :) )
+if ( lbudget_rv ) call Budget_store_init( tbudgets(NBUDGET_RV), '2DADV', prrs (:, :, :, 1) )
+
ILUOUT0 = TLUOUT0%NLU
!
IF (GSFIRSTCALL) THEN
@@ -228,8 +231,9 @@ END IF
!
!* 3. BUDGET CALLS
! ------------
-IF (LBUDGET_TH) CALL BUDGET (PRTHS,NBUDGET_TH,'2DADV_BU_RTH')
-IF (LBUDGET_RV) CALL BUDGET (PRRS(:,:,:,1),NBUDGET_RV,'2DADV_BU_RRV')
+if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), '2DADV', prths(:, :, :) )
+if ( lbudget_rv ) call Budget_store_end( tbudgets(NBUDGET_RV), '2DADV', prrs (:, :, :, 1) )
+
!----------------------------------------------------------------------------
!
END SUBROUTINE ADV_FORCING_n
diff --git a/src/MNH/advection_metsv.f90 b/src/MNH/advection_metsv.f90
index c57da30e6eefc4fc39c737020950069045ae390e..ca9eb25e730b3db3ff21481fc9f5ae08955784f2 100644
--- a/src/MNH/advection_metsv.f90
+++ b/src/MNH/advection_metsv.f90
@@ -137,13 +137,18 @@ END MODULE MODI_ADVECTION_METSV
!! 07/2017 (V. Vionnet) : add advection of 2D variables at
!! the surface for the blowing snow scheme
! P. Wautelet 20/05/2019: add name argument to ADDnFIELD_ll + new ADD4DFIELD_ll subroutine
+! P. Wautelet 02/2020: use the new data structures and subroutines for budgets
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_BUDGET
-USE MODD_CST
+use modd_budget, only: lbudget_th, lbudget_tke, lbudget_rv, lbudget_rc, &
+ lbudget_rr, lbudget_ri, lbudget_rs, lbudget_rg, lbudget_rh, lbudget_sv, &
+ NBUDGET_TH, NBUDGET_TKE, NBUDGET_RV, NBUDGET_RC, &
+ NBUDGET_RR, NBUDGET_RI, NBUDGET_RS, NBUDGET_RG, NBUDGET_RH, NBUDGET_SV1, &
+ tbudgets
+USE MODD_CST
USE MODD_CTURB, ONLY: XTKEMIN
USE MODD_CONF, ONLY: LNEUTRAL,NHALO,L1D, L2D
use modd_field, only: tfielddata, TYPEREAL
@@ -155,6 +160,7 @@ USE MODD_BLOWSNOW
USE MODD_BLOWSNOW_n
USE MODD_PARAMETERS
!
+use mode_budget, only: Budget_store_init, Budget_store_end
USE MODE_IO_FIELD_WRITE, only: IO_Field_write
USE MODE_ll
USE MODE_MSG
@@ -274,16 +280,29 @@ TYPE(TFIELDDATA) :: TZFIELD
!
!* 0. INITIALIZATION
! --------------
-!
+
+GTKE=(SIZE(PTKET)/=0)
+
+if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH ), 'ADV', prths (:, :, :) )
+if ( lbudget_tke ) call Budget_store_init( tbudgets(NBUDGET_TKE), 'ADV', prtkes(:, :, :) )
+if ( lbudget_rv ) call Budget_store_init( tbudgets(NBUDGET_RV ), 'ADV', prrs (:, :, :, 1) )
+if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC ), 'ADV', prrs (:, :, :, 2) )
+if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR ), 'ADV', prrs (:, :, :, 3) )
+if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI ), 'ADV', prrs (:, :, :, 4) )
+if ( lbudget_rs ) call Budget_store_init( tbudgets(NBUDGET_RS ), 'ADV', prrs (:, :, :, 5) )
+if ( lbudget_rg ) call Budget_store_init( tbudgets(NBUDGET_RG ), 'ADV', prrs (:, :, :, 6) )
+if ( lbudget_rh ) call Budget_store_init( tbudgets(NBUDGET_RH ), 'ADV', prrs (:, :, :, 7) )
+if ( lbudget_sv) then
+ do jsv = 1, ksv
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + jsv ), 'ADV', prsvs(:, :, :, jsv) )
+ end do
+end if
+
ILUOUT = TLUOUT%NLU
!
CALL GET_INDICE_ll(IIB,IJB,IIE,IJE)
IKB=1+JPVEXT
IKE=SIZE(PSVT,3) - JPVEXT
-
-!
-GTKE=(SIZE(PTKET)/=0)
-!
!
IF(LBLOWSNOW) THEN ! Put 2D Canopy blowing snow variables into a 3D array for advection
ZSNWC_INIT = 0.
@@ -656,20 +675,26 @@ END IF
!* 5. BUDGETS
! -------
!
-IF ( LBUDGET_TH ) CALL BUDGET( PRTHS, NBUDGET_TH, 'ADV_BU_RTH' )
-IF ( LBUDGET_TKE ) CALL BUDGET( PRTKES, NBUDGET_TKE, 'ADV_BU_RTKE' )
-IF ( KRR >= 1 .AND. LBUDGET_RV ) CALL BUDGET( PRRS(:, :, :, 1 ), NBUDGET_RV, 'ADV_BU_RRV' )
-IF ( KRR >= 2 .AND. LBUDGET_RC ) CALL BUDGET( PRRS(:, :, :, 2 ), NBUDGET_RC, 'ADV_BU_RRC' )
-IF ( KRR >= 3 .AND. LBUDGET_RR ) CALL BUDGET( PRRS(:, :, :, 3 ), NBUDGET_RR, 'ADV_BU_RRR' )
-IF ( KRR >= 4 .AND. LBUDGET_RI ) CALL BUDGET( PRRS(:, :, :, 4 ), NBUDGET_RI, 'ADV_BU_RRI' )
-IF ( KRR >= 5 .AND. LBUDGET_RS ) CALL BUDGET( PRRS(:, :, :, 5 ), NBUDGET_RS, 'ADV_BU_RRS' )
-IF ( KRR >= 6 .AND. LBUDGET_RG ) CALL BUDGET( PRRS(:, :, :, 6 ), NBUDGET_RG, 'ADV_BU_RRG' )
-IF ( KRR >= 7 .AND. LBUDGET_RH ) CALL BUDGET( PRRS(:, :, :, 7 ), NBUDGET_RH, 'ADV_BU_RRH' )
-DO JSV=1,KSV
- IF ( LBUDGET_SV ) CALL BUDGET (PRSVS(:,:,:,JSV), JSV+NBUDGET_SV1-1, 'ADV_BU_RSV' )
-END DO
-!
+if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH ), 'ADV', prths (:, :, :) )
+if ( lbudget_tke ) call Budget_store_end( tbudgets(NBUDGET_TKE), 'ADV', prtkes(:, :, :) )
+if ( lbudget_rv ) call Budget_store_end( tbudgets(NBUDGET_RV ), 'ADV', prrs (:, :, :, 1) )
+if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC ), 'ADV', prrs (:, :, :, 2) )
+if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR ), 'ADV', prrs (:, :, :, 3) )
+if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI ), 'ADV', prrs (:, :, :, 4) )
+if ( lbudget_rs ) call Budget_store_end( tbudgets(NBUDGET_RS ), 'ADV', prrs (:, :, :, 5) )
+if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG ), 'ADV', prrs (:, :, :, 6) )
+if ( lbudget_rh ) call Budget_store_end( tbudgets(NBUDGET_RH ), 'ADV', prrs (:, :, :, 7) )
+if ( lbudget_sv) then
+ do jsv = 1, ksv
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + jsv ), 'ADV', prsvs(:, :, :, jsv) )
+ end do
+end if
+
IF ((HCLOUD == 'KHKO') .OR. (HCLOUD == 'C2R2')) THEN
+ if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'NEADV', prths(:, :, :) )
+ if ( lbudget_rv ) call Budget_store_init( tbudgets(NBUDGET_RV), 'NEADV', prrs (:, :, :, 1) )
+ if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'NEADV', prrs (:, :, :, 2) )
+
ZEXN(:,:,:)= (PPABST(:,:,:)/XP00)**(XRD/XCPD)
ZT(:,:,:)= PTHT(:,:,:)*ZEXN(:,:,:)
ZLV(:,:,:)=XLVTT +(XCPV-XCL) *(ZT(:,:,:)-XTT)
@@ -690,11 +715,10 @@ IF ((HCLOUD == 'KHKO') .OR. (HCLOUD == 'C2R2')) THEN
PRSVS(:,:,:,JSV) = 0.0
END WHERE
END DO
-!
- IF (LBUDGET_TH) CALL BUDGET (PRTHS(:,:,:) , NBUDGET_TH,'NEADV_BU_RTH')
- IF (LBUDGET_RV) CALL BUDGET (PRRS(:,:,:,1), NBUDGET_RV,'NEADV_BU_RRV')
- IF (LBUDGET_RC) CALL BUDGET (PRRS(:,:,:,2), NBUDGET_RC,'NEADV_BU_RRC')
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'NEADV', prths(:, :, :) )
+ if ( lbudget_rv ) call Budget_store_end( tbudgets(NBUDGET_RV), 'NEADV', prrs (:, :, :, 1) )
+ if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'NEADV', prrs (:, :, :, 2) )
END IF
diff --git a/src/MNH/advection_uvw.f90 b/src/MNH/advection_uvw.f90
index 5e18671a47219b4412412189c3f56502529b283c..596990fd7726b994457ce87aed044a3933d5a6dc 100644
--- a/src/MNH/advection_uvw.f90
+++ b/src/MNH/advection_uvw.f90
@@ -92,7 +92,7 @@ END MODULE MODI_ADVECTION_UVW
!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
!! C.LAC 10/2016 : Add OSPLIT_WENO
! P. Wautelet 20/05/2019: add name argument to ADDnFIELD_ll + new ADD4DFIELD_ll subroutine
-! P. Wautelet 28/01/2020: use the new data structures and subroutines for budgets for U
+! P. Wautelet 02/2020: use the new data structures and subroutines for budgets
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -108,7 +108,6 @@ USE MODE_ll
USE MODI_ADV_BOUNDARIES
USE MODI_ADVECUVW_RK
-USE MODI_BUDGET
USE MODI_CONTRAV
USE MODI_SHUMAN
!
@@ -201,7 +200,9 @@ ZMXM_RHODJ = MXM(PRHODJ)
ZMYM_RHODJ = MYM(PRHODJ)
ZMZM_RHODJ = MZM(1,IKU,1,PRHODJ)
-if ( lbudget_u ) call Budget_store_init( tbudgets(NBUDGET_U), 'ADV', prus )
+if ( lbudget_u ) call Budget_store_init( tbudgets(NBUDGET_U), 'ADV', prus(:, :, :) )
+if ( lbudget_v ) call Budget_store_init( tbudgets(NBUDGET_V), 'ADV', prvs(:, :, :) )
+if ( lbudget_w ) call Budget_store_init( tbudgets(NBUDGET_W), 'ADV', prws(:, :, :) )
!-------------------------------------------------------------------------------
!
@@ -324,10 +325,10 @@ END DO
!* 4. BUDGETS
! -------
!
-if ( lbudget_u ) call Budget_store_end( tbudgets(NBUDGET_U), 'ADV', prus )
+if ( lbudget_u ) call Budget_store_end( tbudgets(NBUDGET_U), 'ADV', prus(:, :, :) )
+if ( lbudget_v ) call Budget_store_end( tbudgets(NBUDGET_V), 'ADV', prvs(:, :, :) )
+if ( lbudget_w ) call Budget_store_end( tbudgets(NBUDGET_W), 'ADV', prws(:, :, :) )
-IF (LBUDGET_V) CALL BUDGET (PRVS,NBUDGET_V,'ADV_BU_RV')
-IF (LBUDGET_W) CALL BUDGET (PRWS,NBUDGET_W,'ADV_BU_RW')
!-------------------------------------------------------------------------------
!
END SUBROUTINE ADVECTION_UVW
diff --git a/src/MNH/advection_uvw_cen.f90 b/src/MNH/advection_uvw_cen.f90
index f1b1d8eb8d9443a6745cf44479d33f425e1ea8aa..cb828e7443367ed648d0bfbcbb08355d98bd42f9 100644
--- a/src/MNH/advection_uvw_cen.f90
+++ b/src/MNH/advection_uvw_cen.f90
@@ -89,7 +89,7 @@ END MODULE MODI_ADVECTION_UVW_CEN
!! Modif
!! J.Escobar 21/03/2013: for HALOK comment all NHALO=1 test
! P. Wautelet 20/05/2019: add name argument to ADDnFIELD_ll + new ADD4DFIELD_ll subroutine
-! P. Wautelet 28/01/2020: use the new data structures and subroutines for budgets for U
+! P. Wautelet 02/2020: use the new data structures and subroutines for budgets
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -106,7 +106,6 @@ USE MODE_ll
USE MODI_ADVECUVW_2ND
USE MODI_ADVECUVW_4TH
-USE MODI_BUDGET
USE MODI_CONTRAV
USE MODI_SHUMAN
@@ -181,7 +180,9 @@ IKU = SIZE(XZHAT)
IKB=1+JPVEXT
IKE=IKU-JPVEXT
-if ( lbudget_u ) call Budget_store_init( tbudgets(NBUDGET_U), 'ADV', prus )
+if ( lbudget_u ) call Budget_store_init( tbudgets(NBUDGET_U), 'ADV', prus(:, :, :) )
+if ( lbudget_v ) call Budget_store_init( tbudgets(NBUDGET_V), 'ADV', prvs(:, :, :) )
+if ( lbudget_w ) call Budget_store_init( tbudgets(NBUDGET_W), 'ADV', prws(:, :, :) )
ZMXM_RHODJ = MXM(PRHODJ)
ZMYM_RHODJ = MYM(PRHODJ)
@@ -252,11 +253,10 @@ PDUM = ZUS(:,:,:) - PUM(:,:,:)
PDVM = ZVS(:,:,:) - PVM(:,:,:)
PDWM = ZWS(:,:,:) - PWM(:,:,:)
-if ( lbudget_u ) call Budget_store_end( tbudgets(NBUDGET_U), 'ADV', prus )
+if ( lbudget_u ) call Budget_store_end( tbudgets(NBUDGET_U), 'ADV', prus(:, :, :) )
+if ( lbudget_v ) call Budget_store_end( tbudgets(NBUDGET_V), 'ADV', prvs(:, :, :) )
+if ( lbudget_w ) call Budget_store_end( tbudgets(NBUDGET_W), 'ADV', prws(:, :, :) )
-IF (LBUDGET_V) CALL BUDGET (PRVS,NBUDGET_V,'ADV_BU_RV')
-IF (LBUDGET_W) CALL BUDGET (PRWS,NBUDGET_W,'ADV_BU_RW')
-!
!-------------------------------------------------------------------------------
!
END SUBROUTINE ADVECTION_UVW_CEN
diff --git a/src/MNH/c2r2_adjust.f90 b/src/MNH/c2r2_adjust.f90
index 124d83e2e845d1dafcbd1041b40a519551408c96..1be09d2308fb03483168e5e77a9c0890c901e0d5 100644
--- a/src/MNH/c2r2_adjust.f90
+++ b/src/MNH/c2r2_adjust.f90
@@ -136,27 +136,29 @@ END MODULE MODI_C2R2_ADJUST
!! March 2006 (O.Geoffroy) Add KHKO scheme
!! October 2009 (G. Tanguy) add ILENCH=LEN(YCOMMENT) after
!! change of YCOMMENT
-!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
-!!
+! P. Wautelet 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet 02/2020: use the new data structures and subroutines for budgets
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_BUDGET
+use modd_budget, only: lbudget_th, lbudget_rv, lbudget_rc, lbudget_sv, &
+ NBUDGET_TH, NBUDGET_RV, NBUDGET_RC, NBUDGET_SV1, &
+ tbudgets
USE MODD_CONF
USE MODD_CST
+USE MODD_FIELD, only: tfielddata, TYPEREAL
USE MODD_IO, ONLY: TFILEDATA
USE MODD_LUNIT_n, ONLY: TLUOUT
USE MODD_NSV, ONLY: NSV_C2R2BEG
USE MODD_PARAMETERS
!
-USE MODD_FIELD, only: tfielddata, TYPEREAL
+use mode_budget, only: Budget_store_init, Budget_store_end
USE MODE_IO_FIELD_WRITE, only: IO_Field_write
USE MODE_MSG
!
USE MODI_CONDENS
-USE MODI_BUDGET
!
IMPLICIT NONE
!
@@ -205,6 +207,14 @@ TYPE(TFIELDDATA) :: TZFIELD
!* 1. PRELIMINARIES
! -------------
!
+if ( lbudget_rv ) call Budget_store_init( tbudgets(NBUDGET_RV), 'COND', prvs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'COND', prcs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'COND', pths(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_c2r2beg ), 'CEVA', pcnucs(:, :, :) * prhodj(:, :, :) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_c2r2beg + 1), 'CEVA', pccs (:, :, :) * prhodj(:, :, :) )
+end if
+
ILUOUT = TLUOUT%NLU
ZEPS= XMV / XMD
!
@@ -419,15 +429,14 @@ END IF
!* 7. STORE THE BUDGET TERMS
! ----------------------
!
-!
-IF (LBUDGET_RV) CALL BUDGET (PRVS(:,:,:) * PRHODJ(:,:,:),NBUDGET_RV,'COND_BU_RRV')
-IF (LBUDGET_RC) CALL BUDGET (PRCS(:,:,:) * PRHODJ(:,:,:),NBUDGET_RC,'COND_BU_RRC')
-IF (LBUDGET_TH) CALL BUDGET (PTHS(:,:,:) * PRHODJ(:,:,:),NBUDGET_TH,'COND_BU_RTH')
-IF (LBUDGET_SV) THEN
- CALL BUDGET (PCNUCS(:,:,:) * PRHODJ(:,:,:),NBUDGET_SV1+(NSV_C2R2BEG-1), 'CEVA_BU_RSV') ! RCN
- CALL BUDGET (PCCS(:,:,:) * PRHODJ(:,:,:),NBUDGET_SV1+(NSV_C2R2BEG-1)+1,'CEVA_BU_RSV') ! RCC
-END IF
-!
+if ( lbudget_rv ) call Budget_store_end( tbudgets(NBUDGET_RV), 'COND', prvs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'COND', prcs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'COND', pths(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_c2r2beg ), 'CEVA', pcnucs(:, :, :) * prhodj(:, :, :) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_c2r2beg + 1), 'CEVA', pccs (:, :, :) * prhodj(:, :, :) )
+end if
+
!------------------------------------------------------------------------------
!
!
diff --git a/src/MNH/ch_monitorn.f90 b/src/MNH/ch_monitorn.f90
index b81da5894992fa6cb6dc9f89b007cdc3a8dcad76..f7865f3f7c46b8aac6b35d386208c9dc7e3d6ad9 100644
--- a/src/MNH/ch_monitorn.f90
+++ b/src/MNH/ch_monitorn.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1995-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1995-2020 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.
@@ -116,6 +116,7 @@ END MODULE MODI_CH_MONITOR_n
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
! P. Wautelet 12/02/2019: bugfix: ZINPRR was not initialized all the time
! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
+! P. Wautelet 02/2020: use the new data structures and subroutines for budgets
!!
!! EXTERNAL
!! --------
@@ -125,7 +126,6 @@ USE MODI_CH_SET_RATES
USE MODI_CH_SET_PHOTO_RATES
USE MODI_CH_SOLVER_n
USE MODI_CH_UPDATE_JVALUES
-USE MODI_BUDGET
USE MODI_CH_INIT_ICE
USE MODI_CH_AQUEOUS_TMICICE
USE MODI_CH_AQUEOUS_TMICKESS
@@ -142,6 +142,7 @@ USE MODI_CH_AER_EQM_CORMASS
USE MODI_CH_AER_SURF
USE MODI_CH_AER_DEPOS
!
+use mode_budget, only: Budget_store_end, Budget_store_init
USE MODE_ll
USE MODE_MODELN_HANDLER
use mode_msg
@@ -154,7 +155,7 @@ USE MODI_CH_PRODLOSS
! IMPLICIT ARGUMENTS
! ------------------
!
-USE MODD_BUDGET
+use modd_budget, only: lbudget_sv, NBUDGET_SV1, tbudgets
USE MODD_LUNIT_n
USE MODD_NSV, ONLY : NSV_CHEMBEG,NSV_CHEMEND,NSV_CHEM,& ! index for chemical SV
NSV_CHACBEG,NSV_CHACEND,NSV_CHAC,& ! index for aqueous SV
@@ -403,7 +404,13 @@ REAL, DIMENSION(SIZE(XRT,1), SIZE(XRT,2)) :: ZINPRR! Rain instant precip
!-------------------------------------------------------------------------------
!
! get model index
- IMI = GET_CURRENT_MODEL_INDEX()
+IMI = GET_CURRENT_MODEL_INDEX()
+
+if ( lbudget_sv ) then
+ do jsv = nsv_chembeg, nsv_chemend
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + jsv), 'CHEM', xrsvs(:, :, :, jsv) )
+ enddo
+endif
!
!* 1. PREPARE MONITOR
! ---------------
@@ -1276,12 +1283,12 @@ DO JSV = 1, SIZE(XSVT,4)
XRSVS(:,:,:,JSV) = MAX((XRSVS(:,:,:,JSV)),XSVMIN(JSV))
END DO
!
-IF (LBUDGET_SV) THEN
- DO JSV=NSV_CHEMBEG,NSV_CHEMEND
- CALL BUDGET(XRSVS(:,:,:,JSV),NBUDGET_SV1-1+JSV,'CHEM_BU_RSV')
- ENDDO
-ENDIF
-!
+if ( lbudget_sv ) then
+ do jsv = nsv_chembeg, nsv_chemend
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + jsv), 'CHEM', xrsvs(:, :, :, jsv) )
+ enddo
+endif
+
!----------------------------------------------------------------------
!
IF ((CPROGRAM =='DIAG ').OR.(L1D)) THEN
diff --git a/src/MNH/drag_veg.f90 b/src/MNH/drag_veg.f90
index fbd159cf2c40746506cc671b2a0f97332be1d8da..2ffe637821308851d5f27107894779e15f644346 100644
--- a/src/MNH/drag_veg.f90
+++ b/src/MNH/drag_veg.f90
@@ -96,7 +96,6 @@ USE MODD_VEG_n
use mode_budget, only: Budget_store_init, Budget_store_end
-USE MODI_BUDGET
USE MODI_MNHGET_SURF_PARAM_n
USE MODI_SHUMAN
@@ -153,10 +152,16 @@ IIU = SIZE(PUT,1)
IJU = SIZE(PUT,2)
IKU = SIZE(PUT,3)
-if ( lbudget_u ) call Budget_store_init( tbudgets(NBUDGET_U), 'DRAG', prus )
-!
-!* 0.3 Initialisation de kelkes variables
-!
+if ( lbudget_u ) call Budget_store_init( tbudgets(NBUDGET_U ), 'DRAG', prus (:, :, :) )
+if ( lbudget_v ) call Budget_store_init( tbudgets(NBUDGET_V ), 'DRAG', prvs (:, :, :) )
+if ( lbudget_tke ) call Budget_store_init( tbudgets(NBUDGET_TKE), 'DRAG', prtkes(:, :, :) )
+
+if ( odepotree ) then
+ if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'DEPOTR', prrs(:, :, :, 2) )
+ if ( lbudget_sv .and. ( hcloud=='C2R2' .or. hcloud=='KHKO' .or. hcloud=='LIMA' ) ) &
+ call Budget_store_init( tbudgets(NBUDGET_SV1-1+(NSV_C2R2BEG+1)), 'DEPOTR', psvs(:, :, :, NSV_C2R2BEG+1) )
+end if
+
ZVH(:,:)=0.
ZLAI(:,:)=0.
ZCDRAG(:,:,:)=0.
@@ -275,13 +280,6 @@ IF (ODEPOTREE) THEN
!
!
END IF
-
-if ( lbudget_u ) call Budget_store_end( tbudgets(NBUDGET_U), 'DRAG', prus )
-
-IF (LBUDGET_V) CALL BUDGET (PRVS,NBUDGET_V,'DRAG_BU_RV')
-IF (LBUDGET_RC) CALL BUDGET (PRRS(:,:,:,2),NBUDGET_RC,'DEPOTR_BU_RRC')
-IF (LBUDGET_SV) CALL BUDGET (PSVS(:,:,:,NSV_C2R2BEG+1),NBUDGET_SV1+(NSV_C2R2BEG-1)+1,'DEPOTR_BU_RSV')
-!
!
!* 3. Computations of TKE tendency due to canopy drag
! ------------------------------------------------
@@ -306,7 +304,15 @@ ZTKES(:,:,:)= (ZTKET(:,:,:) + (ZCDRAG(:,:,:)* ZDENSITY(:,:,:) &
(1.+PTSTEP*ZCDRAG(:,:,:)* ZDENSITY(:,:,:)*SQRT(ZUT(:,:,:)**2+ZVT(:,:,:)**2))
!
PRTKES(:,:,:)=PRTKES(:,:,:)+((ZTKES(:,:,:)-ZTKET(:,:,:))*PRHODJ(:,:,:)/PTSTEP)
-!
-IF (LBUDGET_TKE) CALL BUDGET (PRTKES(:,:,:),NBUDGET_TKE,'DRAG_BU_RTKE')
-!
+
+if ( lbudget_u ) call Budget_store_end( tbudgets(NBUDGET_U ), 'DRAG', prus (:, :, :) )
+if ( lbudget_v ) call Budget_store_end( tbudgets(NBUDGET_V ), 'DRAG', prvs (:, :, :) )
+if ( lbudget_tke ) call Budget_store_end( tbudgets(NBUDGET_TKE), 'DRAG', prtkes(:, :, :) )
+
+if ( odepotree ) then
+ if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'DEPOTR', prrs(:, :, :, 2) )
+ if ( lbudget_sv .and. ( hcloud=='C2R2' .or. hcloud=='KHKO' .or. hcloud=='LIMA' ) ) &
+ call Budget_store_end( tbudgets(NBUDGET_SV1-1+(NSV_C2R2BEG+1)), 'DEPOTR', psvs(:, :, :, NSV_C2R2BEG+1) )
+end if
+
END SUBROUTINE DRAG_VEG
diff --git a/src/MNH/dyn_sources.f90 b/src/MNH/dyn_sources.f90
index 3970a0c030f3577025605ad8724bc45759a81c77..d2c15f0ff9af0317d14f927cc939114364759aa3 100644
--- a/src/MNH/dyn_sources.f90
+++ b/src/MNH/dyn_sources.f90
@@ -147,7 +147,7 @@ END MODULE MODI_DYN_SOURCES
!! Correction 06/10 (C.Lac) Exclude L1D for Coriolis term
!! Modification 03/11 (C.Lac) Split the gravity term due to buoyancy
!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
-! P. Wautelet 28/01/2020: use the new data structures and subroutines for budgets for U
+! P. Wautelet 02/2020: use the new data structures and subroutines for budgets
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -163,7 +163,6 @@ USE MODD_DYN
use mode_budget, only: Budget_store_init, Budget_store_end
USE MODE_MPPDB
-USE MODI_BUDGET
USE MODI_GRADIENT_M
USE MODI_SHUMAN
@@ -224,10 +223,11 @@ IKU = SIZE(PUT,3)
!
! Only when earth rotation is considered but not in 1D and CARTESIAN cases
!
-if ( lbudget_u ) call Budget_store_init( tbudgets(NBUDGET_U), 'CURV', prus )
-
IF ((.NOT.L1D).AND.(.NOT.LCARTESIAN) ) THEN
- IF ( LTHINSHELL ) THEN ! THINSHELL approximation
+ if ( lbudget_u ) call Budget_store_init( tbudgets(NBUDGET_U), 'CURV', prus(:, :, :) )
+ if ( lbudget_v ) call Budget_store_init( tbudgets(NBUDGET_V), 'CURV', prvs(:, :, :) )
+
+ IF ( LTHINSHELL ) THEN ! THINSHELL approximation
!
ZWORK1(:,:,:) = SPREAD( PCURVX(:,:),DIM=3,NCOPIES=IKU ) / XRADIUS
ZWORK2(:,:,:) = SPREAD( PCURVY(:,:),DIM=3,NCOPIES=IKU ) / XRADIUS
@@ -241,7 +241,8 @@ IF ((.NOT.L1D).AND.(.NOT.LCARTESIAN) ) THEN
- ZRVT * MYM( MXF(PUT) * ZWORK2 )
!
ELSE ! NO THINSHELL approximation
-!
+ if ( lbudget_w ) call Budget_store_init( tbudgets(NBUDGET_W), 'CURV', prws(:, :, :) )
+
ZWORK3(:,:,:) = 1.0 / ( XRADIUS + MZF(1,IKU,1,PZZ(:,:,:)) )
ZWORK1(:,:,:) = SPREAD( PCURVX(:,:),DIM=3,NCOPIES=IKU )
ZWORK2(:,:,:) = SPREAD( PCURVY(:,:),DIM=3,NCOPIES=IKU )
@@ -263,33 +264,33 @@ IF ((.NOT.L1D).AND.(.NOT.LCARTESIAN) ) THEN
- ZRVT * MYM( (MXF(PUT) * ZWORK2 + MZF(1,IKU,1,PWT) ) * ZWORK3 )
!
PRWS(:,:,:) = PRWS &
- +MZM(1,IKU,1, ( MXF(ZRUT*PUT) + MYF(ZRVT*PVT) ) * ZWORK3 )
-!
+ +MZM(1,IKU,1, ( MXF(ZRUT*PUT) + MYF(ZRVT*PVT) ) * ZWORK3 )
+
+ if ( lbudget_w ) call Budget_store_end( tbudgets(NBUDGET_W), 'CURV', prws(:, :, :) )
END IF
-!
+
+ if ( lbudget_u ) call Budget_store_end( tbudgets(NBUDGET_U), 'CURV', prus(:, :, :) )
+ if ( lbudget_v ) call Budget_store_end( tbudgets(NBUDGET_V), 'CURV', prvs(:, :, :) )
END IF
!
-if ( lbudget_u ) call Budget_store_end( tbudgets(NBUDGET_U), 'CURV', prus )
-
-IF (LBUDGET_V) CALL BUDGET (PRVS,NBUDGET_V,'CURV_BU_RV')
-IF (LBUDGET_W) CALL BUDGET (PRWS,NBUDGET_W,'CURV_BU_RW')
!
!-------------------------------------------------------------------------------
!
!* 3. COMPUTES THE CORIOLIS TERMS
! ---------------------------
!
-if ( lbudget_u ) call Budget_store_init( tbudgets(NBUDGET_U), 'COR', prus )
-
IF (LCORIO) THEN
-!
+ if ( lbudget_u ) call Budget_store_init( tbudgets(NBUDGET_U), 'COR', prus(:, :, :) )
+ if ( lbudget_v ) call Budget_store_init( tbudgets(NBUDGET_V), 'COR', prvs(:, :, :) )
+
ZWORK3(:,:,:) = SPREAD( PCORIOZ(:,:),DIM=3,NCOPIES=IKU ) * PRHODJ(:,:,:)
!
PRUS(:,:,:) = PRUS + MXM( ZWORK3 * MYF(PVT) )
PRVS(:,:,:) = PRVS - MYM( ZWORK3 * MXF(PUT) )
!
IF ((.NOT.LTHINSHELL) .AND. (.NOT.L1D)) THEN
-!
+ if ( lbudget_w ) call Budget_store_init( tbudgets(NBUDGET_W), 'COR', prws(:, :, :) )
+
ZWORK1(:,:,:) = SPREAD( PCORIOX(:,:),DIM=3,NCOPIES=IKU) * PRHODJ(:,:,:)
ZWORK2(:,:,:) = SPREAD( PCORIOY(:,:),DIM=3,NCOPIES=IKU) * PRHODJ(:,:,:)
!
@@ -298,15 +299,14 @@ IF (LCORIO) THEN
PRVS(:,:,:) = PRVS - MYM( ZWORK1 * MZF(1,IKU,1,PWT) )
!
PRWS(:,:,:) = PRWS + MZM( 1,IKU,1,ZWORK2 * MXF(PUT) + ZWORK1 * MYF(PVT) )
-!
+
+ if ( lbudget_w ) call Budget_store_end( tbudgets(NBUDGET_W), 'COR', prws(:, :, :) )
END IF
-!
-END IF
-!
-if ( lbudget_u ) call Budget_store_end( tbudgets(NBUDGET_U), 'COR', prus )
-IF (LBUDGET_V) CALL BUDGET (PRVS,NBUDGET_V,'COR_BU_RV')
-IF (LBUDGET_W) CALL BUDGET (PRWS,NBUDGET_W,'COR_BU_RW')
+ if ( lbudget_u ) call Budget_store_end( tbudgets(NBUDGET_U), 'COR', prus(:, :, :) )
+ if ( lbudget_v ) call Budget_store_end( tbudgets(NBUDGET_V), 'COR', prvs(:, :, :) )
+END IF
+!
!
!-------------------------------------------------------------------------------
!
@@ -322,7 +322,9 @@ ENDIF
IF( .NOT.L1D ) THEN
!
IF (KRR > 0) THEN
- ZCPD_OV_RD = XCPD / XRD
+ if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'PREF', prths(:, :, :) )
+
+ ZCPD_OV_RD = XCPD / XRD
ZG_OV_CPD = -XG / XCPD
!
! stores the specific heat capacity (Cph) in ZWORK1
@@ -342,10 +344,9 @@ IF( .NOT.L1D ) THEN
* ( ( XRD + XRV * PRT(:,:,:,1) ) * ZCPD_OV_RD / ZWORK1(:,:,:) - 1. ) &
* PTHT(:,:,:)/PEXNREF(:,:,:)*MZF(1,IKU,1,PWT(:,:,:))*(ZG_OV_CPD/PTHVREF(:,:,:) &
-ZD1*4./7.*PEXNREF(:,:,:)/( XRADIUS+MZF(1,IKU,1,PZZ(:,:,:)) ))
-!
+
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'PREF', prths(:, :, :) )
END IF
-!
- IF (LBUDGET_TH) CALL BUDGET (PRTHS,NBUDGET_TH,'PREF_BU_RTH')
!
END IF
!
diff --git a/src/MNH/endstep.f90 b/src/MNH/endstep.f90
index e533c689b22fc96db3756a53a0f2ac4c1582e96f..4a7d01269e6db88ca6e54f2ac97df480b9758f81 100644
--- a/src/MNH/endstep.f90
+++ b/src/MNH/endstep.f90
@@ -192,7 +192,7 @@ END MODULE MODI_ENDSTEP
!! 04/2014 (C.Lac) Check on the positivity of PSVT
!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
!! 02/2019 (S. Bielli) Sea salt : significant sea wave height influences salt emission; 5 salt modes
-! P. Wautelet 28/01/2020: use the new data structures and subroutines for budgets for U
+! P. Wautelet 02/2020: use the new data structures and subroutines for budgets
!------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -286,6 +286,7 @@ INTEGER:: JSV ! loop counters
INTEGER :: IKU
INTEGER :: IIB, IIE ! index of first and last inner mass points along x
INTEGER :: IJB, IJE ! index of first and last inner mass points along y
+real, dimension(:,:,:), allocatable :: zrhodjontime
!
!------------------------------------------------------------------------------
!
@@ -525,48 +526,71 @@ IF (LBU_ENABLE) THEN
NBUCTR_ACTV(1 : NBUDGET_SV1 - 1 + KSV ) = 3
!Division by nbustep to compute average on the selected time period
- if ( lbudget_u ) call Budget_store_end( tbudgets(NBUDGET_U), 'AVEF', put(:, :, :) * prhodj(:, :, :) / ( ptstep * nbustep ) )
-
- IF (LBUDGET_V) CALL BUDGET( PVT(:,:,:) * PRHODJ(:,:,:) / PTSTEP, NBUDGET_V, 'AVEF_BU_RV' )
- IF (LBUDGET_W) CALL BUDGET( PWT(:,:,:) * PRHODJ(:,:,:) / PTSTEP, NBUDGET_W, 'AVEF_BU_RW' )
- IF (LBUDGET_TH) CALL BUDGET( PTHT(:,:,:) * PRHODJ(:,:,:) / PTSTEP, NBUDGET_TH, 'AVEF_BU_RTH' )
- IF (LBUDGET_TKE) CALL BUDGET( PTKET(:,:,:) * PRHODJ(:,:,:) / PTSTEP, NBUDGET_TKE, 'AVEF_BU_RTKE' )
- IF (LBUDGET_RV) CALL BUDGET( PRT(:,:,:,1) * PRHODJ(:,:,:) / PTSTEP, NBUDGET_RV, 'AVEF_BU_RRV' )
- IF (LBUDGET_RC) CALL BUDGET( PRT(:,:,:,2) * PRHODJ(:,:,:) / PTSTEP, NBUDGET_RC, 'AVEF_BU_RRC' )
- IF (LBUDGET_RR) CALL BUDGET( PRT(:,:,:,3) * PRHODJ(:,:,:) / PTSTEP, NBUDGET_RR, 'AVEF_BU_RRR' )
- IF (LBUDGET_RI) CALL BUDGET( PRT(:,:,:,4) * PRHODJ(:,:,:) / PTSTEP, NBUDGET_RI, 'AVEF_BU_RRI' )
- IF (LBUDGET_RS) CALL BUDGET( PRT(:,:,:,5) * PRHODJ(:,:,:) / PTSTEP, NBUDGET_RS, 'AVEF_BU_RRS' )
- IF (LBUDGET_RG) CALL BUDGET( PRT(:,:,:,6) * PRHODJ(:,:,:) / PTSTEP, NBUDGET_RG, 'AVEF_BU_RRG' )
- IF (LBUDGET_RH) CALL BUDGET( PRT(:,:,:,7) * PRHODJ(:,:,:) / PTSTEP, NBUDGET_RH, 'AVEF_BU_RRH' )
- IF (LBUDGET_SV) THEN
- DO JSV=1,KSV
- CALL BUDGET( PSVT(:,:,:,JSV) * PRHODJ(:,:,:) / PTSTEP, JSV + NBUDGET_SV1 - 1, 'AVEF_BU_RSV' )
- END DO
- END IF
+ if ( lbudget_u .or. lbudget_v .or. lbudget_u .or. lbudget_v .or. lbudget_w .or. lbudget_th &
+ .or. lbudget_tke .or. lbudget_rv .or. lbudget_rc .or. lbudget_rr .or. lbudget_ri &
+ .or. lbudget_rs .or. lbudget_rg .or. lbudget_rh .or. lbudget_sv ) then
+ allocate( zrhodjontime( size( prhodj, 1), size( prhodj, 2), size( prhodj, 3) ) )
+ zrhodjontime(:, :, :) = prhodj(:, :, :) / ( ptstep * nbustep )
+ end if
+ if ( lbudget_u ) call Budget_store_end( tbudgets(NBUDGET_U ), 'AVEF', put (:, :, :) * zrhodjontime(:, :, :) )
+ if ( lbudget_v ) call Budget_store_end( tbudgets(NBUDGET_V ), 'AVEF', pvt (:, :, :) * zrhodjontime(:, :, :) )
+ if ( lbudget_w ) call Budget_store_end( tbudgets(NBUDGET_W ), 'AVEF', pwt (:, :, :) * zrhodjontime(:, :, :) )
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH ), 'AVEF', ptht (:, :, :) * zrhodjontime(:, :, :) )
+ if ( lbudget_tke ) call Budget_store_end( tbudgets(NBUDGET_TKE), 'AVEF', ptket(:, :, :) * zrhodjontime(:, :, :) )
+ if ( lbudget_rv ) call Budget_store_end( tbudgets(NBUDGET_RV ), 'AVEF', prt (:, :, :, 1) * zrhodjontime(:, :, :) )
+ if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC ), 'AVEF', prt (:, :, :, 2) * zrhodjontime(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR ), 'AVEF', prt (:, :, :, 3) * zrhodjontime(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI ), 'AVEF', prt (:, :, :, 4) * zrhodjontime(:, :, :) )
+ if ( lbudget_rs ) call Budget_store_end( tbudgets(NBUDGET_RS ), 'AVEF', prt (:, :, :, 5) * zrhodjontime(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG ), 'AVEF', prt (:, :, :, 6) * zrhodjontime(:, :, :) )
+ if ( lbudget_rh ) call Budget_store_end( tbudgets(NBUDGET_RH ), 'AVEF', prt (:, :, :, 7) * zrhodjontime(:, :, :) )
+ if ( lbudget_sv ) then
+ do jsv = 1, ksv
+ call Budget_store_end( tbudgets(jsv + NBUDGET_SV1 - 1), 'AVEF', psvt(:, :, :, jsv) * zrhodjontime(:, :, :) )
+ end do
+ end if
!
NBUPROCCTR (1 : NBUDGET_SV1 - 1 + KSV ) = 2
NBUCTR_ACTV(1 : NBUDGET_SV1 - 1 + KSV ) = 2
- if ( lbudget_u ) call Budget_store_end( tbudgets(NBUDGET_U), 'ENDF', pus(:, :, :) * Mxm( prhodj(:, :, :) ) / ptstep )
+ if ( lbudget_u ) call Budget_store_end( tbudgets(NBUDGET_U ), 'ENDF', pus (:, :, :) * Mxm( prhodj(:, :, :) ) / ptstep )
+ if ( lbudget_v ) call Budget_store_end( tbudgets(NBUDGET_V ), 'ENDF', pvs (:, :, :) * Mym( prhodj(:, :, :) ) / ptstep )
+ if ( lbudget_w ) call Budget_store_end( tbudgets(NBUDGET_W ), 'ENDF', pws (:, :, :) * Mzm( 1, iku, 1, prhodj(:, :, :) ) &
+ / ptstep )
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH ), 'ENDF', pths (:, :, :) * prhodj(:, :, :) / ptstep )
+ if ( lbudget_tke ) call Budget_store_end( tbudgets(NBUDGET_TKE), 'ENDF', ptkes(:, :, :) * prhodj(:, :, :) / ptstep )
+ if ( lbudget_rv ) call Budget_store_end( tbudgets(NBUDGET_RV ), 'ENDF', prs (:, :, :, 1) * prhodj(:, :, :) / ptstep )
+ if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC ), 'ENDF', prs (:, :, :, 2) * prhodj(:, :, :) / ptstep )
+ if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR ), 'ENDF', prs (:, :, :, 3) * prhodj(:, :, :) / ptstep )
+ if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI ), 'ENDF', prs (:, :, :, 4) * prhodj(:, :, :) / ptstep )
+ if ( lbudget_rs ) call Budget_store_end( tbudgets(NBUDGET_RS ), 'ENDF', prs (:, :, :, 5) * prhodj(:, :, :) / ptstep )
+ if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG ), 'ENDF', prs (:, :, :, 6) * prhodj(:, :, :) / ptstep )
+ if ( lbudget_rh ) call Budget_store_end( tbudgets(NBUDGET_RH ), 'ENDF', prs (:, :, :, 7) * prhodj(:, :, :) / ptstep )
+ if ( lbudget_sv ) then
+ do jsv = 1, ksv
+ call Budget_store_end( tbudgets(jsv + NBUDGET_SV1 - 1), 'ENDF', psvs(:, :, :, jsv) * zrhodjontime(:, :, :) )
+ end do
+ end if
- if ( lbudget_u ) call Budget_store_init( tbudgets(NBUDGET_U), 'ASSE', pus(:, :, :) * Mxm( prhodj(:, :, :) ) / ptstep )
+ if ( lbudget_u ) call Budget_store_init( tbudgets(NBUDGET_U ), 'ASSE', pus (:, :, :) * Mxm( prhodj(:, :, :) ) / ptstep )
+ if ( lbudget_v ) call Budget_store_init( tbudgets(NBUDGET_V ), 'ASSE', pvs (:, :, :) * Mym( prhodj(:, :, :) ) / ptstep )
+ if ( lbudget_w ) call Budget_store_init( tbudgets(NBUDGET_W ), 'ASSE', pws (:, :, :) * Mzm( 1, iku, 1, prhodj(:, :, :) ) &
+ / ptstep )
+ if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH ), 'ASSE', pths (:, :, :) * prhodj(:, :, :) / ptstep )
+ if ( lbudget_tke ) call Budget_store_init( tbudgets(NBUDGET_TKE), 'ASSE', ptkes(:, :, :) * prhodj(:, :, :) / ptstep )
+ if ( lbudget_rv ) call Budget_store_init( tbudgets(NBUDGET_RV ), 'ASSE', prs (:, :, :, 1) * prhodj(:, :, :) / ptstep )
+ if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC ), 'ASSE', prs (:, :, :, 2) * prhodj(:, :, :) / ptstep )
+ if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR ), 'ASSE', prs (:, :, :, 3) * prhodj(:, :, :) / ptstep )
+ if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI ), 'ASSE', prs (:, :, :, 4) * prhodj(:, :, :) / ptstep )
+ if ( lbudget_rs ) call Budget_store_init( tbudgets(NBUDGET_RS ), 'ASSE', prs (:, :, :, 5) * prhodj(:, :, :) / ptstep )
+ if ( lbudget_rg ) call Budget_store_init( tbudgets(NBUDGET_RG ), 'ASSE', prs (:, :, :, 6) * prhodj(:, :, :) / ptstep )
+ if ( lbudget_rh ) call Budget_store_init( tbudgets(NBUDGET_RH ), 'ASSE', prs (:, :, :, 7) * prhodj(:, :, :) / ptstep )
+ if ( lbudget_sv ) then
+ do jsv = 1, ksv
+ call Budget_store_init( tbudgets(jsv + NBUDGET_SV1 - 1), 'ASSE', psvs(:, :, :, jsv) * prhodj(:, :, :) / ptstep )
+ end do
+ end if
- IF (LBUDGET_V) CALL BUDGET( PVS * MYM(PRHODJ) / PTSTEP, NBUDGET_V, 'ENDF_BU_RV' )
- IF (LBUDGET_W) CALL BUDGET( PWS * MZM(1,IKU,1,PRHODJ) / PTSTEP, NBUDGET_W, 'ENDF_BU_RW' )
- IF (LBUDGET_TH) CALL BUDGET( PTHS * PRHODJ / PTSTEP, NBUDGET_TH, 'ENDF_BU_RTH' )
- IF (LBUDGET_TKE) CALL BUDGET( PTKES * PRHODJ / PTSTEP, NBUDGET_TKE, 'ENDF_BU_RTKE' )
- IF (LBUDGET_RV) CALL BUDGET( PRS(:,:,:,1) * PRHODJ / PTSTEP, NBUDGET_RV, 'ENDF_BU_RRV' )
- IF (LBUDGET_RC) CALL BUDGET( PRS(:,:,:,2) * PRHODJ / PTSTEP, NBUDGET_RC, 'ENDF_BU_RRC' )
- IF (LBUDGET_RR) CALL BUDGET( PRS(:,:,:,3) * PRHODJ / PTSTEP, NBUDGET_RR, 'ENDF_BU_RRR' )
- IF (LBUDGET_RI) CALL BUDGET( PRS(:,:,:,4) * PRHODJ / PTSTEP, NBUDGET_RI, 'ENDF_BU_RRI' )
- IF (LBUDGET_RS) CALL BUDGET( PRS(:,:,:,5) * PRHODJ / PTSTEP, NBUDGET_RS, 'ENDF_BU_RRS' )
- IF (LBUDGET_RG) CALL BUDGET( PRS(:,:,:,6) * PRHODJ / PTSTEP, NBUDGET_RG, 'ENDF_BU_RRG' )
- IF (LBUDGET_RH) CALL BUDGET( PRS(:,:,:,7) * PRHODJ / PTSTEP, NBUDGET_RH, 'ENDF_BU_RRH' )
- IF (LBUDGET_SV) THEN
- DO JSV=1,KSV
- CALL BUDGET( PSVS(:,:,:,JSV) * PRHODJ / PTSTEP, JSV + NBUDGET_SV1 - 1, 'ENDF_BU_RSV' )
- END DO
- END IF
END IF
!
!------------------------------------------------------------------------------
diff --git a/src/MNH/exchange.f90 b/src/MNH/exchange.f90
index 01634dd55e7805147566b0d12449864570f8b362..5587e5331b307d7edfc6bc7469b8c8738b7d3d87 100644
--- a/src/MNH/exchange.f90
+++ b/src/MNH/exchange.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1998-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1998-2020 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.
@@ -86,8 +86,8 @@ END MODULE MODI_EXCHANGE
!! corrections for aq. phase and ice phase (lost mass neglig.)
!! 25/08/16 (M.Leriche) remove negative values for aerosols and conserve
!! total mass for chemical species in aerosols
-!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
-!!
+! P. Wautelet 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet 03/2020: use the new data structures and subroutines for budgets
!-----------------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -96,20 +96,22 @@ END MODULE MODI_EXCHANGE
! USE MODE_ll
!
USE MODD_ARGSLIST_ll, ONLY : LIST_ll
-USE MODD_GRID_n
-USE MODD_NSV
-USE MODD_BUDGET, ONLY : LBUDGET_SV, NBUDGET_SV1
+USE MODD_BLOWSNOW
+USE MODD_BLOWSNOW_n
+use modd_budget, only: lbudget_sv, NBUDGET_SV1, tbudgets
+USE MODD_CH_AEROSOL, ONLY : LORILAM, NM6_AER
+USE MODD_CH_MNHC_n, ONLY : LUSECHEM, LUSECHAQ, LUSECHIC
USE MODD_CST, ONLY : XMNH_TINY
+USE MODD_GRID_n
USE MODD_LUNIT_n, ONLY : TLUOUT
-USE MODI_SHUMAN
+USE MODD_NSV
+
+use mode_budget, only: Budget_store_init, Budget_store_end
use mode_exchange_ll, only: UPDATE_HALO_ll
USE MODE_SUM_ll
-USE MODI_BUDGET
-USE MODD_CH_MNHC_n, ONLY : LUSECHEM, LUSECHAQ, LUSECHIC
-USE MODD_CH_AEROSOL, ONLY : LORILAM, NM6_AER
-USE MODD_BLOWSNOW
-USE MODD_BLOWSNOW_n
-!
+
+USE MODI_SHUMAN
+
IMPLICIT NONE
!
!* 0.1 DECLARATIONS OF ARGUMENTS
@@ -162,6 +164,12 @@ IF (SIZE(PRTKES,1) /= 0) PRTKES(:,:,:) = PRTKES(:,:,:)*PTSTEP/PRHODJ
! REMOVE NEGATIVE VALUES OF CHEM SCALAR
!
IF (LUSECHEM) THEN
+ if ( lbudget_sv ) then
+ do jsv = nsv_chembeg, nsv_chemend
+ call Budget_store_init( tbudgets( NBUDGET_SV1 - 1 + jsv), 'NEGA', prsvs(:, :, :, jsv) )
+ end do
+ end if
+
DO JSV=NSV_CHGSBEG,NSV_CHGSEND
IF ( MIN_ll( PRSVS(:,:,:,JSV), IINFO_ll) < 0.0 ) THEN
!
@@ -208,14 +216,20 @@ IF (LUSECHEM) THEN
END DO
ENDIF
!
- IF (LBUDGET_SV) THEN
- DO JSV=NSV_CHEMBEG,NSV_CHEMEND
- CALL BUDGET(PRSVS(:,:,:,JSV),NBUDGET_SV1-1+JSV,'NEGA_BU_RSV')
- ENDDO
- ENDIF
+ if ( lbudget_sv ) then
+ do jsv = nsv_chembeg, nsv_chemend
+ call Budget_store_end( tbudgets( NBUDGET_SV1 - 1 + jsv), 'NEGA', prsvs(:, :, :, jsv) )
+ end do
+ end if
!
! aerosol sv
IF (LORILAM) THEN
+ if ( lbudget_sv ) then
+ do jsv = nsv_aerbeg, nsv_aerend
+ call Budget_store_init( tbudgets( NBUDGET_SV1 - 1 + jsv), 'NEGA', prsvs(:, :, :, jsv) )
+ end do
+ end if
+
DO JSV=NSV_AERBEG,NSV_AEREND-2-NM6_AER ! keep chem. species only
IF ( MIN_ll( PRSVS(:,:,:,JSV), IINFO_ll) < 0.0 ) THEN
!
@@ -249,11 +263,12 @@ IF (LUSECHEM) THEN
WRITE(ILUOUT,*)'AP MOMENT SOURCES IS SET TO ZERO'
END IF
END DO
- IF (LBUDGET_SV) THEN
- DO JSV=NSV_AERBEG,NSV_AEREND
- CALL BUDGET(PRSVS(:,:,:,JSV),NBUDGET_SV1-1+JSV,'NEGA_BU_RSV')
- ENDDO
- ENDIF
+
+ if ( lbudget_sv ) then
+ do jsv = nsv_aerbeg, nsv_aerend
+ call Budget_store_end( tbudgets( NBUDGET_SV1 - 1 + jsv), 'NEGA', prsvs(:, :, :, jsv) )
+ end do
+ end if
ENDIF
ENDIF
!
diff --git a/src/MNH/fast_terms.f90 b/src/MNH/fast_terms.f90
index 23532ed69e7d2812d37f25dc10d96b574d40b528..a64f5977a0e044de1974b42f3685799a56e1774d 100644
--- a/src/MNH/fast_terms.f90
+++ b/src/MNH/fast_terms.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2020 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.
@@ -150,19 +150,21 @@ END MODULE MODI_FAST_TERMS
!! J.Escobar 21/03/2013: for HALOK comment all NHALO=1 test
!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
!! June 17, 2016 (P. Wautelet) removed unused variables
-!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet 02/2020: use the new data structures and subroutines for budgets
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_BUDGET
-USE MODD_CST
+use modd_budget, only: lbudget_rc, lbudget_rv, lbudget_th, NBUDGET_RC, NBUDGET_RV, NBUDGET_TH, tbudgets
USE MODD_CONF
+USE MODD_CST
USE MODD_LUNIT_n, ONLY: TLUOUT
USE MODD_PARAMETERS
-!
-USE MODI_BUDGET
+
+use mode_budget, only: Budget_store_end, Budget_store_init
+
USE MODI_CONDENS
USE MODI_GET_HALO
!
@@ -238,8 +240,11 @@ IF (OSUBG_COND) THEN
ELSE
ITERMAX=1
END IF
-!
-!
+
+if ( lbudget_rv ) call Budget_store_init( tbudgets(NBUDGET_RV), 'COND', prvs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'COND', prcs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'COND', pths(:, :, :) * prhodj(:, :, :) )
+
!-------------------------------------------------------------------------------
!
!* 2. COMPUTE QUANTITIES WITH THE GUESS OF THE FUTURE INSTANT
@@ -418,12 +423,11 @@ ENDIF
!
!* 7. STORE THE BUDGET TERMS
! ----------------------
-!
-!
-IF (LBUDGET_RV) CALL BUDGET (PRVS(:,:,:) * PRHODJ(:,:,:),NBUDGET_RV,'COND_BU_RRV')
-IF (LBUDGET_RC) CALL BUDGET (PRCS(:,:,:) * PRHODJ(:,:,:),NBUDGET_RC,'COND_BU_RRC')
-IF (LBUDGET_TH) CALL BUDGET (PTHS(:,:,:) * PRHODJ(:,:,:),NBUDGET_TH,'COND_BU_RTH')
-!
+
+if ( lbudget_rv ) call Budget_store_end( tbudgets(NBUDGET_RV), 'COND', prvs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'COND', prcs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'COND', pths(:, :, :) * prhodj(:, :, :) )
+
!------------------------------------------------------------------------------
!
!
diff --git a/src/MNH/forcing.f90 b/src/MNH/forcing.f90
index bc26487f9c851c575692fb48a6518faa46ad5c91..a5e3075881810e2674b03563c18a306926f9e03a 100644
--- a/src/MNH/forcing.f90
+++ b/src/MNH/forcing.f90
@@ -146,7 +146,7 @@ END MODULE MODI_FORCING
! P. Wautelet 28/03/2018: replace TEMPORAL_DIST by DATETIME_DISTANCE
! use overloaded comparison operator for date_time
! P. Wautelet 05/2016-04/2018: new data structures and calls for I/O
-! P. Wautelet 28/01/2020: use the new data structures and subroutines for budgets for U
+! P. Wautelet 02/2020: use the new data structures and subroutines for budgets
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -169,7 +169,6 @@ use mode_budget, only: Budget_store_init, Budget_store_end
USE MODE_DATETIME
USE MODE_MSG
!
-USE MODI_BUDGET
USE MODI_GET_HALO
USE MODI_SHUMAN
USE MODI_UPSTREAM_Z
@@ -253,7 +252,23 @@ IKU=SIZE(PUT,3)
!
ILUOUT0 = TLUOUT0%NLU
-if ( lbudget_u ) call Budget_store_init( tbudgets(NBUDGET_U), 'FRC', prus )
+if ( lbudget_u ) call Budget_store_init( tbudgets(NBUDGET_U ), 'FRC', prus (:, :, :) )
+if ( lbudget_v ) call Budget_store_init( tbudgets(NBUDGET_V ), 'FRC', prvs (:, :, :) )
+if ( lbudget_w ) call Budget_store_init( tbudgets(NBUDGET_W ), 'FRC', prws (:, :, :) )
+if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH ), 'FRC', prths (:, :, :) )
+if ( lbudget_tke ) call Budget_store_init( tbudgets(NBUDGET_TKE), 'FRC', prtkes(:, :, :) )
+if ( lbudget_rv ) call Budget_store_init( tbudgets(NBUDGET_RV ), 'FRC', prrs (:, :, :, 1) )
+if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC ), 'FRC', prrs (:, :, :, 2) )
+if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR ), 'FRC', prrs (:, :, :, 3) )
+if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI ), 'FRC', prrs (:, :, :, 4) )
+if ( lbudget_rs ) call Budget_store_init( tbudgets(NBUDGET_RS ), 'FRC', prrs (:, :, :, 5) )
+if ( lbudget_rg ) call Budget_store_init( tbudgets(NBUDGET_RG ), 'FRC', prrs (:, :, :, 6) )
+if ( lbudget_rh ) call Budget_store_init( tbudgets(NBUDGET_RH ), 'FRC', prrs (:, :, :, 7) )
+if ( lbudget_sv ) then
+ do jl = 1, size( prsvs, 4 )
+ call Budget_store_init( tbudgets(jl + NBUDGET_SV1 - 1), 'FRC', prsvs(:, :, :, jl) )
+ end do
+end if
!
!* 1. PREPARATION OF FORCING
! ----------------------
@@ -835,25 +850,24 @@ END IF
! ------------
!
!
-if ( lbudget_u ) call Budget_store_end( tbudgets(NBUDGET_U), 'FRC', prus )
+if ( lbudget_u ) call Budget_store_end( tbudgets(NBUDGET_U ), 'FRC', prus (:, :, :) )
+if ( lbudget_v ) call Budget_store_end( tbudgets(NBUDGET_V ), 'FRC', prvs (:, :, :) )
+if ( lbudget_w ) call Budget_store_end( tbudgets(NBUDGET_W ), 'FRC', prws (:, :, :) )
+if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH ), 'FRC', prths (:, :, :) )
+if ( lbudget_tke ) call Budget_store_end( tbudgets(NBUDGET_TKE), 'FRC', prtkes(:, :, :) )
+if ( lbudget_rv ) call Budget_store_end( tbudgets(NBUDGET_RV ), 'FRC', prrs (:, :, :, 1) )
+if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC ), 'FRC', prrs (:, :, :, 2) )
+if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR ), 'FRC', prrs (:, :, :, 3) )
+if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI ), 'FRC', prrs (:, :, :, 4) )
+if ( lbudget_rs ) call Budget_store_end( tbudgets(NBUDGET_RS ), 'FRC', prrs (:, :, :, 5) )
+if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG ), 'FRC', prrs (:, :, :, 6) )
+if ( lbudget_rh ) call Budget_store_end( tbudgets(NBUDGET_RH ), 'FRC', prrs (:, :, :, 7) )
+if ( lbudget_sv ) then
+ do jl = 1, size( prsvs, 4 )
+ call Budget_store_end( tbudgets(jl + NBUDGET_SV1 - 1), 'FRC', prsvs(:, :, :, jl) )
+ end do
+end if
-IF (LBUDGET_V) CALL BUDGET (PRVS, NBUDGET_V, 'FRC_BU_RV')
-IF (LBUDGET_W) CALL BUDGET (PRWS, NBUDGET_W, 'FRC_BU_RW')
-IF (LBUDGET_TH) CALL BUDGET (PRTHS, NBUDGET_TH, 'FRC_BU_RTH')
-IF (LBUDGET_TKE) CALL BUDGET (PRTKES, NBUDGET_TKE,'FRC_BU_RTKE')
-IF (LBUDGET_RV) CALL BUDGET (PRRS(:,:,:,1),NBUDGET_RV, 'FRC_BU_RRV')
-IF (LBUDGET_RC) CALL BUDGET (PRRS(:,:,:,2),NBUDGET_RC, 'FRC_BU_RRC')
-IF (LBUDGET_RR) CALL BUDGET (PRRS(:,:,:,3),NBUDGET_RR, 'FRC_BU_RRR')
-IF (LBUDGET_RI) CALL BUDGET (PRRS(:,:,:,4),NBUDGET_RI, 'FRC_BU_RRI')
-IF (LBUDGET_RS) CALL BUDGET (PRRS(:,:,:,5),NBUDGET_RS, 'FRC_BU_RRS')
-IF (LBUDGET_RG) CALL BUDGET (PRRS(:,:,:,6),NBUDGET_RG, 'FRC_BU_RRG')
-IF (LBUDGET_RH) CALL BUDGET (PRRS(:,:,:,7),NBUDGET_RH, 'FRC_BU_RRH')
-IF (LBUDGET_SV) THEN
- DO JL = 1 , SIZE(PRSVS,4)
- CALL BUDGET (PRSVS(:,:,:,JL),JL+NBUDGET_SV1-1,'FRC_BU_RSV')
- END DO
-END IF
-!
!----------------------------------------------------------------------------
!
! deallocate work arrays
diff --git a/src/MNH/gravity_impl.f90 b/src/MNH/gravity_impl.f90
index 8c623c54af3a78f148d53ccce500622b89cee27d..f150e242bbda8c6a055ad3c85f3cf267170db003 100644
--- a/src/MNH/gravity_impl.f90
+++ b/src/MNH/gravity_impl.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 2011-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2011-2020 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.
@@ -71,17 +71,20 @@ END MODULE MODI_GRAVITY_IMPL
!! -------------
!! Original 04/2011
!! Q.Rodier 06/15 correction on budget
-!!
+! P. Wautelet 02/2020: use the new data structures and subroutines for budgets
+!
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-USE MODI_GRAVITY
-USE MODI_ADV_BOUNDARIES
-USE MODD_BUDGET
-USE MODI_BUDGET
-!
+use modd_budget, only: lbudget_w, NBUDGET_W, tbudgets
+
+use mode_budget, only: Budget_store_init, Budget_store_end
+
+use modi_adv_boundaries
+use modi_gravity
+
!-------------------------------------------------------------------------------
!
IMPLICIT NONE
@@ -124,7 +127,9 @@ REAL, DIMENSION(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3),SIZE(PRT,4)) :: ZR
INTEGER :: JR
!
!-------------------------------------------------------------------------------
-!
+
+if ( lbudget_w ) call Budget_store_init( tbudgets(NBUDGET_W), 'GRAV', prws(:, :, :) )
+
ZRWS_GRAV = 0.
ZR = 0.
!
@@ -146,9 +151,9 @@ END DO
CALL GRAVITY ( KRR,KRRL, KRRI, ZTH, ZR, PRHODJ, PTHVREF, ZRWS_GRAV(:,:,:) )
!
PRWS(:,:,:) = PRWS(:,:,:) + ZRWS_GRAV(:,:,:)
-!
-IF (LBUDGET_W) CALL BUDGET (PRWS,NBUDGET_W,'GRAV_BU_RW')
-!
+
+if ( lbudget_w ) call Budget_store_end( tbudgets(NBUDGET_W), 'GRAV', prws(:, :, :) )
+
!-------------------------------------------------------------------------------
!
END SUBROUTINE GRAVITY_IMPL
diff --git a/src/MNH/ice_adjust.f90 b/src/MNH/ice_adjust.f90
index 0beb2e0eaa114e016dd3216c13f540cf4b2f746d..3d599521c7c97b10ffbe0b9cb56c7dd020127729 100644
--- a/src/MNH/ice_adjust.f90
+++ b/src/MNH/ice_adjust.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1996-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1996-2020 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.
@@ -23,7 +23,7 @@ INTEGER, INTENT(IN) :: KKU !uppest atmosphere array index
INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=ARO
INTEGER, INTENT(IN) :: KRR ! Number of moist variables
CHARACTER(len=1), INTENT(IN) :: HFRAC_ICE
-CHARACTER(len=4), INTENT(IN) :: HBUNAME ! Name of the budget
+CHARACTER(len=*), INTENT(IN) :: HBUNAME ! Name of the budget
LOGICAL, INTENT(IN) :: OSUBG_COND ! Switch for Subgrid
! Condensation
LOGICAL :: OSIGMAS ! Switch for Sigma_s:
@@ -163,24 +163,26 @@ END MODULE MODI_ICE_ADJUST
!! This modification allows to call ice_adjust on T variable
!! or to call it on S variables
!! 2016-11 S. Riette: all-or-nothing adjustment now uses condensation
-!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
-!!
+! P. Wautelet 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet 02/2020: use the new data structures and subroutines for budgets
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_BUDGET
+use modd_budget, only: lbudget_th, lbudget_rv, lbudget_rc, lbudget_ri, &
+ NBUDGET_TH, NBUDGET_RV, NBUDGET_RC, NBUDGET_RI, &
+ tbudgets
USE MODD_CONF
USE MODD_CST
USE MODD_PARAMETERS
-use mode_tools_ll, only: GET_INDICE_ll
+use mode_budget, only: Budget_store_init, Budget_store_end
+use mode_tools_ll, only: GET_INDICE_ll
-USE MODI_BUDGET
USE MODI_CONDENSATION
USE MODI_GET_HALO
-!
+
IMPLICIT NONE
!
!
@@ -192,7 +194,7 @@ INTEGER, INTENT(IN) :: KKU !uppest atmosphere array index
INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=ARO
INTEGER, INTENT(IN) :: KRR ! Number of moist variables
CHARACTER(len=1), INTENT(IN) :: HFRAC_ICE
-CHARACTER(len=4), INTENT(IN) :: HBUNAME ! Name of the budget
+CHARACTER(len=*), INTENT(IN) :: HBUNAME ! Name of the budget
LOGICAL, INTENT(IN) :: OSUBG_COND ! Switch for Subgrid
! Condensation
LOGICAL :: OSIGMAS ! Switch for Sigma_s:
@@ -262,6 +264,11 @@ REAL, DIMENSION(SIZE(PEXNREF,1),SIZE(PEXNREF,2),SIZE(PEXNREF,3)) :: ZSIGS,ZSRCS
!* 1. PRELIMINARIES
! -------------
!
+if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), trim( hbuname ), pths(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rv ) call Budget_store_init( tbudgets(NBUDGET_RV), trim( hbuname ), prvs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), trim( hbuname ), prcs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), trim( hbuname ), pris(:, :, :) * prhodj(:, :, :) )
+
IIU = SIZE(PEXNREF,1)
IJU = SIZE(PEXNREF,2)
IKU = SIZE(PEXNREF,3)
@@ -430,11 +437,11 @@ ENDIF
!* 6. STORE THE BUDGET TERMS
! ----------------------
!
-IF (LBUDGET_RV) CALL BUDGET (PRVS(:,:,:) * PRHODJ(:,:,:),NBUDGET_RV,HBUNAME//'_BU_RRV')
-IF (LBUDGET_RC) CALL BUDGET (PRCS(:,:,:) * PRHODJ(:,:,:),NBUDGET_RC,HBUNAME//'_BU_RRC')
-IF (LBUDGET_RI) CALL BUDGET (PRIS(:,:,:) * PRHODJ(:,:,:),NBUDGET_RI,HBUNAME//'_BU_RRI')
-IF (LBUDGET_TH) CALL BUDGET (PTHS(:,:,:) * PRHODJ(:,:,:),NBUDGET_TH,HBUNAME//'_BU_RTH')
-!
+if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), trim( hbuname ), pths(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rv ) call Budget_store_end( tbudgets(NBUDGET_RV), trim( hbuname ), prvs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), trim( hbuname ), prcs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), trim( hbuname ), pris(:, :, :) * prhodj(:, :, :) )
+
!------------------------------------------------------------------------------
!
!
diff --git a/src/MNH/ice_adjust_elec.f90 b/src/MNH/ice_adjust_elec.f90
index 4114d7a2e83efde7fd678237cf4200717844ac85..6d766496dcf250e726ac3331aa423e6d2dd76564 100644
--- a/src/MNH/ice_adjust_elec.f90
+++ b/src/MNH/ice_adjust_elec.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 2002-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2002-2020 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.
@@ -139,14 +139,6 @@ END MODULE MODI_ICE_ADJUST_ELEC
!! ! pressure function
!! Module MODD_CONF
!! CCONF
-!! Module MODD_BUDGET:
-!! NBUMOD
-!! CBUTYPE
-!! NBUPROCCTR
-!! LBU_RTH
-!! LBU_RRV
-!! LBU_RRC
-!! LBU_RRI
!!
!!
!! REFERENCE
@@ -165,25 +157,27 @@ END MODULE MODI_ICE_ADJUST_ELEC
!! C. Barthe 19/11/09 update to version 4.8.1
!! M. Chong Mar. 2010 Add small ions
!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
-!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
-!!
+! P. Wautelet 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet 03/2020: use the new data structures and subroutines for budgets
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_PARAMETERS
-USE MODD_CST
+use modd_budget, only: lbudget_th, lbudget_rv, lbudget_rc, lbudget_ri, lbudget_sv, &
+ NBUDGET_TH, NBUDGET_RV, NBUDGET_RC, NBUDGET_RI, NBUDGET_SV1, &
+ tbudgets
USE MODD_CONF
-USE MODD_BUDGET
-USE MODD_NSV, ONLY : NSV_ELECBEG, NSV_ELECEND
+USE MODD_CST
USE MODD_ELEC_DESCR, ONLY : XRTMIN_ELEC, XQTMIN, XFC, XFI, XECHARGE
+USE MODD_NSV, ONLY : NSV_ELECBEG, NSV_ELECEND
+USE MODD_PARAMETERS
USE MODD_RAIN_ICE_DESCR, ONLY : XRTMIN, XBI
+use mode_budget, only: Budget_store_init, Budget_store_end
use mode_tools_ll, only: GET_INDICE_ll
USE MODI_CONDENSATION
-USE MODI_BUDGET
USE MODI_GET_HALO
!
IMPLICIT NONE
@@ -311,6 +305,16 @@ ZT0 = XTT ! Usefull if LPRETREATMENT=T or LNEW_ADJUST=T
ZT00 = XTT-40. ! Usefull if LPRETREATMENT=T or LNEW_ADJUST=T
!
!-------------------------------------------------------------------------------
+if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'CDEPI', pths(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rv ) call Budget_store_init( tbudgets(NBUDGET_RV), 'CDEPI', prvs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'CDEPI', prcs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'CDEPI', pris(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg ), 'CDEPI', pqpis(:, :, :) * prhodj(:, :, :) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecend ), 'CDEPI', pqnis(:, :, :) * prhodj(:, :, :) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1 ), 'CDEPI', pqcs (:, :, :) * prhodj(:, :, :) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'CDEPI', pqis (:, :, :) * prhodj(:, :, :) )
+end if
!
!* 2. COMPUTE QUANTITIES WITH THE GUESS OF THE FUTURE INSTANT
! -------------------------------------------------------
@@ -625,17 +629,16 @@ ENDIF
!* 6. STORE THE BUDGET TERMS
! ----------------------
!
-IF (LBUDGET_RV) CALL BUDGET (PRVS(:,:,:) * PRHODJ(:,:,:),NBUDGET_RV,'DEPI_BU_RRV')
-IF (LBUDGET_RC) CALL BUDGET (PRCS(:,:,:) * PRHODJ(:,:,:),NBUDGET_RC,'DEPI_BU_RRC')
-IF (LBUDGET_RI) CALL BUDGET (PRIS(:,:,:) * PRHODJ(:,:,:),NBUDGET_RI,'DEPI_BU_RRI')
-IF (LBUDGET_TH) CALL BUDGET (PTHS(:,:,:) * PRHODJ(:,:,:),NBUDGET_TH,'DEPI_BU_RTH')
-IF (LBUDGET_SV) THEN
- CALL BUDGET(PQPIS(:,:,:) * PRHODJ(:,:,:), NBUDGET_SV1-1+NSV_ELECBEG, 'DEPI_BU_RSV')
- CALL BUDGET(PQNIS(:,:,:) * PRHODJ(:,:,:), NBUDGET_SV1-1+NSV_ELECEND, 'DEPI_BU_RSV')
- CALL BUDGET(PQCS(:,:,:) * PRHODJ(:,:,:), NBUDGET_SV1-1+NSV_ELECBEG+1, 'DEPI_BU_RSV')
- CALL BUDGET(PQIS(:,:,:) * PRHODJ(:,:,:), NBUDGET_SV1-1+NSV_ELECBEG+3, 'DEPI_BU_RSV')
-END IF
-!
+if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'CDEPI', pths(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rv ) call Budget_store_end( tbudgets(NBUDGET_RV), 'CDEPI', prvs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'CDEPI', prcs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'CDEPI', pris(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg ), 'CDEPI', pqpis(:, :, :) * prhodj(:, :, :) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecend ), 'CDEPI', pqnis(:, :, :) * prhodj(:, :, :) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1 ), 'CDEPI', pqcs (:, :, :) * prhodj(:, :, :) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'CDEPI', pqis (:, :, :) * prhodj(:, :, :) )
+end if
!------------------------------------------------------------------------------
!
END SUBROUTINE ICE_ADJUST_ELEC
diff --git a/src/MNH/initial_guess.f90 b/src/MNH/initial_guess.f90
index 43eb8c20c10a52ec402842b44466f430d15bdbbc..7cf04e71e5d13b4769571f27166f8df6c39c22ac 100644
--- a/src/MNH/initial_guess.f90
+++ b/src/MNH/initial_guess.f90
@@ -140,7 +140,7 @@ END MODULE MODI_INITIAL_GUESS
!! 10/09 (C.Lac) FIT for variables advected with PPM
!! 04/13 (C.Lac) FIT for all variables
! J. Escobar) 07/2019: add reproductiblity test => MPPDB_CHECK( PRRS/RT/RHO )
-! P. Wautelet 28/01/2020: use the new data structures and subroutines for budgets for U
+! P. Wautelet 02/2020: use the new data structures and subroutines for budgets
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -159,7 +159,6 @@ USE MODD_GRID_n
use mode_budget, only: Budget_store_init, Budget_store_end
USE MODE_MPPDB
-USE MODI_BUDGET
USE MODI_SHUMAN
!
IMPLICIT NONE
@@ -242,40 +241,23 @@ IF (LBU_ENABLE) THEN
NBUCTR_ACTV(:)=1
!Remark: does not need a call to Budget_store_init because the budget array is overwritten for this source term
- if ( lbudget_u ) call Budget_store_end( tbudgets(NBUDGET_U), 'INIF', prus )
-
- IF (LBUDGET_V) CALL BUDGET( PRVS, NBUDGET_V, 'INIF_BU_RV' )
- IF (LBUDGET_W) CALL BUDGET( PRWS, NBUDGET_W, 'INIF_BU_RW' )
- IF (LBUDGET_TH) CALL BUDGET( PRTHS, NBUDGET_TH, 'INIF_BU_RTH' )
- IF (LBUDGET_TKE) CALL BUDGET( PRTKES, NBUDGET_TKE, 'INIF_BU_RTKE' )
- IF (LBUDGET_RV) CALL BUDGET( PRRS(:,:,:,1), NBUDGET_RV, 'INIF_BU_RRV' )
- IF (LBUDGET_RC) CALL BUDGET( PRRS(:,:,:,2), NBUDGET_RC, 'INIF_BU_RRC' )
- IF (LBUDGET_RR) CALL BUDGET( PRRS(:,:,:,3), NBUDGET_RR, 'INIF_BU_RRR' )
- IF (LBUDGET_RI) CALL BUDGET( PRRS(:,:,:,4), NBUDGET_RI, 'INIF_BU_RRI' )
- IF (LBUDGET_RS) CALL BUDGET( PRRS(:,:,:,5), NBUDGET_RS, 'INIF_BU_RRS' )
- IF (LBUDGET_RG) CALL BUDGET( PRRS(:,:,:,6), NBUDGET_RG, 'INIF_BU_RRG' )
- IF (LBUDGET_RH) CALL BUDGET( PRRS(:,:,:,7), NBUDGET_RH, 'INIF_BU_RRH' )
- DO JSV=1,KSV
- IF (LBUDGET_SV) CALL BUDGET( PRSVS(:,:,:,JSV), JSV + NBUDGET_SV1 - 1, 'INIF_BU_RSV' )
- END DO
-!
- NBUPROCCTR(:)=2
- NBUCTR_ACTV(:)=2
-!
- IF (LBUDGET_V) CALL BUDGET( PRVS, NBUDGET_V, 'ENDF_BU_RV' )
- IF (LBUDGET_W) CALL BUDGET( PRWS, NBUDGET_W, 'ENDF_BU_RW' )
- IF (LBUDGET_TH) CALL BUDGET( PRTHS, NBUDGET_TH, 'ENDF_BU_RTH' )
- IF (LBUDGET_TKE) CALL BUDGET( PRTKES, NBUDGET_TKE, 'ENDF_BU_RTKE' )
- IF (LBUDGET_RV) CALL BUDGET( PRRS(:,:,:,1), NBUDGET_RV, 'ENDF_BU_RRV' )
- IF (LBUDGET_RC) CALL BUDGET( PRRS(:,:,:,2), NBUDGET_RC, 'ENDF_BU_RRC' )
- IF (LBUDGET_RR) CALL BUDGET( PRRS(:,:,:,3), NBUDGET_RR, 'ENDF_BU_RRR' )
- IF (LBUDGET_RI) CALL BUDGET( PRRS(:,:,:,4), NBUDGET_RI, 'ENDF_BU_RRI' )
- IF (LBUDGET_RS) CALL BUDGET( PRRS(:,:,:,5), NBUDGET_RS, 'ENDF_BU_RRS' )
- IF (LBUDGET_RG) CALL BUDGET( PRRS(:,:,:,6), NBUDGET_RG, 'ENDF_BU_RRG' )
- IF (LBUDGET_RH) CALL BUDGET( PRRS(:,:,:,7), NBUDGET_RH, 'ENDF_BU_RRH' )
- DO JSV=1,KSV
- IF (LBUDGET_SV) CALL BUDGET( PRSVS(:,:,:,JSV), JSV + NBUDGET_SV1 - 1, 'ENDF_BU_RSV' )
- END DO
+ if ( lbudget_u ) call Budget_store_end( tbudgets(NBUDGET_U ), 'INIF', prus (:, :, :) )
+ if ( lbudget_v ) call Budget_store_end( tbudgets(NBUDGET_V ), 'INIF', prvs (:, :, :) )
+ if ( lbudget_w ) call Budget_store_end( tbudgets(NBUDGET_W ), 'INIF', prws (:, :, :) )
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH ), 'INIF', prths (:, :, :) )
+ if ( lbudget_tke ) call Budget_store_end( tbudgets(NBUDGET_TKE), 'INIF', prtkes(:, :, :) )
+ if ( lbudget_rv ) call Budget_store_end( tbudgets(NBUDGET_RV ), 'INIF', prrs (:, :, :, 1) )
+ if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC ), 'INIF', prrs (:, :, :, 2) )
+ if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR ), 'INIF', prrs (:, :, :, 3) )
+ if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI ), 'INIF', prrs (:, :, :, 4) )
+ if ( lbudget_rs ) call Budget_store_end( tbudgets(NBUDGET_RS ), 'INIF', prrs (:, :, :, 5) )
+ if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG ), 'INIF', prrs (:, :, :, 6) )
+ if ( lbudget_rh ) call Budget_store_end( tbudgets(NBUDGET_RH ), 'INIF', prrs (:, :, :, 7) )
+ if ( lbudget_sv ) then
+ do jsv = 1, ksv
+ call Budget_store_end( tbudgets(jsv + NBUDGET_SV1 - 1), 'INIF', prsvs(:, :, :, jsv) )
+ end do
+ end if
END IF
!
NBUPROCCTR(:)=4
@@ -286,23 +268,24 @@ IF (LBU_ENABLE) THEN
!The Asselin source term is computed from the end of the previous time step to now
!Therefore, it has to be stored only if not the 1st timestep of the budget
if ( .not. lbu_beg ) then
- if ( lbudget_u ) call Budget_store_end( tbudgets(NBUDGET_U), 'ASSE', prus )
+ if ( lbudget_u ) call Budget_store_end( tbudgets(NBUDGET_U ), 'ASSE', prus (:, :, :) )
+ if ( lbudget_v ) call Budget_store_end( tbudgets(NBUDGET_V ), 'ASSE', prvs (:, :, :) )
+ if ( lbudget_w ) call Budget_store_end( tbudgets(NBUDGET_W ), 'ASSE', prws (:, :, :) )
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH ), 'ASSE', prths (:, :, :) )
+ if ( lbudget_tke ) call Budget_store_end( tbudgets(NBUDGET_TKE), 'ASSE', prtkes(:, :, :) )
+ if ( lbudget_rv ) call Budget_store_end( tbudgets(NBUDGET_RV ), 'ASSE', prrs (:, :, :, 1) )
+ if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC ), 'ASSE', prrs (:, :, :, 2) )
+ if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR ), 'ASSE', prrs (:, :, :, 3) )
+ if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI ), 'ASSE', prrs (:, :, :, 4) )
+ if ( lbudget_rs ) call Budget_store_end( tbudgets(NBUDGET_RS ), 'ASSE', prrs (:, :, :, 5) )
+ if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG ), 'ASSE', prrs (:, :, :, 6) )
+ if ( lbudget_rh ) call Budget_store_end( tbudgets(NBUDGET_RH ), 'ASSE', prrs (:, :, :, 7) )
+ if ( lbudget_sv ) then
+ do jsv = 1, ksv
+ call Budget_store_end( tbudgets(jsv + NBUDGET_SV1 - 1), 'ASSE', prsvs(:, :, :, jsv) )
+ end do
+ end if
end if
-
- IF (LBUDGET_V) CALL BUDGET( PRVS, NBUDGET_V, 'ASSE_BU_RV' )
- IF (LBUDGET_W) CALL BUDGET( PRWS, NBUDGET_W, 'ASSE_BU_RW' )
- IF (LBUDGET_TH) CALL BUDGET( PRTHS, NBUDGET_TH, 'ASSE_BU_RTH' )
- IF (LBUDGET_TKE) CALL BUDGET( PRTKES, NBUDGET_TKE, 'ASSE_BU_RTKE' )
- IF (LBUDGET_RV) CALL BUDGET( PRRS(:,:,:,1), NBUDGET_RV, 'ASSE_BU_RRV' )
- IF (LBUDGET_RC) CALL BUDGET( PRRS(:,:,:,2), NBUDGET_RC, 'ASSE_BU_RRC' )
- IF (LBUDGET_RR) CALL BUDGET( PRRS(:,:,:,3), NBUDGET_RR, 'ASSE_BU_RRR' )
- IF (LBUDGET_RI) CALL BUDGET( PRRS(:,:,:,4), NBUDGET_RI, 'ASSE_BU_RRI' )
- IF (LBUDGET_RS) CALL BUDGET( PRRS(:,:,:,5), NBUDGET_RS, 'ASSE_BU_RRS' )
- IF (LBUDGET_RG) CALL BUDGET( PRRS(:,:,:,6), NBUDGET_RG, 'ASSE_BU_RRG' )
- IF (LBUDGET_RH) CALL BUDGET( PRRS(:,:,:,7), NBUDGET_RH, 'ASSE_BU_RRH' )
- DO JSV=1,KSV
- IF (LBUDGET_SV) CALL BUDGET( PRSVS(:,:,:,JSV), JSV + NBUDGET_SV1 - 1, 'ASSE_BU_RSV' )
- END DO
END IF
LBU_BEG=.FALSE.
diff --git a/src/MNH/ion_attach_elec.f90 b/src/MNH/ion_attach_elec.f90
index be198dae2f056e2effafcdb498216e65bfd213f1..dfda780c2d9864e4b3bb710ce27e5599df2076d3 100644
--- a/src/MNH/ion_attach_elec.f90
+++ b/src/MNH/ion_attach_elec.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 2010-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2010-2020 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.
@@ -76,29 +76,29 @@ END MODULE MODI_ION_ATTACH_ELEC
!! Original 2010
!! Modifications:
!! J.Escobar : 18/12/2015 : Correction of bug in bound in // for NHALO <>1
-!!
+! P. Wautelet 03/2020: use the new data structures and subroutines for budgets
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_PARAMETERS, ONLY : JPHEXT, JPVEXT
+use modd_budget, only : lbudget_sv, NBUDGET_SV1, tbudgets
+USE MODD_CONF, ONLY: CCONF
USE MODD_CST
-USE MODD_CONF, ONLY : CCONF
USE MODD_ELEC_DESCR
-USE MODD_ELEC_n
+USE MODD_ELEC_n
USE MODD_ELEC_PARAM
+USE MODD_NSV, ONLY: NSV_ELECBEG, NSV_ELEC
+USE MODD_PARAMETERS, ONLY: JPHEXT, JPVEXT
USE MODD_RAIN_ICE_DESCR
USE MODD_RAIN_ICE_PARAM
-USE MODD_NSV, ONLY : NSV_ELECBEG, NSV_ELEC
-USE MODD_BUDGET, ONLY : LBU_RSV, NBUDGET_SV1
-USE MODD_REF, ONLY : XTHVREFZ
+USE MODD_REF, ONLY: XTHVREFZ
+use mode_budget, only: Budget_store_init, Budget_store_end
use mode_tools_ll, only: GET_INDICE_ll
-USE MODI_BUDGET
USE MODI_MOMG
-!
+
IMPLICIT NONE
!
! 0.1 Declaration of arguments
@@ -145,6 +145,11 @@ REAL :: ZCOMB ! Recombination
!
!
!-------------------------------------------------------------------------------
+if ( lbudget_sv ) then
+ do jrr = 1, nsv_elec
+ call Budget_store_init( tbudgets( NBUDGET_SV1 - 1 + nsv_elecbeg - 1 + jrr), 'NEUT', psvs(:, :, :, jrr) )
+ end do
+end if
!
!* 1. COMPUTE THE ION RECOMBINATION and TEMPERATURE
! ---------------------------------------------
@@ -261,11 +266,11 @@ ENDDO
!* 5. BUDGET
! ------
!
-IF (LBU_RSV) THEN
- DO JRR = 1, NSV_ELEC
- CALL BUDGET(PSVS(:,:,:,JRR), NBUDGET_SV1-1+NSV_ELECBEG+JRR-1, 'NEUT_BU_RSV')
- ENDDO
-END IF
+if ( lbudget_sv ) then
+ do jrr = 1, nsv_elec
+ call Budget_store_end( tbudgets( NBUDGET_SV1 - 1 + nsv_elecbeg - 1 + jrr), 'NEUT', psvs(:, :, :, jrr) )
+ end do
+end if
!
!------------------------------------------------------------------------------
!
diff --git a/src/MNH/khko_notadjust.f90 b/src/MNH/khko_notadjust.f90
index 6b1aa32df6782a82412b5e4fb5ae2c731e2c164a..3f6f1c8d843915674ee95ae09a6a06f7041684d0 100644
--- a/src/MNH/khko_notadjust.f90
+++ b/src/MNH/khko_notadjust.f90
@@ -93,11 +93,14 @@ END MODULE MODI_KHKO_NOTADJUST
!! M.Mazoyer : 10/2016 New KHKO output fields
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90
+! P. Wautelet 02/2020: use the new data structures and subroutines for budgets
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
!
-USE MODD_BUDGET
+use modd_budget, only: lbudget_th, lbudget_rv, lbudget_rc, lbudget_sv, &
+ NBUDGET_TH, NBUDGET_RV, NBUDGET_RC, NBUDGET_SV1, &
+ tbudgets
USE MODD_CONF
USE MODD_CST
use modd_field, only: TFIELDDATA,TYPEREAL
@@ -107,13 +110,12 @@ USE MODD_NSV, ONLY: NSV_C2R2BEG
USE MODD_PARAMETERS
USE MODD_RAIN_C2R2_DESCR, ONLY: XRTMIN
-!
+use mode_budget, only: Budget_store_init, Budget_store_end
USE MODE_IO_FIELD_WRITE, only: IO_Field_write
USE MODE_MSG
use mode_tools, only: Countjv
use mode_tools_ll, only: GET_INDICE_ll
-!
-USE MODI_BUDGET
+
USE MODI_PROGNOS
!
IMPLICIT NONE
@@ -194,6 +196,14 @@ TYPE(TFIELDDATA) :: TZFIELD
!* 1. PRELIMINARIES
! -------------
!
+if ( lbudget_rv ) call Budget_store_init( tbudgets(NBUDGET_RV), 'COND', prvs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'COND', prcs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'COND', pths(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_c2r2beg ), 'CEVA', pcnucs(:, :, :) * prhodj(:, :, :) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_c2r2beg + 1), 'CEVA', pccs (:, :, :) * prhodj(:, :, :) )
+end if
+
ILUOUT = TLUOUT%NLU
CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
IKB=1+JPVEXT
@@ -411,13 +421,12 @@ END IF
!* 7. STORE THE BUDGET TERMS
! ----------------------
!
-!
-IF (LBUDGET_RV) CALL BUDGET (PRVS(:,:,:) * PRHODJ(:,:,:),NBUDGET_RV,'COND_BU_RRV')
-IF (LBUDGET_RC) CALL BUDGET (PRCS(:,:,:) * PRHODJ(:,:,:),NBUDGET_RC,'COND_BU_RRC')
-IF (LBUDGET_TH) CALL BUDGET (PTHS(:,:,:) * PRHODJ(:,:,:),NBUDGET_TH,'COND_BU_RTH')
-IF (LBUDGET_SV) THEN
- CALL BUDGET (PCNUCS(:,:,:) * PRHODJ(:,:,:),NBUDGET_SV1-1+NSV_C2R2BEG, 'CEVA_BU_RSV') ! RCN
- CALL BUDGET (PCCS(:,:,:) * PRHODJ(:,:,:), NBUDGET_SV1-1+NSV_C2R2BEG+1,'CEVA_BU_RSV') ! RCC
-END IF
-!
+if ( lbudget_rv ) call Budget_store_end( tbudgets(NBUDGET_RV), 'COND', prvs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'COND', prcs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'COND', pths(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_c2r2beg ), 'CEVA', pcnucs(:, :, :) * prhodj(:, :, :) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_c2r2beg + 1), 'CEVA', pccs (:, :, :) * prhodj(:, :, :) )
+end if
+
END SUBROUTINE KHKO_NOTADJUST
diff --git a/src/MNH/lima.f90 b/src/MNH/lima.f90
index 2711c496a1f700f1f8c0a6dab02257f3779996ad..d3589d32cfd6c284995deea11da694a6016e47cb 100644
--- a/src/MNH/lima.f90
+++ b/src/MNH/lima.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 2013-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2013-2020 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.
@@ -97,14 +97,16 @@ END MODULE MODI_LIMA
!! Original 15/03/2018
!!
!! B.Vié 02/2019 : minor correction on budget
-!!
-!!
+! P. Wautelet 02/2020: use the new data structures and subroutines for budgets (no more budget calls in this subroutine)
+!
!* 0. DECLARATIONS
! ------------
-USE MODD_BUDGET, ONLY: LBU_ENABLE, LBUDGET_TH, LBUDGET_RV, LBUDGET_RC, LBUDGET_RR, &
- LBUDGET_RI, LBUDGET_RS, LBUDGET_RG, LBUDGET_RH, LBUDGET_SV, &
- NBUDGET_TH, NBUDGET_RV, NBUDGET_RC, NBUDGET_RR, NBUDGET_RI, &
- NBUDGET_RS, NBUDGET_RG, NBUDGET_RH, NBUDGET_SV1
+use modd_budget, only: lbu_enable, &
+ lbudget_th, lbudget_rv, lbudget_rc, lbudget_rr, lbudget_ri, &
+ lbudget_rs, lbudget_rg, lbudget_rh, lbudget_sv, &
+ NBUDGET_TH, NBUDGET_RV, NBUDGET_RC, NBUDGET_RR, NBUDGET_RI, &
+ NBUDGET_RS, NBUDGET_RG, NBUDGET_RH, NBUDGET_SV1, &
+ tbudgets
USE MODD_CLOUDPAR_n, ONLY: NSPLITR, NSPLITG
USE MODD_CST, ONLY: XCI, XCL, XCPD, XCPV, XLSTT, XLVTT, XTT, XRHOLW, XP00, XRD
USE MODD_IO, ONLY: TFILEDATA
@@ -120,9 +122,9 @@ USE MODD_PARAM_LIMA, ONLY: LCOLD, LRAIN, LWARM, NMOD_CCN, NMOD_IFN, NMOD_IM
USE MODD_PARAM_LIMA_COLD, ONLY: XAI, XBI
USE MODD_PARAM_LIMA_WARM, ONLY: XLBC, XLBEXC, XAC, XBC, XAR, XBR
+use mode_budget, only: Budget_store_add, Budget_store_init, Budget_store_end
use mode_tools, only: Countjv
-USE MODI_BUDGET
USE MODI_LIMA_DROPS_TO_DROPLETS_CONV
USE MODI_LIMA_INST_PROCS
USE MODI_LIMA_NUCLEATION_PROCS
@@ -309,6 +311,7 @@ INTEGER :: KRR
INTEGER :: IIB, IIE, IIT, IJB, IJE, IJT, IKB, IKE, IKT, IKTB, IKTE
! loops and packing
INTEGER :: II, IPACK
+integer :: idx
INTEGER, DIMENSION(:), ALLOCATABLE :: I1, I2, I3
! Inverse ov PTSTEP
REAL :: ZINV_TSTEP
@@ -318,6 +321,7 @@ REAL, DIMENSION(SIZE(PRT,1),SIZE(PRT,2)) :: ZW2D
REAL, DIMENSION(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3)) :: ZRT_SUM ! Total condensed water mr
REAL, DIMENSION(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3)) :: ZCPT ! Total condensed water mr
LOGICAL, DIMENSION(SIZE(PRT,1),SIZE(PRT,2)) :: GDEP
+real, dimension(:,:,:), allocatable :: zrhodjontstep
!
!-------------------------------------------------------------------------------
!
@@ -524,6 +528,20 @@ ZT(:,:,:) = ZTHT(:,:,:) * ZEXN(:,:,:)
!
!* 0. Check mean diameter for cloud, rain and ice
! --------------------------------------------
+if ( lbu_enable ) then
+ if ( lbudget_rc .and. lwarm .and. lrain ) call Budget_store_init( tbudgets(NBUDGET_RC), 'CORR', zrcs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rr .and. lwarm .and. lrain ) call Budget_store_init( tbudgets(NBUDGET_RR), 'CORR', zrrs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_ri .and. lcold .and. lsnow ) call Budget_store_init( tbudgets(NBUDGET_RI), 'CORR', zris(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rs .and. lcold .and. lsnow ) call Budget_store_init( tbudgets(NBUDGET_RS), 'CORR', zrss(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_sv ) then
+ if ( lwarm .and. lrain ) &
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'CORR', zccs(:, :, :) * prhodj(:, :, :) )
+ if ( lwarm .and. lrain ) &
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'CORR', zcrs(:, :, :) * prhodj(:, :, :) )
+ if ( lcold .and. lsnow ) &
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'CORR', zcis(:, :, :) * prhodj(:, :, :) )
+ end if
+end if
IF (LWARM .AND. LRAIN) THEN
WHERE( ZRCT>XRTMIN(2) .AND. ZCCT>XCTMIN(2) .AND. ZRCT>XAC*ZCCT*(100.E-6)**XBC )
ZRRT=ZRRT+ZRCT
@@ -561,23 +579,44 @@ IF (LCOLD .AND. LSNOW) THEN
END WHERE
END IF
!
-IF(LBU_ENABLE) THEN
- IF (LBUDGET_RC .AND. LWARM .AND. LRAIN) CALL BUDGET (ZRCS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RC, 'CORR_BU_RRC')
- IF (LBUDGET_RR .AND. LWARM .AND. LRAIN) CALL BUDGET (ZRRS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RR, 'CORR_BU_RRR')
- IF (LBUDGET_RI .AND. LCOLD .AND. LSNOW) CALL BUDGET (ZRIS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RI, 'CORR_BU_RRI')
- IF (LBUDGET_RI .AND. LCOLD .AND. LSNOW) CALL BUDGET (ZRSS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RS, 'CORR_BU_RRS')
- IF (LBUDGET_SV) THEN
- IF (LWARM .AND. LRAIN) CALL BUDGET (ZCCS(:,:,:)*PRHODJ(:,:,:), NBUDGET_SV1-1+NSV_LIMA_NC, 'CORR_BU_RSV')
- IF (LWARM .AND. LRAIN) CALL BUDGET (ZCRS(:,:,:)*PRHODJ(:,:,:), NBUDGET_SV1-1+NSV_LIMA_NR, 'CORR_BU_RSV')
- IF (LCOLD .AND. LSNOW) CALL BUDGET (ZCIS(:,:,:)*PRHODJ(:,:,:), NBUDGET_SV1-1+NSV_LIMA_NI, 'CORR_BU_RSV')
- END IF
-END IF
+if ( lbu_enable ) then
+ if ( lbudget_rc .and. lwarm .and. lrain ) call Budget_store_end( tbudgets(NBUDGET_RC), 'CORR', zrcs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rr .and. lwarm .and. lrain ) call Budget_store_end( tbudgets(NBUDGET_RR), 'CORR', zrrs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_ri .and. lcold .and. lsnow ) call Budget_store_end( tbudgets(NBUDGET_RI), 'CORR', zris(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rs .and. lcold .and. lsnow ) call Budget_store_end( tbudgets(NBUDGET_RS), 'CORR', zrss(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_sv ) then
+ if ( lwarm .and. lrain ) &
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'CORR', zccs(:, :, :) * prhodj(:, :, :) )
+ if ( lwarm .and. lrain ) &
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'CORR', zcrs(:, :, :) * prhodj(:, :, :) )
+ if ( lcold .and. lsnow ) &
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'CORR', zcis(:, :, :) * prhodj(:, :, :) )
+ end if
+end if
!-------------------------------------------------------------------------------
!
!* 1. Sedimentation
! -------------
!
!
+if ( lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'SEDI', zths(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rc .and. lwarm .and. lsedc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'SEDI', zrcs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rr .and. lwarm .and. lrain ) call Budget_store_init( tbudgets(NBUDGET_RR), 'SEDI', zrrs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_ri .and. lcold .and. lsedi ) call Budget_store_init( tbudgets(NBUDGET_RI), 'SEDI', zris(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rs .and. lcold .and. lsnow ) call Budget_store_init( tbudgets(NBUDGET_RS), 'SEDI', zrss(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rg .and. lcold .and. lsnow ) call Budget_store_init( tbudgets(NBUDGET_RG), 'SEDI', zrgs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rh .and. lcold .and. lhail ) call Budget_store_init( tbudgets(NBUDGET_RH), 'SEDI', zrhs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_sv ) then
+ if ( lwarm .and. lsedc ) &
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'SEDI', zccs(:, :, :) * prhodj(:, :, :) )
+ if ( lwarm .and. lrain ) &
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'SEDI', zcrs(:, :, :) * prhodj(:, :, :) )
+ if ( lcold .and. lsedi ) &
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'SEDI', zcis(:, :, :) * prhodj(:, :, :) )
+ end if
+end if
+
ZRT_SUM = (ZRVS + ZRCS + ZRRS + ZRIS + ZRSS + ZRGS + ZRHS)*PTSTEP
ZCPT = XCPD + (XCPV * ZRVS + XCL * (ZRCS + ZRRS) + XCI * (ZRIS + ZRSS + ZRGS + ZRHS))*PTSTEP
IF (LWARM .AND. LSEDC) CALL LIMA_SEDIMENTATION(IIB, IIE, IIT, IJB, IJE, IJT, IKB, IKE, IKTB, IKTE, IKT, KKL, &
@@ -607,24 +646,30 @@ ZTHS(:,:,:) = ZT(:,:,:) / ZEXN(:,:,:) * ZINV_TSTEP
!
! Call budgets
!
-IF(LBU_ENABLE) THEN
- IF (LBUDGET_TH) CALL BUDGET (ZTHS(:,:,:)*PRHODJ(:,:,:), NBUDGET_TH, 'SEDI_BU_RTH')
- IF (LBUDGET_RC .AND. LWARM .AND. LSEDC) CALL BUDGET (ZRCS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RC, 'SEDI_BU_RRC')
- IF (LBUDGET_RR .AND. LWARM .AND. LRAIN) CALL BUDGET (ZRRS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RR, 'SEDI_BU_RRR')
- IF (LBUDGET_RI .AND. LCOLD .AND. LSEDI) CALL BUDGET (ZRIS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RI, 'SEDI_BU_RRI')
- IF (LBUDGET_RS .AND. LCOLD .AND. LSNOW) CALL BUDGET (ZRSS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RS, 'SEDI_BU_RRS')
- IF (LBUDGET_RG .AND. LCOLD .AND. LSNOW) CALL BUDGET (ZRGS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RG, 'SEDI_BU_RRG')
- IF (LBUDGET_RH .AND. LCOLD .AND. LHAIL) CALL BUDGET (ZRHS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RH, 'SEDI_BU_RRH')
- IF (LBUDGET_SV) THEN
- IF (LWARM .AND. LSEDC) CALL BUDGET (ZCCS(:,:,:)*PRHODJ(:,:,:), NBUDGET_SV1-1+NSV_LIMA_NC, 'SEDI_BU_RSV')
- IF (LWARM .AND. LRAIN) CALL BUDGET (ZCRS(:,:,:)*PRHODJ(:,:,:), NBUDGET_SV1-1+NSV_LIMA_NR, 'SEDI_BU_RSV')
- IF (LCOLD .AND. LSEDI) CALL BUDGET (ZCIS(:,:,:)*PRHODJ(:,:,:), NBUDGET_SV1-1+NSV_LIMA_NI, 'SEDI_BU_RSV')
- END IF
-END IF
+if ( lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'SEDI', zths(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rc .and. lwarm .and. lsedc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'SEDI', zrcs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rr .and. lwarm .and. lrain ) call Budget_store_end( tbudgets(NBUDGET_RR), 'SEDI', zrrs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_ri .and. lcold .and. lsedi ) call Budget_store_end( tbudgets(NBUDGET_RI), 'SEDI', zris(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rs .and. lcold .and. lsnow ) call Budget_store_end( tbudgets(NBUDGET_RS), 'SEDI', zrss(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rg .and. lcold .and. lsnow ) call Budget_store_end( tbudgets(NBUDGET_RG), 'SEDI', zrgs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rh .and. lcold .and. lhail ) call Budget_store_end( tbudgets(NBUDGET_RH), 'SEDI', zrhs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_sv ) then
+ if ( lwarm .and. lsedc ) &
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'SEDI', zccs(:, :, :) * prhodj(:, :, :) )
+ if ( lwarm .and. lrain ) &
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'SEDI', zcrs(:, :, :) * prhodj(:, :, :) )
+ if ( lcold .and. lsedi ) &
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'SEDI', zcis(:, :, :) * prhodj(:, :, :) )
+ end if
+end if
!
! 1.bis Deposition at 1st level above ground
!
IF (LWARM .AND. LDEPOC) THEN
+ if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'DEPO', zrcs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'DEPO', zccs(:, :, :) * prhodj(:, :, :) )
+
PINDEP(:,:)=0.
GDEP(:,:) = .FALSE.
GDEP(:,:) = ZRCS(:,:,IKB) >0 .AND. ZCCS(:,:,IKB) >0
@@ -634,15 +679,22 @@ IF (LWARM .AND. LDEPOC) THEN
PINPRC(:,:) = PINPRC(:,:) + XVDEPOC * ZRCT(:,:,IKB) * PRHODREF(:,:,IKB) /XRHOLW
PINDEP(:,:) = XVDEPOC * ZRCT(:,:,IKB) * PRHODREF(:,:,IKB) /XRHOLW
END WHERE
-!
- IF ( LBUDGET_RC ) CALL BUDGET (ZRCS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RC, 'DEPO_BU_RRC')
- IF ( LBUDGET_SV ) CALL BUDGET (ZCCS(:,:,:)*PRHODJ(:,:,:), NBUDGET_SV1-1+NSV_LIMA_NC, 'DEPO_BU_RSV')
+
+ if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'DEPO', zrcs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'DEPO', zccs(:, :, :) * prhodj(:, :, :) )
END IF
!
!
Z_RR_CVRC(:,:,:) = 0.
Z_CR_CVRC(:,:,:) = 0.
IF (LWARM .AND. LRAIN) THEN
+ if( lbu_enable ) then
+ if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'R2C1', zrcs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'R2C1', zrrs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'R2C1', zccs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'R2C1', zcrs(:, :, :) * prhodj(:, :, :) )
+ end if
+
CALL LIMA_DROPS_TO_DROPLETS_CONV(PRHODREF, ZRCS*PTSTEP, ZRRS*PTSTEP, ZCCS*PTSTEP, ZCRS*PTSTEP, &
Z_RR_CVRC, Z_CR_CVRC)
!
@@ -650,15 +702,13 @@ IF (LWARM .AND. LRAIN) THEN
ZRRS(:,:,:) = ZRRS(:,:,:) + Z_RR_CVRC(:,:,:)/PTSTEP
ZCCS(:,:,:) = ZCCS(:,:,:) - Z_CR_CVRC(:,:,:)/PTSTEP
ZCRS(:,:,:) = ZCRS(:,:,:) + Z_CR_CVRC(:,:,:)/PTSTEP
- !
- IF(LBU_ENABLE) THEN
- IF (LBUDGET_RC) CALL BUDGET (ZRCS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RC, 'R2C1_BU_RRC')
- IF (LBUDGET_RR) CALL BUDGET (ZRRS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RR, 'R2C1_BU_RRR')
- IF (LBUDGET_SV) THEN
- CALL BUDGET (ZCCS(:,:,:)*PRHODJ(:,:,:), NBUDGET_SV1-1+NSV_LIMA_NC , 'R2C1_BU_RSV')
- CALL BUDGET (ZCRS(:,:,:)*PRHODJ(:,:,:), NBUDGET_SV1-1+NSV_LIMA_NR , 'R2C1_BU_RSV')
- END IF
- END IF
+
+ if( lbu_enable ) then
+ if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'R2C1', zrcs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'R2C1', zrrs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'R2C1', zccs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'R2C1', zcrs(:, :, :) * prhodj(:, :, :) )
+ end if
END IF
!
! Update variables
@@ -1475,260 +1525,150 @@ IF ( LCOLD .AND. LHHONI) PSVS(:,:,:,NSV_LIMA_HOM_HAZE) = ZHOMFT(:,:,:) *ZINV_TST
!
! Call budgets
!
-IF(LBU_ENABLE) THEN
- IF (LBUDGET_TH) THEN
- ZTHS(:,:,:) = ZTHS(:,:,:) + ZTOT_TH_EVAP(:,:,:)/PTSTEP
- CALL BUDGET (ZTHS(:,:,:)*PRHODJ(:,:,:), NBUDGET_TH, 'REVA_BU_RTH')
- ZTHS(:,:,:) = ZTHS(:,:,:) + ZTOT_TH_HONC(:,:,:)/PTSTEP
- CALL BUDGET (ZTHS(:,:,:)*PRHODJ(:,:,:), NBUDGET_TH, 'HONC_BU_RTH')
- ZTHS(:,:,:) = ZTHS(:,:,:) + ZTOT_TH_HONR(:,:,:)/PTSTEP
- CALL BUDGET (ZTHS(:,:,:)*PRHODJ(:,:,:), NBUDGET_TH, 'HONR_BU_RTH')
- ZTHS(:,:,:) = ZTHS(:,:,:) + ZTOT_TH_DEPS(:,:,:)/PTSTEP
- CALL BUDGET (ZTHS(:,:,:)*PRHODJ(:,:,:), NBUDGET_TH, 'DEPS_BU_RTH')
- ZTHS(:,:,:) = ZTHS(:,:,:) + ZTOT_TH_DEPG(:,:,:)/PTSTEP
- CALL BUDGET (ZTHS(:,:,:)*PRHODJ(:,:,:), NBUDGET_TH, 'DEPG_BU_RTH')
- ZTHS(:,:,:) = ZTHS(:,:,:) + ZTOT_TH_IMLT(:,:,:)/PTSTEP
- CALL BUDGET (ZTHS(:,:,:)*PRHODJ(:,:,:), NBUDGET_TH, 'IMLT_BU_RTH')
- ZTHS(:,:,:) = ZTHS(:,:,:) + ZTOT_TH_BERFI(:,:,:)/PTSTEP
- CALL BUDGET (ZTHS(:,:,:)*PRHODJ(:,:,:), NBUDGET_TH, 'BERFI_BU_RTH')
- ZTHS(:,:,:) = ZTHS(:,:,:) + ZTOT_TH_RIM(:,:,:)/PTSTEP
- CALL BUDGET (ZTHS(:,:,:)*PRHODJ(:,:,:), NBUDGET_TH, 'RIM_BU_RTH')
- ZTHS(:,:,:) = ZTHS(:,:,:) + ZTOT_TH_ACC(:,:,:)/PTSTEP
- CALL BUDGET (ZTHS(:,:,:)*PRHODJ(:,:,:), NBUDGET_TH, 'ACC_BU_RTH')
- ZTHS(:,:,:) = ZTHS(:,:,:) + ZTOT_TH_CFRZ(:,:,:)/PTSTEP
- CALL BUDGET (ZTHS(:,:,:)*PRHODJ(:,:,:), NBUDGET_TH, 'CFRZ_BU_RTH')
- ZTHS(:,:,:) = ZTHS(:,:,:) + ZTOT_TH_WETG(:,:,:)/PTSTEP
- CALL BUDGET (ZTHS(:,:,:)*PRHODJ(:,:,:), NBUDGET_TH, 'WETG_BU_RTH')
- ZTHS(:,:,:) = ZTHS(:,:,:) + ZTOT_TH_DRYG(:,:,:)/PTSTEP
- CALL BUDGET (ZTHS(:,:,:)*PRHODJ(:,:,:), NBUDGET_TH, 'DRYG_BU_RTH')
- ZTHS(:,:,:) = ZTHS(:,:,:) + ZTOT_TH_GMLT(:,:,:)/PTSTEP
- CALL BUDGET (ZTHS(:,:,:)*PRHODJ(:,:,:), NBUDGET_TH, 'GMLT_BU_RTH')
- END IF
+if ( lbu_enable ) then
+ allocate( zrhodjontstep(size( prhodj, 1), size( prhodj, 2), size( prhodj, 3) ) )
+ zrhodjontstep(:, :, :) = zinv_tstep * prhodj(:, :, :)
- IF (LBUDGET_RV) THEN
- ZRVS(:,:,:) = ZRVS(:,:,:) - ZTOT_RR_EVAP(:,:,:)/PTSTEP
- CALL BUDGET (ZRVS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RV, 'REVA_BU_RRV')
- ZRVS(:,:,:) = ZRVS(:,:,:) - ZTOT_RS_DEPS(:,:,:)/PTSTEP
- CALL BUDGET (ZRVS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RV, 'DEPS_BU_RRV')
- ZRVS(:,:,:) = ZRVS(:,:,:) - ZTOT_RG_DEPG(:,:,:)/PTSTEP
- CALL BUDGET (ZRVS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RV, 'DEPG_BU_RRV')
- END IF
+ if ( lbudget_th ) then
+ call Budget_store_add( tbudgets(NBUDGET_TH), 'REVA', ztot_th_evap (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_TH), 'HONC', ztot_th_honc (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_TH), 'HONR', ztot_th_honr (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_TH), 'DEPS', ztot_th_deps (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_TH), 'DEPG', ztot_th_depg (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_TH), 'IMLT', ztot_th_imlt (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_TH), 'BERFI', ztot_th_berfi(:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_TH), 'RIM', ztot_th_rim (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_TH), 'ACC', ztot_th_acc (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_TH), 'CFRZ', ztot_th_cfrz (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_TH), 'WETG', ztot_th_wetg (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_TH), 'DRYG', ztot_th_dryg (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_TH), 'GMLT', ztot_th_gmlt (:, :, :) * zrhodjontstep(:, :, :) )
+ end if
- IF (LBUDGET_RC) THEN
- ZRCS(:,:,:) = ZRCS(:,:,:) + ZTOT_RC_AUTO(:,:,:)/PTSTEP
- CALL BUDGET (ZRCS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RC, 'AUTO_BU_RRC')
- ZRCS(:,:,:) = ZRCS(:,:,:) + ZTOT_RC_ACCR(:,:,:)/PTSTEP
- CALL BUDGET (ZRCS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RC, 'ACCR_BU_RRC')
- ! impact of rain evap !!!!!!
- ZRCS(:,:,:) = ZRCS(:,:,:)
- CALL BUDGET (ZRCS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RC, 'REVA_BU_RRC')
- ZRCS(:,:,:) = ZRCS(:,:,:) + ZTOT_RC_HONC(:,:,:)/PTSTEP
- CALL BUDGET (ZRCS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RC, 'HONC_BU_RRC')
- ZRCS(:,:,:) = ZRCS(:,:,:) + ZTOT_RC_IMLT(:,:,:)/PTSTEP
- CALL BUDGET (ZRCS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RC, 'IMLT_BU_RRC')
- ZRCS(:,:,:) = ZRCS(:,:,:) + ZTOT_RC_BERFI(:,:,:)/PTSTEP
- CALL BUDGET (ZRCS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RC, 'BERFI_BU_RRC')
- ZRCS(:,:,:) = ZRCS(:,:,:) + ZTOT_RC_RIM(:,:,:)/PTSTEP
- CALL BUDGET (ZRCS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RC, 'RIM_BU_RRC')
- ZRCS(:,:,:) = ZRCS(:,:,:) + ZTOT_RC_WETG(:,:,:)/PTSTEP
- CALL BUDGET (ZRCS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RC, 'WETG_BU_RRC')
- ZRCS(:,:,:) = ZRCS(:,:,:) + ZTOT_RC_DRYG(:,:,:)/PTSTEP
- CALL BUDGET (ZRCS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RC, 'DRYG_BU_RRC')
- ZRCS(:,:,:) = ZRCS(:,:,:) - ZTOT_RR_CVRC(:,:,:)/PTSTEP
- CALL BUDGET (ZRCS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RC, 'CVRC_BU_RRC')
- END IF
-
- IF (LBUDGET_RR) THEN
- ZRRS(:,:,:) = ZRRS(:,:,:) - ZTOT_RC_AUTO(:,:,:)/PTSTEP
- CALL BUDGET (ZRRS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RR, 'AUTO_BU_RRR')
- ZRRS(:,:,:) = ZRRS(:,:,:) - ZTOT_RC_ACCR(:,:,:)/PTSTEP
- CALL BUDGET (ZRRS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RR, 'ACCR_BU_RRR')
- ZRRS(:,:,:) = ZRRS(:,:,:) + ZTOT_RR_EVAP(:,:,:)/PTSTEP
- CALL BUDGET (ZRRS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RR, 'REVA_BU_RRR')
- ZRRS(:,:,:) = ZRRS(:,:,:) + ZTOT_RR_HONR(:,:,:)/PTSTEP
- CALL BUDGET (ZRRS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RR, 'HONR_BU_RRR')
- ZRRS(:,:,:) = ZRRS(:,:,:) + ZTOT_RR_ACC(:,:,:)/PTSTEP
- CALL BUDGET (ZRRS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RR, 'ACC_BU_RRR')
- ZRRS(:,:,:) = ZRRS(:,:,:) + ZTOT_RR_CFRZ(:,:,:)/PTSTEP
- CALL BUDGET (ZRRS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RR, 'CFRZ_BU_RRR')
- ZRRS(:,:,:) = ZRRS(:,:,:) + ZTOT_RR_WETG(:,:,:)/PTSTEP
- CALL BUDGET (ZRRS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RR, 'WETG_BU_RRR')
- ZRRS(:,:,:) = ZRRS(:,:,:) + ZTOT_RR_DRYG(:,:,:)/PTSTEP
- CALL BUDGET (ZRRS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RR, 'DRYG_BU_RRR')
- ZRRS(:,:,:) = ZRRS(:,:,:) + ZTOT_RR_GMLT(:,:,:)/PTSTEP
- CALL BUDGET (ZRRS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RR, 'GMLT_BU_RRR')
- ZRRS(:,:,:) = ZRRS(:,:,:) + ZTOT_RR_CVRC(:,:,:)/PTSTEP
- CALL BUDGET (ZRRS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RR, 'CVRC_BU_RRR')
- END IF
-
- IF (LBUDGET_RI) THEN
- ZRIS(:,:,:) = ZRIS(:,:,:) - ZTOT_RC_HONC(:,:,:)/PTSTEP
- CALL BUDGET (ZRIS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RI, 'HONC_BU_RRI')
- ZRIS(:,:,:) = ZRIS(:,:,:) + ZTOT_RI_CNVI(:,:,:)/PTSTEP
- CALL BUDGET (ZRIS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RI, 'CNVI_BU_RRI')
- ZRIS(:,:,:) = ZRIS(:,:,:) + ZTOT_RI_CNVS(:,:,:)/PTSTEP
- CALL BUDGET (ZRIS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RI, 'CNVS_BU_RRI')
- ZRIS(:,:,:) = ZRIS(:,:,:) + ZTOT_RI_AGGS(:,:,:)/PTSTEP
- CALL BUDGET (ZRIS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RI, 'AGGS_BU_RRI')
- ZRIS(:,:,:) = ZRIS(:,:,:) - ZTOT_RC_IMLT(:,:,:)/PTSTEP
- CALL BUDGET (ZRIS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RI, 'IMLT_BU_RRI')
- ZRIS(:,:,:) = ZRIS(:,:,:) - ZTOT_RC_BERFI(:,:,:)/PTSTEP
- CALL BUDGET (ZRIS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RI, 'BERFI_BU_RRI')
- ZRIS(:,:,:) = ZRIS(:,:,:) + ZTOT_RI_HMS(:,:,:)/PTSTEP
- CALL BUDGET (ZRIS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RI, 'HMS_BU_RRI')
- ZRIS(:,:,:) = ZRIS(:,:,:) + ZTOT_RI_CFRZ(:,:,:)/PTSTEP
- CALL BUDGET (ZRIS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RI, 'CFRZ_BU_RRI')
- ZRIS(:,:,:) = ZRIS(:,:,:) + ZTOT_RI_WETG(:,:,:)/PTSTEP
- CALL BUDGET (ZRIS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RI, 'WETG_BU_RRI')
- ZRIS(:,:,:) = ZRIS(:,:,:) + ZTOT_RI_DRYG(:,:,:)/PTSTEP
- CALL BUDGET (ZRIS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RI, 'DRYG_BU_RRI')
- ZRIS(:,:,:) = ZRIS(:,:,:) + ZTOT_RI_HMG(:,:,:)/PTSTEP
- CALL BUDGET (ZRIS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RI, 'HMG_BU_RRI')
- END IF
-
- IF (LBUDGET_RS) THEN
- ZRSS(:,:,:) = ZRSS(:,:,:) - ZTOT_RI_CNVI(:,:,:)/PTSTEP
- CALL BUDGET (ZRSS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RS, 'CNVI_BU_RRS')
- ZRSS(:,:,:) = ZRSS(:,:,:) + ZTOT_RS_DEPS(:,:,:)/PTSTEP
- CALL BUDGET (ZRSS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RS, 'DEPS_BU_RRS')
- ZRSS(:,:,:) = ZRSS(:,:,:) - ZTOT_RI_CNVS(:,:,:)/PTSTEP
- CALL BUDGET (ZRSS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RS, 'CNVS_BU_RRS')
- ZRSS(:,:,:) = ZRSS(:,:,:) - ZTOT_RI_AGGS(:,:,:)/PTSTEP
- CALL BUDGET (ZRSS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RS, 'AGGS_BU_RRS')
- ZRSS(:,:,:) = ZRSS(:,:,:) + ZTOT_RS_RIM(:,:,:)/PTSTEP
- CALL BUDGET (ZRSS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RS, 'RIM_BU_RRS')
- ZRSS(:,:,:) = ZRSS(:,:,:) + ZTOT_RS_HMS(:,:,:)/PTSTEP
- CALL BUDGET (ZRSS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RS, 'HMS_BU_RRS')
- ZRSS(:,:,:) = ZRSS(:,:,:) + ZTOT_RS_ACC(:,:,:)/PTSTEP
- CALL BUDGET (ZRSS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RS, 'ACC_BU_RRS')
- ZRSS(:,:,:) = ZRSS(:,:,:) + ZTOT_RS_CMEL(:,:,:)/PTSTEP
- CALL BUDGET (ZRSS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RS, 'CMEL_BU_RRS')
- ZRSS(:,:,:) = ZRSS(:,:,:) + ZTOT_RS_WETG(:,:,:)/PTSTEP
- CALL BUDGET (ZRSS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RS, 'WETG_BU_RRS')
- ZRSS(:,:,:) = ZRSS(:,:,:) + ZTOT_RS_DRYG(:,:,:)/PTSTEP
- CALL BUDGET (ZRSS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RS, 'DRYG_BU_RRS')
- END IF
-
- IF (LBUDGET_RG) THEN
- ZRGS(:,:,:) = ZRGS(:,:,:) - ZTOT_RR_HONR(:,:,:)/PTSTEP
- CALL BUDGET (ZRGS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RG, 'HONR_BU_RRG')
- ZRGS(:,:,:) = ZRGS(:,:,:) + ZTOT_RG_DEPG(:,:,:)/PTSTEP
- CALL BUDGET (ZRGS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RG, 'DEPG_BU_RRG')
- ZRGS(:,:,:) = ZRGS(:,:,:) + ZTOT_RG_RIM(:,:,:)/PTSTEP
- CALL BUDGET (ZRGS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RG, 'RIM_BU_RRG')
- ZRGS(:,:,:) = ZRGS(:,:,:) + ZTOT_RG_ACC(:,:,:)/PTSTEP
- CALL BUDGET (ZRGS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RG, 'ACC_BU_RRG')
- ZRGS(:,:,:) = ZRGS(:,:,:) - ZTOT_RS_CMEL(:,:,:)/PTSTEP
- CALL BUDGET (ZRGS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RG, 'CMEL_BU_RRG')
- ZRGS(:,:,:) = ZRGS(:,:,:) - ZTOT_RR_CFRZ(:,:,:)/PTSTEP - ZTOT_RI_CFRZ(:,:,:)/PTSTEP
- CALL BUDGET (ZRGS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RG, 'CFRZ_BU_RRG')
- ZRGS(:,:,:) = ZRGS(:,:,:) + ZTOT_RG_WETG(:,:,:)/PTSTEP
- CALL BUDGET (ZRGS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RG, 'WETG_BU_RRG')
- ZRGS(:,:,:) = ZRGS(:,:,:) + ZTOT_RG_DRYG(:,:,:)/PTSTEP
- CALL BUDGET (ZRGS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RG, 'DRYG_BU_RRG')
- ZRGS(:,:,:) = ZRGS(:,:,:) + ZTOT_RG_HMG(:,:,:)/PTSTEP
- CALL BUDGET (ZRGS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RG, 'HMG_BU_RRG')
- ZRGS(:,:,:) = ZRGS(:,:,:) - ZTOT_RR_GMLT(:,:,:)/PTSTEP
- CALL BUDGET (ZRGS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RG, 'GMLT_BU_RRG')
- END IF
+ if ( lbudget_rv ) then
+ call Budget_store_add( tbudgets(NBUDGET_RV), 'REVA', -ztot_rr_evap (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_RV), 'DEPS', -ztot_rs_deps (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_RV), 'DEPG', -ztot_rg_depg (:, :, :) * zrhodjontstep(:, :, :) )
+ end if
- IF (LBUDGET_RH) THEN
- ZRHS(:,:,:) = ZRHS(:,:,:) + ZTOT_RH_WETG(:,:,:)/PTSTEP
- CALL BUDGET (ZRHS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RH, 'WETG_BU_RRH')
- END IF
+ if ( lbudget_rc ) then
+ call Budget_store_add( tbudgets(NBUDGET_RC), 'AUTO', ztot_rc_auto (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_RC), 'ACCR', ztot_rc_accr (:, :, :) * zrhodjontstep(:, :, :) )
+ !call Budget_store_add( tbudgets(NBUDGET_RC), 'REVA', 0. )
+ call Budget_store_add( tbudgets(NBUDGET_RC), 'HONC', ztot_rc_honc (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_RC), 'IMLT', ztot_rc_imlt (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_RC), 'BERFI', ztot_rc_berfi(:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_RC), 'RIM', ztot_rc_rim (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_RC), 'WETG', ztot_rc_wetg (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_RC), 'DRYG', ztot_rc_dryg (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_RC), 'CVRC', -ztot_rr_cvrc (:, :, :) * zrhodjontstep(:, :, :) )
+ end if
- IF (LBUDGET_SV) THEN
- !
- ! Cloud droplets
- !
- ZCCS(:,:,:) = ZCCS(:,:,:) + ZTOT_CC_SELF(:,:,:)/PTSTEP
- CALL BUDGET (ZCCS(:,:,:)*PRHODJ(:,:,:), NBUDGET_SV1-1+NSV_LIMA_NC, 'SELF_BU_RSV')
- ZCCS(:,:,:) = ZCCS(:,:,:) + ZTOT_CC_AUTO(:,:,:)/PTSTEP
- CALL BUDGET (ZCCS(:,:,:)*PRHODJ(:,:,:), NBUDGET_SV1-1+NSV_LIMA_NC, 'AUTO_BU_RSV')
- ZCCS(:,:,:) = ZCCS(:,:,:) + ZTOT_CC_ACCR(:,:,:)/PTSTEP
- CALL BUDGET (ZCCS(:,:,:)*PRHODJ(:,:,:), NBUDGET_SV1-1+NSV_LIMA_NC, 'ACCR_BU_RSV')
- ! impact of rain evap !!!!!!
- ZCCS(:,:,:) = ZCCS(:,:,:)
- CALL BUDGET (ZCCS(:,:,:)*PRHODJ(:,:,:), NBUDGET_SV1-1+NSV_LIMA_NC, 'REVA_BU_RSV')
- ZCCS(:,:,:) = ZCCS(:,:,:) + ZTOT_CC_HONC(:,:,:)/PTSTEP
- CALL BUDGET (ZCCS(:,:,:)*PRHODJ(:,:,:), NBUDGET_SV1-1+NSV_LIMA_NC, 'HONC_BU_RSV')
- ZCCS(:,:,:) = ZCCS(:,:,:) + ZTOT_CC_IMLT(:,:,:)/PTSTEP
- CALL BUDGET (ZCCS(:,:,:)*PRHODJ(:,:,:), NBUDGET_SV1-1+NSV_LIMA_NC, 'IMLT_BU_RSV')
- ZCCS(:,:,:) = ZCCS(:,:,:) + ZTOT_CC_RIM(:,:,:)/PTSTEP
- CALL BUDGET (ZCCS(:,:,:)*PRHODJ(:,:,:), NBUDGET_SV1-1+NSV_LIMA_NC, 'RIM_BU_RSV')
- ZCCS(:,:,:) = ZCCS(:,:,:) + ZTOT_CC_WETG(:,:,:)/PTSTEP
- CALL BUDGET (ZCCS(:,:,:)*PRHODJ(:,:,:), NBUDGET_SV1-1+NSV_LIMA_NC, 'WETG_BU_RSV')
- ZCCS(:,:,:) = ZCCS(:,:,:) + ZTOT_CC_DRYG(:,:,:)/PTSTEP
- CALL BUDGET (ZCCS(:,:,:)*PRHODJ(:,:,:), NBUDGET_SV1-1+NSV_LIMA_NC, 'DRYG_BU_RSV')
- ZCCS(:,:,:) = ZCCS(:,:,:) - ZTOT_CR_CVRC(:,:,:)/PTSTEP
- CALL BUDGET (ZCCS(:,:,:)*PRHODJ(:,:,:), NBUDGET_SV1-1+NSV_LIMA_NC, 'CVRC_BU_RSV')
- !
- ! Rain drops
- !
- ZCRS(:,:,:) = ZCRS(:,:,:) + ZTOT_CR_AUTO(:,:,:)/PTSTEP
- CALL BUDGET (ZCRS(:,:,:)*PRHODJ(:,:,:), NBUDGET_SV1-1+NSV_LIMA_NR, 'AUTO_BU_RSV')
- ZCRS(:,:,:) = ZCRS(:,:,:) + ZTOT_CR_SCBU(:,:,:)/PTSTEP
- CALL BUDGET (ZCRS(:,:,:)*PRHODJ(:,:,:), NBUDGET_SV1-1+NSV_LIMA_NR, 'SCBU_BU_RSV')
- ! Rain evaporation !!!!!!!!!!!!!
- ZCRS(:,:,:) = ZCRS(:,:,:)
- CALL BUDGET (ZCRS(:,:,:)*PRHODJ(:,:,:), NBUDGET_SV1-1+NSV_LIMA_NR, 'REVA_BU_RSV')
- ZCRS(:,:,:) = ZCRS(:,:,:) + ZTOT_CR_BRKU(:,:,:)/PTSTEP
- CALL BUDGET (ZCRS(:,:,:)*PRHODJ(:,:,:), NBUDGET_SV1-1+NSV_LIMA_NR, 'BRKU_BU_RSV')
- ZCRS(:,:,:) = ZCRS(:,:,:) + ZTOT_CR_HONR(:,:,:)/PTSTEP
- CALL BUDGET (ZCRS(:,:,:)*PRHODJ(:,:,:), NBUDGET_SV1-1+NSV_LIMA_NR, 'HONR_BU_RSV')
- ZCRS(:,:,:) = ZCRS(:,:,:) + ZTOT_CR_ACC(:,:,:)/PTSTEP
- CALL BUDGET (ZCRS(:,:,:)*PRHODJ(:,:,:), NBUDGET_SV1-1+NSV_LIMA_NR, 'ACC_BU_RSV')
- ZCRS(:,:,:) = ZCRS(:,:,:) + ZTOT_CR_CFRZ(:,:,:)/PTSTEP
- CALL BUDGET (ZCRS(:,:,:)*PRHODJ(:,:,:), NBUDGET_SV1-1+NSV_LIMA_NR, 'CFRZ_BU_RSV')
- ZCRS(:,:,:) = ZCRS(:,:,:) + ZTOT_CR_WETG(:,:,:)/PTSTEP
- CALL BUDGET (ZCRS(:,:,:)*PRHODJ(:,:,:), NBUDGET_SV1-1+NSV_LIMA_NR, 'WETG_BU_RSV')
- ZCRS(:,:,:) = ZCRS(:,:,:) + ZTOT_CR_DRYG(:,:,:)/PTSTEP
- CALL BUDGET (ZCRS(:,:,:)*PRHODJ(:,:,:), NBUDGET_SV1-1+NSV_LIMA_NR, 'DRYG_BU_RSV')
- ZCRS(:,:,:) = ZCRS(:,:,:) + ZTOT_CR_GMLT(:,:,:)/PTSTEP
- CALL BUDGET (ZCRS(:,:,:)*PRHODJ(:,:,:), NBUDGET_SV1-1+NSV_LIMA_NR, 'GMLT_BU_RSV')
- ZCRS(:,:,:) = ZCRS(:,:,:) + ZTOT_CR_CVRC(:,:,:)/PTSTEP
- CALL BUDGET (ZCRS(:,:,:)*PRHODJ(:,:,:), NBUDGET_SV1-1+NSV_LIMA_NR, 'CVRC_BU_RSV')
- !
- ! Ice crystals
- !
- ZCIS(:,:,:) = ZCIS(:,:,:) - ZTOT_CC_HONC(:,:,:)/PTSTEP
- CALL BUDGET (ZCIS(:,:,:)*PRHODJ(:,:,:), NBUDGET_SV1-1+NSV_LIMA_NI, 'HONC_BU_RSV')
- ZCIS(:,:,:) = ZCIS(:,:,:) + ZTOT_CI_CNVI(:,:,:)/PTSTEP
- CALL BUDGET (ZCIS(:,:,:)*PRHODJ(:,:,:), NBUDGET_SV1-1+NSV_LIMA_NI, 'CNVI_BU_RSV')
- ZCIS(:,:,:) = ZCIS(:,:,:) + ZTOT_CI_CNVS(:,:,:)/PTSTEP
- CALL BUDGET (ZCIS(:,:,:)*PRHODJ(:,:,:), NBUDGET_SV1-1+NSV_LIMA_NI, 'CNVS_BU_RSV')
- ZCIS(:,:,:) = ZCIS(:,:,:) + ZTOT_CI_AGGS(:,:,:)/PTSTEP
- CALL BUDGET (ZCIS(:,:,:)*PRHODJ(:,:,:), NBUDGET_SV1-1+NSV_LIMA_NI, 'AGGS_BU_RSV')
- ZCIS(:,:,:) = ZCIS(:,:,:) - ZTOT_CC_IMLT(:,:,:)/PTSTEP
- CALL BUDGET (ZCIS(:,:,:)*PRHODJ(:,:,:), NBUDGET_SV1-1+NSV_LIMA_NI, 'IMLT_BU_RSV')
- ZCIS(:,:,:) = ZCIS(:,:,:) + ZTOT_CI_HMS(:,:,:)/PTSTEP
- CALL BUDGET (ZCIS(:,:,:)*PRHODJ(:,:,:), NBUDGET_SV1-1+NSV_LIMA_NI, 'HMS_BU_RSV')
- ZCIS(:,:,:) = ZCIS(:,:,:) + ZTOT_CI_CFRZ(:,:,:)/PTSTEP
- CALL BUDGET (ZCIS(:,:,:)*PRHODJ(:,:,:), NBUDGET_SV1-1+NSV_LIMA_NI, 'CFRZ_BU_RSV')
- ZCIS(:,:,:) = ZCIS(:,:,:) + ZTOT_CI_WETG(:,:,:)/PTSTEP
- CALL BUDGET (ZCIS(:,:,:)*PRHODJ(:,:,:), NBUDGET_SV1-1+NSV_LIMA_NI, 'WETG_BU_RSV')
- ZCIS(:,:,:) = ZCIS(:,:,:) + ZTOT_CI_DRYG(:,:,:)/PTSTEP
- CALL BUDGET (ZCIS(:,:,:)*PRHODJ(:,:,:), NBUDGET_SV1-1+NSV_LIMA_NI, 'DRYG_BU_RSV')
- ZCIS(:,:,:) = ZCIS(:,:,:) + ZTOT_CI_HMG(:,:,:)/PTSTEP
- CALL BUDGET (ZCIS(:,:,:)*PRHODJ(:,:,:), NBUDGET_SV1-1+NSV_LIMA_NI, 'HMG_BU_RSV')
- END IF
-!!$ ZTOT_RC_EVAP(I1(II),I2(II),I3(II)) = ZTOT_RC_EVAP(I1(II),I2(II),I3(II)) + Z_RC_EVAP(II) * ZMAXTIME(II)
-!!$ ZTOT_CC_EVAP(I1(II),I2(II),I3(II)) = ZTOT_CC_EVAP(I1(II),I2(II),I3(II)) + Z_CC_EVAP(II) * ZMAXTIME(II)
-!!$ ZTOT_CR_EVAP(I1(II),I2(II),I3(II)) = ZTOT_CR_EVAP(I1(II),I2(II),I3(II)) + Z_CR_EVAP(II) * ZMAXTIME(II)
+ if ( lbudget_rr ) then
+ call Budget_store_add( tbudgets(NBUDGET_RR), 'AUTO', -ztot_rc_auto(:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_RR), 'ACCR', -ztot_rc_accr(:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_RR), 'REVA', ztot_rr_evap(:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_RR), 'HONR', ztot_rr_honr(:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_RR), 'ACC', ztot_rr_acc (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_RR), 'CFRZ', ztot_rr_cfrz(:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_RR), 'WETG', ztot_rr_wetg(:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_RR), 'DRYG', ztot_rr_dryg(:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_RR), 'GMLT', ztot_rr_gmlt(:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_RR), 'CVRC', ztot_rr_cvrc(:, :, :) * zrhodjontstep(:, :, :) )
+ end if
-!!$ ZTOT_RC_WETH(I1(II),I2(II),I3(II)) = ZTOT_RC_WETH(I1(II),I2(II),I3(II)) + Z_RC_WETH(II) * ZMAXTIME(II)
-!!$ ZTOT_CC_WETH(I1(II),I2(II),I3(II)) = ZTOT_CC_WETH(I1(II),I2(II),I3(II)) + Z_CC_WETH(II) * ZMAXTIME(II)
-!!$ ZTOT_RR_WETH(I1(II),I2(II),I3(II)) = ZTOT_RR_WETH(I1(II),I2(II),I3(II)) + Z_RR_WETH(II) * ZMAXTIME(II)
-!!$ ZTOT_CR_WETH(I1(II),I2(II),I3(II)) = ZTOT_CR_WETH(I1(II),I2(II),I3(II)) + Z_CR_WETH(II) * ZMAXTIME(II)
-!!$ ZTOT_RI_WETH(I1(II),I2(II),I3(II)) = ZTOT_RI_WETH(I1(II),I2(II),I3(II)) + Z_RI_WETH(II) * ZMAXTIME(II)
-!!$ ZTOT_CI_WETH(I1(II),I2(II),I3(II)) = ZTOT_CI_WETH(I1(II),I2(II),I3(II)) + Z_CI_WETH(II) * ZMAXTIME(II)
-!!$ ZTOT_RS_WETH(I1(II),I2(II),I3(II)) = ZTOT_RS_WETH(I1(II),I2(II),I3(II)) + Z_RS_WETH(II) * ZMAXTIME(II)
-!!$ ZTOT_RG_WETH(I1(II),I2(II),I3(II)) = ZTOT_RG_WETH(I1(II),I2(II),I3(II)) + Z_RG_WETH(II) * ZMAXTIME(II)
-!!$ ZTOT_RH_WETH(I1(II),I2(II),I3(II)) = ZTOT_RH_WETH(I1(II),I2(II),I3(II)) + Z_RH_WETH(II) * ZMAXTIME(II)
-!!$ ZTOT_RG_COHG(I1(II),I2(II),I3(II)) = ZTOT_RG_COHG(I1(II),I2(II),I3(II)) + Z_RG_COHG(II) * ZMAXTIME(II)
-!!$ ZTOT_RR_HMLT(I1(II),I2(II),I3(II)) = ZTOT_RR_HMLT(I1(II),I2(II),I3(II)) + Z_RR_HMLT(II) * ZMAXTIME(II)
-!!$ ZTOT_CR_HMLT(I1(II),I2(II),I3(II)) = ZTOT_CR_HMLT(I1(II),I2(II),I3(II)) + Z_CR_HMLT(II) * ZMAXTIME(II)
-
-END IF
+ if ( lbudget_ri ) then
+ call Budget_store_add( tbudgets(NBUDGET_RI), 'HONC', -ztot_rc_honc (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_RI), 'CNVI', ztot_ri_cnvi (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_RI), 'CNVS', ztot_ri_cnvs (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_RI), 'AGGS', ztot_ri_aggs (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_RI), 'IMLT', -ztot_rc_imlt (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_RI), 'BERFI', -ztot_rc_berfi(:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_RI), 'HMS', ztot_ri_hms (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_RI), 'CFRZ', ztot_ri_cfrz (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_RI), 'WETG', ztot_ri_wetg (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_RI), 'DRYG', ztot_ri_dryg (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_RI), 'HMG', ztot_ri_hmg (:, :, :) * zrhodjontstep(:, :, :) )
+ end if
+
+ if ( lbudget_rs ) then
+ call Budget_store_add( tbudgets(NBUDGET_RS), 'CNVI', -ztot_ri_cnvi(:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_RS), 'DEPS', ztot_rs_deps(:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_RS), 'CNVS', -ztot_ri_cnvs(:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_RS), 'AGGS', -ztot_ri_aggs(:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_RS), 'RIM', ztot_rs_rim (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_RS), 'HMS', ztot_rs_hms (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_RS), 'ACC', ztot_rs_acc (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_RS), 'CMEL', ztot_rs_cmel(:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_RS), 'WETG', ztot_rs_wetg(:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_RS), 'DRYG', ztot_rs_dryg(:, :, :) * zrhodjontstep(:, :, :) )
+ end if
+
+ if ( lbudget_rg ) then
+ call Budget_store_add( tbudgets(NBUDGET_RG), 'HONR', -ztot_rr_honr(:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_RG), 'DEPG', ztot_rg_depg(:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_RG), 'RIM', ztot_rg_rim (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_RG), 'ACC', ztot_rg_acc (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_RG), 'CMEL', -ztot_rs_cmel(:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_RG), 'CFRZ', ( -ztot_rr_cfrz(:, :, :) - ztot_ri_cfrz(:, :, :) ) &
+ * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_RG), 'WETG', ztot_rg_wetg(:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_RG), 'DRYG', ztot_rg_dryg(:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_RG), 'HMG', ztot_rg_hmg (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_RG), 'GMLT', -ztot_rr_gmlt(:, :, :) * zrhodjontstep(:, :, :) )
+ end if
+
+ if ( lbudget_rh ) then
+ call Budget_store_add( tbudgets(NBUDGET_RH), 'WETG', ztot_rh_wetg(:, :, :) * zrhodjontstep(:, :, :) )
+ end if
+
+ if ( lbudget_sv ) then
+ !
+ ! Cloud droplets
+ !
+ idx = NBUDGET_SV1 - 1 + nsv_lima_nc
+ call Budget_store_add( tbudgets(idx), 'SELF', ztot_cc_self (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(idx), 'AUTO', ztot_cc_auto (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(idx), 'ACCR', ztot_cc_accr (:, :, :) * zrhodjontstep(:, :, :) )
+ !call Budget_store_add( tbudgets(idx), 'REVA', 0. )c
+ call Budget_store_add( tbudgets(idx), 'HONC', ztot_cc_honc (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(idx), 'IMLT', ztot_cc_imlt (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(idx), 'RIM', ztot_cc_rim (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(idx), 'WETG', ztot_cc_wetg (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(idx), 'DRYG', ztot_cc_dryg (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(idx), 'CVRC', -ztot_cr_cvrc (:, :, :) * zrhodjontstep(:, :, :) )
+ !
+ ! Rain drops
+ !
+ idx = NBUDGET_SV1 - 1 + nsv_lima_nr
+ call Budget_store_add( tbudgets(idx), 'AUTO', ztot_cr_auto(:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(idx), 'SCBU', ztot_cr_scbu(:, :, :) * zrhodjontstep(:, :, :) )
+ !all Budget_store_add( tbudgets(idx), 'REVA', 0. )
+ call Budget_store_add( tbudgets(idx), 'BRKU', ztot_cr_brku(:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(idx), 'HONR', ztot_cr_honr(:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(idx), 'ACC', ztot_cr_acc (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(idx), 'CFRZ', ztot_cr_cfrz(:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(idx), 'WETG', ztot_cr_wetg(:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(idx), 'DRYG', ztot_cr_dryg(:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(idx), 'GMLT', ztot_cr_gmlt(:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(idx), 'CVRC', ztot_cr_cvrc(:, :, :) * zrhodjontstep(:, :, :) )
+ !
+ ! Ice crystals
+ !
+ idx = NBUDGET_SV1 - 1 + nsv_lima_ni
+ call Budget_store_add( tbudgets(idx), 'HONC', -ztot_cc_honc (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(idx), 'CNVI', ztot_ci_cnvi (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(idx), 'CNVS', ztot_ci_cnvs (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(idx), 'AGGS', ztot_ci_aggs (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(idx), 'IMLT', -ztot_cc_imlt (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(idx), 'HMS', ztot_ci_hms (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(idx), 'CFRZ', ztot_ci_cfrz (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(idx), 'WETG', ztot_ci_wetg (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(idx), 'DRYG', ztot_ci_dryg (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(idx), 'HMG', ztot_ci_hmg (:, :, :) * zrhodjontstep(:, :, :) )
+ end if
+
+ deallocate( zrhodjontstep )
+end if
!
END SUBROUTINE LIMA
diff --git a/src/MNH/lima_adjust.f90 b/src/MNH/lima_adjust.f90
index f460701f2c319c234bbe50357592392a0ade6c4d..bf61da8e357cc35a9acf2469e198396f8ba7c2ab 100644
--- a/src/MNH/lima_adjust.f90
+++ b/src/MNH/lima_adjust.f90
@@ -137,13 +137,16 @@ END MODULE MODI_LIMA_ADJUST
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90
-!
+! P. Wautelet 03/2020: use the new data structures and subroutines for budgets
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_BUDGET
+use modd_budget, only: lbu_enable, nbumod, &
+ lbudget_th, lbudget_rv, lbudget_rc, lbudget_ri, lbudget_sv, &
+ NBUDGET_TH, NBUDGET_RV, NBUDGET_RC, NBUDGET_RI, NBUDGET_SV1, &
+ tbudgets
USE MODD_CONF
USE MODD_CST
use modd_field, only: TFIELDDATA, TYPEREAL
@@ -156,11 +159,11 @@ USE MODD_PARAM_LIMA_COLD
USE MODD_PARAM_LIMA_MIXED
USE MODD_PARAM_LIMA_WARM
!
+use mode_budget, only: Budget_store_init, Budget_store_end
USE MODE_IO_FIELD_WRITE, only: IO_Field_write
use mode_msg
use mode_tools, only: Countjv
!
-USE MODI_BUDGET
USE MODI_CONDENS
USE MODI_LIMA_FUNCTIONS
!
@@ -276,6 +279,7 @@ INTEGER :: ISIZE
REAL, DIMENSION(:), ALLOCATABLE :: ZRTMIN
REAL, DIMENSION(:), ALLOCATABLE :: ZCTMIN
!
+integer :: idx
INTEGER , DIMENSION(SIZE(GMICRO)) :: I1,I2,I3 ! Used to replace the COUNT
INTEGER :: JL ! and PACK intrinsics
INTEGER :: JMOD, JMOD_IFN, JMOD_IMM
@@ -372,8 +376,30 @@ IF ( NMOD_IMM .GE. 1 ) THEN
ALLOCATE( PNIS(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3),NMOD_IMM) )
PNIS(:,:,:,:) = PSVS(:,:,:,NSV_LIMA_IMM_NUCL:NSV_LIMA_IMM_NUCL+NMOD_IMM-1)
END IF
-!
-!
+
+if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'CEDS', pths(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rv ) call Budget_store_init( tbudgets(NBUDGET_RV), 'CEDS', prvs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'CEDS', prcs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'CEDS', pris(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'CEDS', pccs(:, :, :) * prhodj(:, :, :) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'CEDS', pcis(:, :, :) * prhodj(:, :, :) )
+ if ( lwarm ) then
+ do jl = 1, nmod_ccn
+ idx = NBUDGET_SV1 - 1 + nsv_lima_ccn_free - 1 + jl
+ call Budget_store_init( tbudgets(idx), 'CEDS', pnfs(:, :, :, jl) * prhodj(:, :, :) )
+ end do
+ end if
+ if ( lcold ) then
+ do jl = 1, nmod_ifn
+ idx = NBUDGET_SV1 - 1 + nsv_lima_ifn_free - 1 + jl
+ call Budget_store_init( tbudgets(idx), 'CEDS', pifs(:, :, :, jl) * prhodj(:, :, :) )
+ end do
+ end if
+ end if
+end if
+
!-------------------------------------------------------------------------------
!
!
@@ -1195,27 +1221,28 @@ END IF
!* 7. STORE THE BUDGET TERMS
! ----------------------
!
-!
-IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
- IF (LBUDGET_TH) CALL BUDGET (PTHS(:,:,:) * PRHODJ(:,:,:),NBUDGET_TH,'CEDS_BU_RTH')
- IF (LBUDGET_RV) CALL BUDGET (PRVS(:,:,:) * PRHODJ(:,:,:),NBUDGET_RV,'CEDS_BU_RRV')
- IF (LBUDGET_RC) CALL BUDGET (PRCS(:,:,:) * PRHODJ(:,:,:),NBUDGET_RC,'CEDS_BU_RRC')
- IF (LBUDGET_RI) CALL BUDGET (PRIS(:,:,:) * PRHODJ(:,:,:),NBUDGET_RI,'CEDS_BU_RRI')
- IF (LBUDGET_SV) THEN
- CALL BUDGET (PCCS(:,:,:) * PRHODJ(:,:,:),NBUDGET_SV1-1+NSV_LIMA_NC,'CEDS_BU_RSV') ! RCC
- CALL BUDGET (PCIS(:,:,:) * PRHODJ(:,:,:),NBUDGET_SV1-1+NSV_LIMA_NI,'CEDS_BU_RSV') ! RCI
- IF (NMOD_CCN .GE. 1) THEN
- DO JL = 1, NMOD_CCN
- CALL BUDGET (PNFS(:,:,:,JL)*PRHODJ(:,:,:),NBUDGET_SV1-1+NSV_LIMA_CCN_FREE+JL-1,'CEDS_BU_RSV') ! RCC
- END DO
- END IF
- IF (NMOD_IFN .GE. 1) THEN
- DO JL = 1, NMOD_IFN
- CALL BUDGET (PIFS(:,:,:,JL)*PRHODJ(:,:,:),NBUDGET_SV1-1+NSV_LIMA_IFN_FREE+JL-1,'CEDS_BU_RSV') ! RCC
- END DO
- END IF
- END IF
-END IF
+if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'CEDS', pths(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rv ) call Budget_store_end( tbudgets(NBUDGET_RV), 'CEDS', prvs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'CEDS', prcs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'CEDS', pris(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'CEDS', pccs(:, :, :) * prhodj(:, :, :) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'CEDS', pcis(:, :, :) * prhodj(:, :, :) )
+ if ( lwarm ) then
+ do jl = 1, nmod_ccn
+ idx = NBUDGET_SV1 - 1 + nsv_lima_ccn_free - 1 + jl
+ call Budget_store_end( tbudgets(idx), 'CEDS', pnfs(:, :, :, jl) * prhodj(:, :, :) )
+ end do
+ end if
+ if ( lcold ) then
+ do jl = 1, nmod_ifn
+ idx = NBUDGET_SV1 - 1 + nsv_lima_ifn_free - 1 + jl
+ call Budget_store_end( tbudgets(idx), 'CEDS', pifs(:, :, :, jl) * prhodj(:, :, :) )
+ end do
+ end if
+ end if
+end if
!++cb++
IF (ALLOCATED(PNFS)) DEALLOCATE(PNFS)
IF (ALLOCATED(PNAS)) DEALLOCATE(PNAS)
diff --git a/src/MNH/lima_cold.f90 b/src/MNH/lima_cold.f90
index 587d2712dee644134ef166a7e8021a5bb42a0b5a..5f6267f227843fec7a58db0290e25f8d85c7c308 100644
--- a/src/MNH/lima_cold.f90
+++ b/src/MNH/lima_cold.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 2013-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2013-2020 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.
@@ -106,24 +106,28 @@ END MODULE MODI_LIMA_COLD
!! MODIFICATIONS
!! -------------
!! Original ??/??/13
-!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
-!!
+! P. Wautelet 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet 02/2020: use the new data structures and subroutines for budgets (no more budget calls in this subroutine)
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
+
+use modd_budget, only: lbu_enable, &
+ lbudget_ri, lbudget_rs, lbudget_rg, lbudget_rh, lbudget_sv, &
+ NBUDGET_RI, NBUDGET_RS, NBUDGET_RG, NBUDGET_RH, NBUDGET_SV1, &
+ tbudgets
USE MODD_NSV
USE MODD_PARAM_LIMA
-!
-USE MODD_BUDGET
-USE MODI_BUDGET
-!
+
+use mode_budget, only: Budget_store_init, Budget_store_end
+
+USE MODI_LIMA_COLD_HOM_NUCL
USE MODI_LIMA_COLD_SEDIMENTATION
+USE MODI_LIMA_COLD_SLOW_PROCESSES
USE MODI_LIMA_MEYERS
USE MODI_LIMA_PHILLIPS
-USE MODI_LIMA_COLD_HOM_NUCL
-USE MODI_LIMA_COLD_SLOW_PROCESSES
-!
+
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
@@ -301,6 +305,15 @@ END IF
!* 1. COMPUTE THE SEDIMENTATION (RS) SOURCE
! -------------------------------------
!
+if ( lbu_enable ) then
+ if ( lbudget_ri .and. osedi ) call Budget_store_init( tbudgets(NBUDGET_RI), 'SEDI', pris(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rs .and. lsnow ) call Budget_store_init( tbudgets(NBUDGET_RS), 'SEDI', prss(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rg .and. lsnow ) call Budget_store_init( tbudgets(NBUDGET_RG), 'SEDI', prgs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rh .and. lhail ) call Budget_store_init( tbudgets(NBUDGET_RH), 'SEDI', prhs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_sv .and. osedi ) &
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'SEDI', pcis(:, :, :) * prhodj(:, :, :) )
+end if
+
CALL LIMA_COLD_SEDIMENTATION (OSEDI, KSPLITG, PTSTEP, KMI, &
PZZ, PRHODJ, PRHODREF, &
PRIT, PCIT, &
@@ -308,15 +321,14 @@ CALL LIMA_COLD_SEDIMENTATION (OSEDI, KSPLITG, PTSTEP, KMI, &
PINPRS, PINPRG,&
PINPRH )
-IF (LBU_ENABLE) THEN
- IF (LBUDGET_RI .AND. OSEDI) CALL BUDGET (PRIS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RI,'SEDI_BU_RRI')
- IF (LBUDGET_RS .AND. LSNOW) CALL BUDGET (PRSS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RS,'SEDI_BU_RRS')
- IF (LBUDGET_RG .AND. LSNOW) CALL BUDGET (PRGS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RG,'SEDI_BU_RRG')
- IF (LBUDGET_RH .AND. LHAIL) CALL BUDGET (PRHS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RH,'SEDI_BU_RRH')
- IF (LBUDGET_SV) THEN
- IF (OSEDI) CALL BUDGET (PCIS(:,:,:)*PRHODJ(:,:,:),NBUDGET_SV1-1+NSV_LIMA_NI,'SEDI_BU_RSV') ! RCI
- END IF
-END IF
+if ( lbu_enable ) then
+ if ( lbudget_ri .and. osedi ) call Budget_store_end( tbudgets(NBUDGET_RI), 'SEDI', pris(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rs .and. lsnow ) call Budget_store_end( tbudgets(NBUDGET_RS), 'SEDI', prss(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rg .and. lsnow ) call Budget_store_end( tbudgets(NBUDGET_RG), 'SEDI', prgs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rh .and. lhail ) call Budget_store_end( tbudgets(NBUDGET_RH), 'SEDI', prhs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_sv .and. osedi ) &
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'SEDI', pcis(:, :, :) * prhodj(:, :, :) )
+end if
!-------------------------------------------------------------------------------
!
!
diff --git a/src/MNH/lima_cold_hom_nucl.f90 b/src/MNH/lima_cold_hom_nucl.f90
index 3882ac276498816b8576e3dc9db19e3a769a138a..c8d64a8929768895a32a15f2ad1753ba2a1b0e7f 100644
--- a/src/MNH/lima_cold_hom_nucl.f90
+++ b/src/MNH/lima_cold_hom_nucl.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 2013-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2013-2020 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.
@@ -92,13 +92,16 @@ END MODULE MODI_LIMA_COLD_HOM_NUCL
!! B.Vie 10/2016 Bug zero division
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90
-!
+! P. Wautelet 03/2020: use the new data structures and subroutines for budgets
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_BUDGET
+use modd_budget, only: lbu_enable, nbumod, &
+ lbudget_th, lbudget_rv, lbudget_rc, lbudget_rr, lbudget_ri, lbudget_rg, lbudget_sv, &
+ NBUDGET_TH, NBUDGET_RV, NBUDGET_RC, NBUDGET_RR, NBUDGET_RI, NBUDGET_RG, NBUDGET_SV1, &
+ tbudgets
USE MODD_CST, ONLY: XP00, XRD, XRV, XMV, XMD, XCPD, XCPV, XCL, XCI, &
XTT, XLSTT, XLVTT, XALPI, XBETAI, XGAMI, &
XG
@@ -112,11 +115,10 @@ USE MODD_PARAM_LIMA_COLD, ONLY: XRCOEF_HONH, XCEXP_DIFVAP_HONH, XCOEF_DIFVAP_HON
XC_HONC, XTEXP1_HONC, XTEXP2_HONC, XTEXP3_HONC, &
XTEXP4_HONC, XTEXP5_HONC
USE MODD_PARAM_LIMA_WARM, ONLY: XLBC
-!
+
+use mode_budget, only: Budget_store_init, Budget_store_end
use mode_tools, only: Countjv
-!
-USE MODI_BUDGET
-!
+
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
@@ -222,6 +224,7 @@ INTEGER :: IIB, IIE, IJB, IJE, IKB, IKE ! Physical domain
INTEGER :: JL, JMOD_CCN, JMOD_IMM ! Loop index
!
INTEGER :: INEGT ! Case number of hom. nucleation
+integer :: idx
LOGICAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) &
:: GNEGT ! Test where to compute the hom. nucleation
INTEGER , DIMENSION(SIZE(GNEGT)) :: I1,I2,I3 ! Used to replace the COUNT
@@ -355,6 +358,21 @@ IF (INEGT.GT.0) THEN
!* 2. Haze homogeneous freezing
! ------------------------
!
+ if ( nbumod == kmi .and. lbu_enable .and. ohhoni .and. nmod_ccn > 0 ) then
+ if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'HONH', pths(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rv ) call Budget_store_init( tbudgets(NBUDGET_RV), 'HONH', prvs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'HONH', pris(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'HONH', pcis(:, :, :) * prhodj(:, :, :) )
+ if ( nmod_ccn > 0 ) then
+ do jl = 1, nmod_ccn
+ idx = NBUDGET_SV1 - 1 + nsv_lima_ccn_free - 1 + jl
+ call Budget_store_init( tbudgets(idx), 'HONH', pnfs(:, :, :, jl) * prhodj(:, :, :) )
+ end do
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_hom_haze), 'HONH', znhs(:, :, :) * prhodj(:, :, :) )
+ end if
+ end if
+ end if
!
! Compute the haze homogeneous nucleation source: RHHONI
!
@@ -446,31 +464,27 @@ IF (INEGT.GT.0) THEN
END IF ! OHHONI
!
! Budget storage
- IF (NBUMOD==KMI .AND. LBU_ENABLE .AND. OHHONI .AND. NMOD_CCN.GT.0 ) THEN
- IF (LBUDGET_TH) CALL BUDGET ( &
- UNPACK(ZTHS(:),MASK=GNEGT(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:),&
- NBUDGET_TH,'HONH_BU_RTH')
- IF (LBUDGET_RV) CALL BUDGET ( &
- UNPACK(ZRVS(:),MASK=GNEGT(:,:,:),FIELD=PRVS)*PRHODJ(:,:,:),&
- NBUDGET_RV,'HONH_BU_RRV')
- IF (LBUDGET_RI) CALL BUDGET ( &
- UNPACK(ZRIS(:),MASK=GNEGT(:,:,:),FIELD=PRIS)*PRHODJ(:,:,:),&
- NBUDGET_RI,'HONH_BU_RRI')
- IF (LBUDGET_SV) THEN
- CALL BUDGET ( UNPACK(ZCIS(:),MASK=GNEGT(:,:,:),FIELD=PCIS)*PRHODJ(:,:,:),&
- NBUDGET_SV1-1+NSV_LIMA_NI,'HONH_BU_RSV') ! RCI
- IF (NMOD_CCN.GE.1) THEN
- DO JL=1, NMOD_CCN
- CALL BUDGET ( UNPACK(ZNFS(:,JL),MASK=GNEGT(:,:,:),FIELD=PNFS(:,:,:,JL))*PRHODJ(:,:,:),&
- NBUDGET_SV1-1+NSV_LIMA_CCN_FREE+JL-1,'HONH_BU_RSV')
- END DO
- CALL BUDGET ( UNPACK(ZZNHS(:),MASK=GNEGT(:,:,:),FIELD=ZNHS(:,:,:))*PRHODJ(:,:,:),&
- NBUDGET_SV1-1+NSV_LIMA_HOM_HAZE,'HONH_BU_RSV')
-
- END IF
- END IF
- END IF
-!
+ if ( nbumod == kmi .and. lbu_enable .and. ohhoni .and. nmod_ccn > 0 ) then
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'HONH', &
+ Unpack( zths(:), mask = gnegt(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rv ) call Budget_store_end( tbudgets(NBUDGET_RV), 'HONH', &
+ Unpack( zrvs(:), mask = gnegt(:, :, :), field = prvs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'HONH', &
+ Unpack( zris(:), mask = gnegt(:, :, :), field = pris(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'HONH', &
+ Unpack( zcis(:), mask = gnegt(:, :, :), field = pcis(:, :, :) ) * prhodj(:, :, :) )
+ if ( nmod_ccn > 0 ) then
+ do jl = 1, nmod_ccn
+ idx = NBUDGET_SV1 - 1 + nsv_lima_ccn_free - 1 + jl
+ call Budget_store_end( tbudgets(idx), 'HONH', &
+ Unpack( znfs(:, jl), mask = gnegt(:, :, :), field = pnfs(:, :, :, jl) ) * prhodj(:, :, :) )
+ end do
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_hom_haze), 'HONH', &
+ Unpack( zznhs(:), mask = gnegt(:, :, :), field = znhs(:, :, :) ) * prhodj(:, :, :) )
+ end if
+ end if
+ end if
!
!-------------------------------------------------------------------------------
!
@@ -483,6 +497,19 @@ IF (INEGT.GT.0) THEN
! -> Pruppacher(1995)
!
IF (LWARM) THEN
+ if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'HONC', &
+ Unpack( zths(:), mask = gnegt(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'HONC', prcs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'HONC', &
+ Unpack( zris(:), mask = gnegt(:, :, :), field = pris(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'HONC', pccs(:, :, :) * prhodj(:, :, :) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'HONC', &
+ Unpack( zcis(:), mask = gnegt(:, :, :), field = pcis(:, :, :) ) * prhodj(:, :, :) )
+ end if
+ end if
+
ZZW(:) = 0.0
ZZX(:) = 0.0
WHERE( (ZZT(:)<XTT-35.0) .AND. (ZCCT(:)>XCTMIN(2)) .AND. (ZRCT(:)>XRTMIN(2)) )
@@ -505,23 +532,20 @@ IF (LWARM) THEN
END WHERE
!
! Budget storage
- IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
- IF (LBUDGET_TH) CALL BUDGET ( &
- UNPACK(ZTHS(:),MASK=GNEGT(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:),&
- NBUDGET_TH,'HONC_BU_RTH')
- IF (LBUDGET_RC) CALL BUDGET ( &
- UNPACK(ZRCS(:),MASK=GNEGT(:,:,:),FIELD=PRCS)*PRHODJ(:,:,:),&
- NBUDGET_RC,'HONC_BU_RRC')
- IF (LBUDGET_RI) CALL BUDGET ( &
- UNPACK(ZRIS(:),MASK=GNEGT(:,:,:),FIELD=PRIS)*PRHODJ(:,:,:),&
- NBUDGET_RI,'HONC_BU_RRI')
- IF (LBUDGET_SV) THEN
- CALL BUDGET ( UNPACK(ZCCS(:),MASK=GNEGT(:,:,:),FIELD=PCCS)*PRHODJ(:,:,:),&
- NBUDGET_SV1-1+NSV_LIMA_NC,'HONC_BU_RSV')
- CALL BUDGET ( UNPACK(ZCIS(:),MASK=GNEGT(:,:,:),FIELD=PCIS)*PRHODJ(:,:,:),&
- NBUDGET_SV1-1+NSV_LIMA_NI,'HONC_BU_RSV')
- END IF
- END IF
+ if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'HONC', &
+ Unpack( zths(:), mask = gnegt(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'HONC', &
+ Unpack( zrcs(:), mask = gnegt(:, :, :), field = prcs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'HONC', &
+ Unpack( zris(:), mask = gnegt(:, :, :), field = pris(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'HONC', &
+ Unpack( zccs(:), mask = gnegt(:, :, :), field = pccs(:, :, :) ) * prhodj(:, :, :) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'HONC', &
+ Unpack( zcis(:), mask = gnegt(:, :, :), field = pcis(:, :, :) ) * prhodj(:, :, :) )
+ end if
+ end if
END IF
!
!
@@ -535,6 +559,16 @@ END IF
! Compute the drop homogeneous nucleation source: RRHONG
!
IF (LWARM .AND. LRAIN) THEN
+ if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'HONR', &
+ Unpack( zths(:), mask = gnegt(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'HONR', prrs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_init( tbudgets(NBUDGET_RG), 'HONR', prgs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'HONR', pcrs(:, :, :) * prhodj(:, :, :) )
+ end if
+ end if
+
ZZW(:) = 0.0
WHERE( (ZZT(:)<XTT-35.0) .AND. (ZRRS(:)>XRTMIN(3)/PTSTEP) )
ZZW(:) = ZRRS(:) ! Instantaneous freezing of the raindrops
@@ -546,21 +580,18 @@ IF (LWARM .AND. LRAIN) THEN
ENDWHERE
!
! Budget storage
- IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
- IF (LBUDGET_TH) CALL BUDGET ( &
- UNPACK(ZTHS(:),MASK=GNEGT(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:),&
- NBUDGET_TH,'HONR_BU_RTH')
- IF (LBUDGET_RR) CALL BUDGET ( &
- UNPACK(ZRRS(:),MASK=GNEGT(:,:,:),FIELD=PRRS)*PRHODJ(:,:,:),&
- NBUDGET_RR,'HONR_BU_RRR')
- IF (LBUDGET_RG) CALL BUDGET ( &
- UNPACK(ZRGS(:),MASK=GNEGT(:,:,:),FIELD=PRGS)*PRHODJ(:,:,:),&
- NBUDGET_RG,'HONR_BU_RRG')
- IF (LBUDGET_SV) THEN
- CALL BUDGET ( UNPACK(ZCRS(:),MASK=GNEGT(:,:,:),FIELD=PCRS)*PRHODJ(:,:,:),&
- NBUDGET_SV1-1+NSV_LIMA_NR,'HONR_BU_RSV')
- END IF
- END IF
+ if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'HONR', &
+ Unpack( zths(:), mask = gnegt(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'HONR', &
+ Unpack( zrrs(:), mask = gnegt(:, :, :), field = prrs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG), 'HONR', &
+ Unpack( zrgs(:), mask = gnegt(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'HONR', &
+ Unpack( zcrs(:), mask = gnegt(:, :, :), field = pcrs(:, :, :) ) * prhodj(:, :, :) )
+ end if
+ end if
END IF
!
!
@@ -632,57 +663,6 @@ END IF
DEALLOCATE(ZZX)
DEALLOCATE(ZZY)
!
-ELSE
-!
-! Advance the budget calls
-!
- IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
- IF (LBUDGET_TH) THEN
- ZW(:,:,:) = PTHS(:,:,:)*PRHODJ(:,:,:)
- IF( OHHONI .AND. NMOD_CCN.GT.0 ) CALL BUDGET (ZW,NBUDGET_TH,'HONH_BU_RTH')
- IF (LWARM) CALL BUDGET (ZW,NBUDGET_TH,'HONC_BU_RTH')
- IF (LWARM .AND. LRAIN) CALL BUDGET (ZW,NBUDGET_TH,'HONR_BU_RTH')
- ENDIF
- IF (LBUDGET_RV) THEN
- ZW(:,:,:) = PRVS(:,:,:)*PRHODJ(:,:,:)
- IF( OHHONI .AND. NMOD_CCN.GT.0 ) CALL BUDGET (ZW,NBUDGET_RV,'HONH_BU_RRV')
- ENDIF
- IF (LBUDGET_RC) THEN
- ZW(:,:,:) = PRCS(:,:,:)*PRHODJ(:,:,:)
- IF (LWARM) CALL BUDGET (ZW,NBUDGET_RC,'HONC_BU_RRC')
- ENDIF
- IF (LBUDGET_RR) THEN
- ZW(:,:,:) = PRRS(:,:,:)*PRHODJ(:,:,:)
- IF (LWARM .AND. LRAIN) CALL BUDGET (ZW,NBUDGET_RR,'HONR_BU_RRR')
- ENDIF
- IF (LBUDGET_RI) THEN
- ZW(:,:,:) = PRIS(:,:,:)*PRHODJ(:,:,:)
- IF( OHHONI .AND. NMOD_CCN.GT.0 ) CALL BUDGET (ZW,NBUDGET_RI,'HONH_BU_RRI')
- IF (LWARM) CALL BUDGET (ZW,NBUDGET_RI,'HONC_BU_RRI')
- ENDIF
- IF (LBUDGET_RG) THEN
- ZW(:,:,:) = PRGS(:,:,:)*PRHODJ(:,:,:)
- IF (LWARM .AND. LRAIN) CALL BUDGET (ZW,NBUDGET_RG,'HONR_BU_RRG')
- ENDIF
- IF (LBUDGET_SV) THEN
- ZW(:,:,:) = PCCS(:,:,:)*PRHODJ(:,:,:)
- IF (LWARM) CALL BUDGET (ZW,NBUDGET_SV1-1+NSV_LIMA_NC,'HONC_BU_RSV')
- ZW(:,:,:) = PCRS(:,:,:)*PRHODJ(:,:,:)
- IF (LWARM .AND. LRAIN) CALL BUDGET (ZW,NBUDGET_SV1-1+NSV_LIMA_NR,'HONR_BU_RSV')
- ZW(:,:,:) = PCIS(:,:,:)*PRHODJ(:,:,:)
- IF( OHHONI .AND. NMOD_CCN.GT.0 ) CALL BUDGET (ZW,NBUDGET_SV1-1+NSV_LIMA_NI,'HONH_BU_RSV')
- IF (LWARM) CALL BUDGET (ZW,NBUDGET_SV1-1+NSV_LIMA_NI,'HONC_BU_RSV')
- IF( OHHONI .AND. NMOD_CCN.GT.0 ) THEN
- DO JL=1, NMOD_CCN
- ZW(:,:,:) = PNFS(:,:,:,JL)*PRHODJ(:,:,:)
- CALL BUDGET (ZW,NBUDGET_SV1-1+NSV_LIMA_CCN_FREE+JL-1,'HONH_BU_RSV')
- END DO
- ZW(:,:,:) = ZNHS(:,:,:)*PRHODJ(:,:,:)
- CALL BUDGET (ZW,NBUDGET_SV1-1+NSV_LIMA_HOM_HAZE,'HONH_BU_RSV')
- END IF
- END IF
- END IF
-!
END IF ! INEGT>0
!
!
diff --git a/src/MNH/lima_cold_slow_processes.f90 b/src/MNH/lima_cold_slow_processes.f90
index 53cdf53a797c73540601e2b6a78efd713c6ff577..d0f7b3c8bff45779090f75e6849ee68dc2f9e89d 100644
--- a/src/MNH/lima_cold_slow_processes.f90
+++ b/src/MNH/lima_cold_slow_processes.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 2013-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2013-2020 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.
@@ -77,15 +77,18 @@ END MODULE MODI_LIMA_COLD_SLOW_PROCESSES
!! -------------
!! Original ??/??/13
!! C. Barthe * LACy * jan. 2014 add budgets
-!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+! P.Wautelet 05/2016-04/2018: new data structures and calls for I/O
! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90
-!
+! P. Wautelet 03/2020: use the new data structures and subroutines for budgets
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_BUDGET
+use modd_budget, only: lbu_enable, nbumod, &
+ lbudget_th, lbudget_rv, lbudget_ri, lbudget_rs, lbudget_sv, &
+ NBUDGET_TH, NBUDGET_RV, NBUDGET_RI, NBUDGET_RS, NBUDGET_SV1, &
+ tbudgets
USE MODD_CST, ONLY: XP00, XRD, XRV, XMV, XMD, XCPD, XCPV, &
XCL, XCI, XTT, XLSTT, XALPI, XBETAI, XGAMI
USE MODD_NSV, ONLY: NSV_LIMA_NI
@@ -101,10 +104,9 @@ USE MODD_PARAM_LIMA_COLD, ONLY: XLBI, XLBEXI, XLBS, XLBEXS, XBI, XCXS, XCCS, &
XCOLEXIS, XAGGS_CLARGE1, XAGGS_CLARGE2, &
XAGGS_RLARGE1, XAGGS_RLARGE2
+use mode_budget, only: Budget_store_init, Budget_store_end
use mode_tools, only: Countjv
-USE MODI_BUDGET
-!
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
@@ -332,7 +334,13 @@ IF( IMICRO >= 1 ) THEN
!* 2.1 Conversion of snow to r_i: RSCNVI
! ----------------------------------------
!
-!
+ if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'CNVI', pris(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rs ) call Budget_store_init( tbudgets(NBUDGET_RS), 'CNVI', prss(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_sv ) &
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'CNVI', pcis(:, :, :) * prhodj(:, :, :) )
+ end if
+
WHERE ( ZRST(:)>XRTMIN(5) )
ZLBDAS(:) = MIN( XLBDAS_MAX, &
XLBS*( ZRHODREF(:)*MAX( ZRST(:),XRTMIN(5) ) )**XLBEXS )
@@ -353,23 +361,26 @@ IF( IMICRO >= 1 ) THEN
END WHERE
!
! Budget storage
- IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
- IF (LBUDGET_RI) CALL BUDGET ( &
- UNPACK(ZRIS(:),MASK=GMICRO(:,:,:),FIELD=PRIS)*PRHODJ(:,:,:),&
- NBUDGET_RI,'CNVI_BU_RRI')
- IF (LBUDGET_RS) CALL BUDGET ( &
- UNPACK(ZRSS(:),MASK=GMICRO(:,:,:),FIELD=PRSS)*PRHODJ(:,:,:),&
- NBUDGET_RS,'CNVI_BU_RRS')
- IF (LBUDGET_SV) CALL BUDGET ( &
- UNPACK(ZCIS(:),MASK=GMICRO(:,:,:),FIELD=PCIS)*PRHODJ(:,:,:), &
- NBUDGET_SV1-1+NSV_LIMA_NI,'CNVI_BU_RSV')
- END IF
+ if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'CNVI', &
+ Unpack( zris(:), mask = gmicro(:, :, :), field = pris(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rs ) call Budget_store_end( tbudgets(NBUDGET_RS), 'CNVI', &
+ Unpack( zrss(:), mask = gmicro(:, :, :), field = prss(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'CNVI', &
+ Unpack( zcis(:), mask = gmicro(:, :, :), field = pcis(:, :, :) ) * prhodj(:, :, :) )
+ end if
!
!
!* 2.2 Deposition of water vapor on r_s: RVDEPS
! -----------------------------------------------
!
-!
+ if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'DEPS', pths(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rv ) call Budget_store_init( tbudgets(NBUDGET_RV), 'DEPS', prvs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rs ) call Budget_store_init( tbudgets(NBUDGET_RS), 'DEPS', &
+ Unpack( zrss(:), mask = gmicro(:, :, :), field = prss(:, :, :) ) * prhodj(:, :, :) )
+ end if
+
ZZW(:) = 0.0
WHERE ( (ZRST(:)>XRTMIN(5)) .AND. (ZRSS(:)>ZRTMIN(5)) )
ZZW(:) = ( ZSSI(:)/(ZRHODREF(:)*ZAI(:)) ) * &
@@ -382,23 +393,27 @@ IF( IMICRO >= 1 ) THEN
END WHERE
!
! Budget storage
- IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
- IF (LBUDGET_TH) CALL BUDGET ( &
- UNPACK(ZTHS(:),MASK=GMICRO(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:),&
- NBUDGET_TH,'DEPS_BU_RTH')
- IF (LBUDGET_RV) CALL BUDGET ( &
- UNPACK(ZRVS(:),MASK=GMICRO(:,:,:),FIELD=PRVS)*PRHODJ(:,:,:),&
- NBUDGET_RV,'DEPS_BU_RRV')
- IF (LBUDGET_RS) CALL BUDGET ( &
- UNPACK(ZRSS(:),MASK=GMICRO(:,:,:),FIELD=PRSS)*PRHODJ(:,:,:),&
- NBUDGET_RS,'DEPS_BU_RRS')
- END IF
-!
+ if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'DEPS', &
+ Unpack( zths(:), mask = gmicro(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rv ) call Budget_store_end( tbudgets(NBUDGET_RV), 'DEPS', &
+ Unpack( zrvs(:), mask = gmicro(:, :, :), field = prvs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rs ) call Budget_store_end( tbudgets(NBUDGET_RS), 'DEPS', &
+ Unpack( zrss(:), mask = gmicro(:, :, :), field = prss(:, :, :) ) * prhodj(:, :, :) )
+ end if
!
!* 2.3 Conversion of pristine ice to r_s: RICNVS
! ------------------------------------------------
!
-!
+ if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'CNVS', &
+ Unpack( zris(:), mask = gmicro(:, :, :), field = pris(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rs ) call Budget_store_init( tbudgets(NBUDGET_RS), 'CNVS', &
+ Unpack( zrss(:), mask = gmicro(:, :, :), field = prss(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'CNVS', &
+ Unpack( zcis(:), mask = gmicro(:, :, :), field = pcis(:, :, :) ) * prhodj(:, :, :) )
+ end if
+
ZZW(:) = 0.0
WHERE ( (ZLBDAI(:)<XLBDAICNVS_LIM) .AND. (ZCIT(:)>XCTMIN(4)) &
.AND. (ZSSI(:)>0.0) )
@@ -418,23 +433,28 @@ IF( IMICRO >= 1 ) THEN
END WHERE
!
! Budget storage
- IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
- IF (LBUDGET_RI) CALL BUDGET ( &
- UNPACK(ZRIS(:),MASK=GMICRO(:,:,:),FIELD=PRIS)*PRHODJ(:,:,:),&
- NBUDGET_RI,'CNVS_BU_RRI')
- IF (LBUDGET_RS) CALL BUDGET ( &
- UNPACK(ZRSS(:),MASK=GMICRO(:,:,:),FIELD=PRSS)*PRHODJ(:,:,:),&
- NBUDGET_RS,'CNVS_BU_RRS')
- IF (LBUDGET_SV) CALL BUDGET ( &
- UNPACK(ZCIS(:),MASK=GMICRO(:,:,:),FIELD=PCIS)*PRHODJ(:,:,:), &
- NBUDGET_SV1-1+NSV_LIMA_NI,'CNVS_BU_RSV')
- END IF
+ if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'CNVS', &
+ Unpack( zris(:), mask = gmicro(:, :, :), field = pris(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rs ) call Budget_store_end( tbudgets(NBUDGET_RS), 'CNVS', &
+ Unpack( zrss(:), mask = gmicro(:, :, :), field = prss(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'CNVS', &
+ Unpack( zcis(:), mask = gmicro(:, :, :), field = pcis(:, :, :) ) * prhodj(:, :, :) )
+ end if
!
!
!* 2.4 Aggregation of r_i on r_s: CIAGGS and RIAGGS
! ---------------------------------------------------
!
-!
+ if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'AGGS', &
+ Unpack( zris(:), mask = gmicro(:, :, :), field = pris(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rs ) call Budget_store_init( tbudgets(NBUDGET_RS), 'AGGS', &
+ Unpack( zrss(:), mask = gmicro(:, :, :), field = prss(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'AGGS', &
+ Unpack( zcis(:), mask = gmicro(:, :, :), field = pcis(:, :, :) ) * prhodj(:, :, :) )
+ end if
+
WHERE ( (ZRIT(:)>XRTMIN(4)) .AND. (ZRST(:)>XRTMIN(5)) .AND. (ZRIS(:)>ZRTMIN(4)) &
.AND. (ZCIS(:)>ZCTMIN(4)) )
ZZW1(:,3) = (ZLBDAI(:) / ZLBDAS(:))**3
@@ -450,19 +470,14 @@ IF( IMICRO >= 1 ) THEN
END WHERE
!
! Budget storage
- IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
- IF (LBUDGET_RI) CALL BUDGET ( &
- UNPACK(ZRIS(:),MASK=GMICRO(:,:,:),FIELD=PRIS)*PRHODJ(:,:,:), &
- NBUDGET_RI,'AGGS_BU_RRI')
- IF (LBUDGET_RS) CALL BUDGET ( &
- UNPACK(ZRSS(:),MASK=GMICRO(:,:,:),FIELD=PRSS)*PRHODJ(:,:,:), &
- NBUDGET_RS,'AGGS_BU_RRS')
- IF (LBUDGET_SV) CALL BUDGET ( &
- UNPACK(ZCIS(:),MASK=GMICRO(:,:,:),FIELD=PCIS)*PRHODJ(:,:,:), &
- NBUDGET_SV1-1+NSV_LIMA_NI,'AGGS_BU_RSV')
- END IF
-!
-!
+ if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'AGGS', &
+ Unpack( zris(:), mask = gmicro(:, :, :), field = pris(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rs ) call Budget_store_end( tbudgets(NBUDGET_RS), 'AGGS', &
+ Unpack( zrss(:), mask = gmicro(:, :, :), field = prss(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'AGGS', &
+ Unpack( zcis(:), mask = gmicro(:, :, :), field = pcis(:, :, :) ) * prhodj(:, :, :) )
+ end if
!------------------------------------------------------------------------------
!
!
@@ -513,41 +528,6 @@ IF( IMICRO >= 1 ) THEN
DEALLOCATE(ZZW1)
IF (NBUMOD==KMI .AND. LBU_ENABLE) DEALLOCATE(ZRHODJ)
!
-!
-ELSE
-!
-! Advance the budget calls
-!
- IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
- IF (LBUDGET_TH) THEN
- ZW(:,:,:) = PTHS(:,:,:)*PRHODJ(:,:,:)
- CALL BUDGET (ZW,NBUDGET_TH,'DEPS_BU_RTH')
- ENDIF
- IF (LBUDGET_RV) THEN
- ZW(:,:,:) = PRVS(:,:,:)*PRHODJ(:,:,:)
- CALL BUDGET (ZW,NBUDGET_RV,'DEPS_BU_RRV')
- ENDIF
- IF (LBUDGET_RI) THEN
- ZW(:,:,:) = PRIS(:,:,:)*PRHODJ(:,:,:)
- CALL BUDGET (ZW,NBUDGET_RI,'CNVI_BU_RRI')
- CALL BUDGET (ZW,NBUDGET_RI,'CNVS_BU_RRI')
- CALL BUDGET (ZW,NBUDGET_RI,'AGGS_BU_RRI')
- ENDIF
- IF (LBUDGET_RS) THEN
- ZW(:,:,:) = PRSS(:,:,:)*PRHODJ(:,:,:)
- CALL BUDGET (ZW,NBUDGET_RS,'CNVI_BU_RRS')
- CALL BUDGET (ZW,NBUDGET_RS,'DEPS_BU_RRS')
- CALL BUDGET (ZW,NBUDGET_RS,'CNVS_BU_RRS')
- CALL BUDGET (ZW,NBUDGET_RS,'AGGS_BU_RRS')
- ENDIF
- IF (LBUDGET_SV) THEN
- ZW(:,:,:) = PCIS(:,:,:)*PRHODJ(:,:,:)
- CALL BUDGET (ZW,NBUDGET_SV1-1+NSV_LIMA_NI,'CNVI_BU_RSV')
- CALL BUDGET (ZW,NBUDGET_SV1-1+NSV_LIMA_NI,'CNVS_BU_RSV')
- CALL BUDGET (ZW,NBUDGET_SV1-1+NSV_LIMA_NI,'AGGS_BU_RSV')
- ENDIF
- ENDIF
-!
END IF
!
!++cb++
diff --git a/src/MNH/lima_meyers.f90 b/src/MNH/lima_meyers.f90
index 28c90601f4520fb51071b7420fdc3e4154c8548d..04a1a18dec57bb7d7b90ccd629f12fc8c519c959 100644
--- a/src/MNH/lima_meyers.f90
+++ b/src/MNH/lima_meyers.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 2013-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2013-2020 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.
@@ -106,25 +106,27 @@ END MODULE MODI_LIMA_MEYERS
!! -------------
!! Original ??/??/13
!! C. Barthe * LACy * jan. 2014 add budgets
-!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet 05/2016-04/2018: new data structures and calls for I/O
! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90
-!
+! P. Wautelet 02/2020: use the new data structures and subroutines for budgets
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_BUDGET
+use modd_budget, only: lbu_enable, nbumod, &
+ lbudget_th, lbudget_rv, lbudget_rc, lbudget_ri, lbudget_sv, &
+ NBUDGET_TH, NBUDGET_RV, NBUDGET_RC, NBUDGET_RI, NBUDGET_SV1, &
+ tbudgets
USE MODD_CST
USE MODD_NSV, ONLY: NSV_LIMA_NC, NSV_LIMA_NI
USE MODD_PARAMETERS
USE MODD_PARAM_LIMA
USE MODD_PARAM_LIMA_COLD
+use mode_budget, only: Budget_store_init, Budget_store_end
use mode_tools, only: Countjv
-USE MODI_BUDGET
-!
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
@@ -314,6 +316,13 @@ IF( INEGT >= 1 ) THEN
!
!* compute the heterogeneous nucleation by deposition: RVHNDI
!
+ if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'HIND', pths(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rv ) call Budget_store_init( tbudgets(NBUDGET_RV), 'HIND', prvs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'HIND', pris(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'HIND', pcis(:, :, :) * prhodj(:, :, :) )
+ end if
+
DO JL=1,INEGT
ZINS(JL,1) = PINS(I1(JL),I2(JL),I3(JL),1)
END DO
@@ -338,24 +347,32 @@ IF( INEGT >= 1 ) THEN
!
!
! Budget storage
- IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
- IF (LBUDGET_TH) CALL BUDGET ( &
- UNPACK(ZTHS(:),MASK=GNEGT(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:),&
- NBUDGET_TH,'HIND_BU_RTH')
- IF (LBUDGET_RV) CALL BUDGET ( &
- UNPACK(ZRVS(:),MASK=GNEGT(:,:,:),FIELD=PRVS)*PRHODJ(:,:,:),&
- NBUDGET_RV,'HIND_BU_RRV')
- IF (LBUDGET_RI) CALL BUDGET ( &
- UNPACK(ZRIS(:),MASK=GNEGT(:,:,:),FIELD=PRIS)*PRHODJ(:,:,:),&
- NBUDGET_RI,'HIND_BU_RRI')
- IF (LBUDGET_SV) THEN
- CALL BUDGET ( UNPACK(ZCIS(:),MASK=GNEGT(:,:,:),FIELD=PCIS)*PRHODJ(:,:,:),&
- NBUDGET_SV1-1+NSV_LIMA_NI,'HIND_BU_RSV')
- END IF
- END IF
+ if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'HIND', &
+ Unpack ( zths(:), mask = gnegt(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rv ) call Budget_store_end( tbudgets(NBUDGET_RV), 'HIND', &
+ Unpack ( zrvs(:), mask = gnegt(:, :, :), field = prvs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'HIND', &
+ Unpack ( zris(:), mask = gnegt(:, :, :), field = pris(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'HIND', &
+ Unpack ( zcis(:), mask = gnegt(:, :, :), field = pcis(:, :, :) ) * prhodj(:, :, :) )
+ end if
!
!* compute the heterogeneous nucleation by contact: RVHNCI
!
+ if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'HINC', &
+ Unpack ( zths(:), mask = gnegt(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'HINC', prcs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'HINC', &
+ Unpack ( zris(:), mask = gnegt(:, :, :), field = pris(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'HINC', pccs(:, :, :) * prhodj(:, :, :) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'HINC', &
+ Unpack ( zcis(:), mask = gnegt(:, :, :), field = pcis(:, :, :) ) * prhodj(:, :, :) )
+ end if
+ end if
+
DO JL=1,INEGT
ZINS(JL,1) = PINS(I1(JL),I2(JL),I3(JL),1)
END DO
@@ -396,17 +413,16 @@ IF( INEGT >= 1 ) THEN
PCIS(:,:,:) = UNPACK( ZCIS(:),MASK=GNEGT(:,:,:),FIELD=ZW(:,:,:) )
!
! Budget storage
- IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
- IF (LBUDGET_TH) CALL BUDGET (PTHS(:,:,:)*PRHODJ(:,:,:), NBUDGET_TH,'HINC_BU_RTH')
- IF (LBUDGET_RC) CALL BUDGET (PRCS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RC,'HINC_BU_RRC')
- IF (LBUDGET_RI) CALL BUDGET (PRIS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RI,'HINC_BU_RRI')
- IF (LBUDGET_SV) THEN
- CALL BUDGET ( PCCS(:,:,:)*PRHODJ(:,:,:),NBUDGET_SV1-1+NSV_LIMA_NC,'HINC_BU_RSV')
- CALL BUDGET ( PCIS(:,:,:)*PRHODJ(:,:,:),NBUDGET_SV1-1+NSV_LIMA_NI,'HINC_BU_RSV')
- END IF
- END IF
+ if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'HINC', pths(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'HINC', prcs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'HINC', pris(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'HINC', pccs(:, :, :) * prhodj(:, :, :) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'HINC', pcis(:, :, :) * prhodj(:, :, :) )
+ end if
+ end if
-!
DEALLOCATE(ZRVT)
DEALLOCATE(ZRCT)
DEALLOCATE(ZRRT)
@@ -438,38 +454,6 @@ IF( INEGT >= 1 ) THEN
DEALLOCATE(ZLSFACT)
DEALLOCATE(ZLVFACT)
!
-ELSE
-!
-! Advance the budget calls
-!
- IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
- IF (LBUDGET_TH) THEN
- ZW(:,:,:) = PTHS(:,:,:)*PRHODJ(:,:,:)
- CALL BUDGET (ZW,NBUDGET_TH,'HIND_BU_RTH')
- CALL BUDGET (ZW,NBUDGET_TH,'HINC_BU_RTH')
- ENDIF
- IF (LBUDGET_RV) THEN
- ZW(:,:,:) = PRVS(:,:,:)*PRHODJ(:,:,:)
- CALL BUDGET (ZW,NBUDGET_RV,'HIND_BU_RRV')
- ENDIF
- IF (LBUDGET_RC) THEN
- ZW(:,:,:) = PRCS(:,:,:)*PRHODJ(:,:,:)
- CALL BUDGET (ZW,NBUDGET_RC,'HINC_BU_RRC')
- ENDIF
- IF (LBUDGET_RI) THEN
- ZW(:,:,:) = PRIS(:,:,:)*PRHODJ(:,:,:)
- CALL BUDGET (ZW,NBUDGET_RI,'HIND_BU_RRI')
- CALL BUDGET (ZW,NBUDGET_RI,'HINC_BU_RRI')
- ENDIF
- IF (LBUDGET_SV) THEN
- ZW(:,:,:) = PCCS(:,:,:)*PRHODJ(:,:,:)
- CALL BUDGET (ZW,NBUDGET_SV1-1+NSV_LIMA_NC,'HINC_BU_RSV')
- ZW(:,:,:) = PCIS(:,:,:)*PRHODJ(:,:,:)
- CALL BUDGET (ZW,NBUDGET_SV1-1+NSV_LIMA_NI,'HIND_BU_RSV')
- CALL BUDGET (ZW,NBUDGET_SV1-1+NSV_LIMA_NI,'HINC_BU_RSV')
- END IF
- END IF
-!
END IF
!
!-------------------------------------------------------------------------------
diff --git a/src/MNH/lima_meyers_nucleation.f90 b/src/MNH/lima_meyers_nucleation.f90
index bf77de46421082792eddebe764baeb569b336c5d..7798bd5d4d90d8cd81615ce516de228d55143ecb 100644
--- a/src/MNH/lima_meyers_nucleation.f90
+++ b/src/MNH/lima_meyers_nucleation.f90
@@ -76,7 +76,6 @@ END MODULE MODI_LIMA_MEYERS_NUCLEATION
!* 0. DECLARATIONS
! ------------
!
-USE MODD_BUDGET
USE MODD_CST
USE MODD_NSV, ONLY: NSV_LIMA_NC, NSV_LIMA_NI
USE MODD_PARAMETERS
@@ -85,8 +84,6 @@ USE MODD_PARAM_LIMA_COLD
use mode_tools, only: Countjv
-USE MODI_BUDGET
-!
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
@@ -170,6 +167,7 @@ REAL, DIMENSION(:), ALLOCATABLE :: ZTCELSIUS
P_TH_HIND(:,:,:) = 0.
P_RI_HIND(:,:,:) = 0.
P_CI_HIND(:,:,:) = 0.
+P_TH_HINC(:,:,:) = 0.
P_RC_HINC(:,:,:) = 0.
P_CC_HINC(:,:,:) = 0.
!
diff --git a/src/MNH/lima_mixed.f90 b/src/MNH/lima_mixed.f90
index 9f1769c818feaf831c9b414bd48654dd7420bec2..b2b7d1e2b66d4bd0688119824b658626180133de 100644
--- a/src/MNH/lima_mixed.f90
+++ b/src/MNH/lima_mixed.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 2013-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2013-2020 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.
@@ -91,14 +91,14 @@ END MODULE MODI_LIMA_MIXED
!! -------------
!! Original ??/??/13
!! C. Barthe * LACy * jan. 2014 add budgets
-!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
-!!
+! P. Wautelet 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet 03/2020: use the new data structures and subroutines for budgets (no more call to budget in this subroutine)
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_BUDGET
+use modd_budget, only: lbu_enable, nbumod
USE MODD_CST, ONLY: XP00, XRD, XRV, XMV, XMD, XCPD, XCPV, &
XCL, XCI, XTT, XLSTT, XLVTT, &
XALPI, XBETAI, XGAMI
@@ -112,10 +112,9 @@ USE MODD_PARAM_LIMA_MIXED, ONLY: XLBG, XLBEXG, XLBH, XLBEXH
use mode_tools, only: Countjv
-USE MODI_BUDGET
USE MODI_LIMA_MIXED_FAST_PROCESSES
USE MODI_LIMA_MIXED_SLOW_PROCESSES
-!
+
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
@@ -642,119 +641,6 @@ END IF
!
IF (NBUMOD==KMI .AND. LBU_ENABLE) DEALLOCATE(ZRHODJ)
!
-!
-ELSE
-!
-! Advance the budget calls
-!
- IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
- IF (LBUDGET_TH) THEN
- ZW(:,:,:) = PTHS(:,:,:)*PRHODJ(:,:,:)
- IF (LSNOW) CALL BUDGET (ZW,NBUDGET_TH,'DEPG_BU_RTH')
- CALL BUDGET (ZW,NBUDGET_TH,'IMLT_BU_RTH')
- CALL BUDGET (ZW,NBUDGET_TH,'BERFI_BU_RTH')
- IF (LSNOW) CALL BUDGET (ZW,NBUDGET_TH,'RIM_BU_RTH')
- IF (LSNOW .AND. LRAIN) CALL BUDGET (ZW,NBUDGET_TH,'ACC_BU_RTH')
- IF (LSNOW) CALL BUDGET (ZW,NBUDGET_TH,'CFRZ_BU_RTH')
- IF (LSNOW) CALL BUDGET (ZW,NBUDGET_TH,'WETG_BU_RTH')
- IF (LSNOW) CALL BUDGET (ZW,NBUDGET_TH,'DRYG_BU_RTH')
- IF (LSNOW) CALL BUDGET (ZW,NBUDGET_TH,'GMLT_BU_RTH')
- IF (LHAIL) CALL BUDGET (ZW,NBUDGET_TH,'WETH_BU_RTH')
- IF (LHAIL) CALL BUDGET (ZW,NBUDGET_TH,'HMLT_BU_RTH')
- ENDIF
- IF (LBUDGET_RV) THEN
- ZW(:,:,:) = PRVS(:,:,:)*PRHODJ(:,:,:)
- IF (LSNOW) CALL BUDGET (ZW,NBUDGET_RV,'DEPG_BU_RRV')
- ENDIF
- IF (LBUDGET_RC) THEN
- ZW(:,:,:) = PRCS(:,:,:)*PRHODJ(:,:,:)
- CALL BUDGET (ZW,NBUDGET_RC,'IMLT_BU_RRC')
- CALL BUDGET (ZW,NBUDGET_RC,'BERFI_BU_RRC')
- IF (LSNOW) CALL BUDGET (ZW,NBUDGET_RC,'RIM_BU_RRC')
- IF (LSNOW) CALL BUDGET (ZW,NBUDGET_RC,'WETG_BU_RRC')
- IF (LSNOW) CALL BUDGET (ZW,NBUDGET_RC,'DRYG_BU_RRC')
- IF (LHAIL) CALL BUDGET (ZW,NBUDGET_RC,'WETH_BU_RRC')
- ENDIF
- IF (LBUDGET_RR .AND. LRAIN) THEN
- ZW(:,:,:) = PRRS(:,:,:)*PRHODJ(:,:,:)
- IF (LSNOW .AND. LRAIN) CALL BUDGET (ZW,NBUDGET_RR,'ACC_BU_RRR')
- IF (LSNOW) CALL BUDGET (ZW,NBUDGET_RR,'CFRZ_BU_RRR')
- IF (LSNOW) CALL BUDGET (ZW,NBUDGET_RR,'WETG_BU_RRR')
- IF (LSNOW) CALL BUDGET (ZW,NBUDGET_RR,'DRYG_BU_RRR')
- IF (LSNOW) CALL BUDGET (ZW,NBUDGET_RR,'GMLT_BU_RRR')
- IF (LHAIL) CALL BUDGET (ZW,NBUDGET_RR,'WETH_BU_RRR')
- IF (LHAIL) CALL BUDGET (ZW,NBUDGET_RR,'HMLT_BU_RRR')
- ENDIF
- IF (LBUDGET_RI) THEN
- ZW(:,:,:) = PRIS(:,:,:)*PRHODJ(:,:,:)
- CALL BUDGET (ZW,NBUDGET_RI,'IMLT_BU_RRI')
- CALL BUDGET (ZW,NBUDGET_RI,'BERFI_BU_RRI')
- IF (LSNOW) CALL BUDGET (ZW,NBUDGET_RI,'HMS_BU_RRI')
- IF (LSNOW) CALL BUDGET (ZW,NBUDGET_RI,'CFRZ_BU_RRI')
- IF (LSNOW) CALL BUDGET (ZW,NBUDGET_RI,'WETG_BU_RRI')
- IF (LSNOW) CALL BUDGET (ZW,NBUDGET_RI,'DRYG_BU_RRI')
- IF (LSNOW) CALL BUDGET (ZW,NBUDGET_RI,'HMG_BU_RRI')
- IF (LHAIL) CALL BUDGET (ZW,NBUDGET_RI,'WETH_BU_RRI')
- ENDIF
- IF (LBUDGET_RS .AND. LSNOW) THEN
- ZW(:,:,:) = PRSS(:,:,:)*PRHODJ(:,:,:)
- CALL BUDGET (ZW,NBUDGET_RS,'RIM_BU_RRS')
- CALL BUDGET (ZW,NBUDGET_RS,'HMS_BU_RRS')
- IF (LRAIN) CALL BUDGET (ZW,NBUDGET_RS,'ACC_BU_RRS')
- CALL BUDGET (ZW,NBUDGET_RS,'CMEL_BU_RRS')
- CALL BUDGET (ZW,NBUDGET_RS,'WETG_BU_RRS')
- CALL BUDGET (ZW,NBUDGET_RS,'DRYG_BU_RRS')
- IF (LHAIL) CALL BUDGET (ZW,NBUDGET_RS,'WETH_BU_RRS')
- ENDIF
- IF (LBUDGET_RG .AND. LSNOW) THEN
- ZW(:,:,:) = PRGS(:,:,:)*PRHODJ(:,:,:)
- CALL BUDGET (ZW,NBUDGET_RG,'DEPG_BU_RRG')
- CALL BUDGET (ZW,NBUDGET_RG,'RIM_BU_RRG')
- IF (LRAIN) CALL BUDGET (ZW,NBUDGET_RG,'ACC_BU_RRG')
- CALL BUDGET (ZW,NBUDGET_RG,'CMEL_BU_RRG')
- CALL BUDGET (ZW,NBUDGET_RG,'CFRZ_BU_RRG')
- CALL BUDGET (ZW,NBUDGET_RG,'WETG_BU_RRG')
- CALL BUDGET (ZW,NBUDGET_RG,'DRYG_BU_RRG')
- CALL BUDGET (ZW,NBUDGET_RG,'HMG_BU_RRG')
- CALL BUDGET (ZW,NBUDGET_RG,'GMLT_BU_RRG')
- IF (LHAIL) CALL BUDGET (ZW,NBUDGET_RG,'WETH_BU_RRG')
- IF (LHAIL) CALL BUDGET (ZW,NBUDGET_RG,'COHG_BU_RRG')
- ENDIF
- IF (LBUDGET_RH .AND. LHAIL) THEN
- ZW(:,:,:) = PRHS(:,:,:)*PRHODJ(:,:,:)
- CALL BUDGET (ZW,NBUDGET_RH,'WETG_BU_RRH')
- IF (LHAIL) CALL BUDGET (ZW,NBUDGET_RH,'WETH_BU_RRH')
- IF (LHAIL) CALL BUDGET (ZW,NBUDGET_RH,'COHG_BU_RRH')
- IF (LHAIL) CALL BUDGET (ZW,NBUDGET_RH,'HMLT_BU_RRH')
- ENDIF
- IF (LBUDGET_SV) THEN
- ZW(:,:,:) = PCCS(:,:,:)*PRHODJ(:,:,:)
- CALL BUDGET (ZW,NBUDGET_SV1-1+NSV_LIMA_NC,'IMLT_BU_RSV')
- IF (LSNOW) CALL BUDGET (ZW,NBUDGET_SV1-1+NSV_LIMA_NC,'RIM_BU_RSV')
- IF (LSNOW) CALL BUDGET (ZW,NBUDGET_SV1-1+NSV_LIMA_NC,'WETG_BU_RSV')
- IF (LSNOW) CALL BUDGET (ZW,NBUDGET_SV1-1+NSV_LIMA_NC,'DRYG_BU_RSV')
- IF (LHAIL) CALL BUDGET (ZW,NBUDGET_SV1-1+NSV_LIMA_NC,'WETH_BU_RSV')
-!
- ZW(:,:,:) = PCRS(:,:,:)*PRHODJ(:,:,:)
- IF (LSNOW) CALL BUDGET (ZW,NBUDGET_SV1-1+NSV_LIMA_NR,'ACC_BU_RSV')
- IF (LSNOW) CALL BUDGET (ZW,NBUDGET_SV1-1+NSV_LIMA_NR,'CFRZ_BU_RSV')
- IF (LSNOW) CALL BUDGET (ZW,NBUDGET_SV1-1+NSV_LIMA_NR,'WETG_BU_RSV')
- IF (LSNOW) CALL BUDGET (ZW,NBUDGET_SV1-1+NSV_LIMA_NR,'DRYG_BU_RSV')
- IF (LSNOW) CALL BUDGET (ZW,NBUDGET_SV1-1+NSV_LIMA_NR,'GMLT_BU_RSV')
- IF (LHAIL) CALL BUDGET (ZW,NBUDGET_SV1-1+NSV_LIMA_NR,'WETH_BU_RSV')
- IF (LHAIL) CALL BUDGET (ZW,NBUDGET_SV1-1+NSV_LIMA_NR,'HMLT_BU_RSV')
-!
- ZW(:,:,:) = PCIS(:,:,:)*PRHODJ(:,:,:)
- CALL BUDGET (ZW,NBUDGET_SV1-1+NSV_LIMA_NI,'IMLT_BU_RSV')
- IF (LSNOW) CALL BUDGET (ZW,NBUDGET_SV1-1+NSV_LIMA_NI,'HMS_BU_RSV')
- IF (LSNOW) CALL BUDGET (ZW,NBUDGET_SV1-1+NSV_LIMA_NI,'CFRZ_BU_RSV')
- IF (LSNOW) CALL BUDGET (ZW,NBUDGET_SV1-1+NSV_LIMA_NI,'WETG_BU_RSV')
- IF (LSNOW) CALL BUDGET (ZW,NBUDGET_SV1-1+NSV_LIMA_NI,'DRYG_BU_RSV')
- IF (LSNOW) CALL BUDGET (ZW,NBUDGET_SV1-1+NSV_LIMA_NI,'HMG_BU_RSV')
- IF (LHAIL) CALL BUDGET (ZW,NBUDGET_SV1-1+NSV_LIMA_NI,'WETH_BU_RSV')
- ENDIF
- ENDIF
-!
END IF ! IMICRO >= 1
!
!------------------------------------------------------------------------------
diff --git a/src/MNH/lima_mixed_fast_processes.f90 b/src/MNH/lima_mixed_fast_processes.f90
index 09ea55a1b5a8b21bbd490edc38764c28beed8f79..09c86c8a20e23fb9cd16adb859604d1aae2c37e5 100644
--- a/src/MNH/lima_mixed_fast_processes.f90
+++ b/src/MNH/lima_mixed_fast_processes.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 2013-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2013-2020 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.
@@ -15,7 +15,7 @@ INTERFACE
ZRCS, ZRRS, ZRIS, ZRSS, ZRGS, ZRHS, &
ZTHS, ZCCS, ZCRS, ZCIS, &
ZLBDAC, ZLBDAR, ZLBDAS, ZLBDAG, ZLBDAH, &
- ZRHODJ, GMICRO, PRHODJ, KMI, PTHS, &
+ PRHODJ1D, GMICRO, PRHODJ, KMI, PTHS, &
PRCS, PRRS, PRIS, PRSS, PRGS, PRHS, &
PCCS, PCRS, PCIS )
!
@@ -62,7 +62,7 @@ REAL, DIMENSION(:), INTENT(IN) :: ZLBDAG ! Slope param of the graupel dist
REAL, DIMENSION(:), INTENT(IN) :: ZLBDAH ! Slope param of the hail distr.
!
! used for budget storage
-REAL, DIMENSION(:), INTENT(IN) :: ZRHODJ
+REAL, DIMENSION(:), INTENT(IN) :: PRHODJ1D
LOGICAL, DIMENSION(:,:,:), INTENT(IN) :: GMICRO
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ
INTEGER, INTENT(IN) :: KMI
@@ -89,7 +89,7 @@ END MODULE MODI_LIMA_MIXED_FAST_PROCESSES
ZRCS, ZRRS, ZRIS, ZRSS, ZRGS, ZRHS, &
ZTHS, ZCCS, ZCRS, ZCIS, &
ZLBDAC, ZLBDAR, ZLBDAS, ZLBDAG, ZLBDAH, &
- ZRHODJ, GMICRO, PRHODJ, KMI, PTHS, &
+ PRHODJ1D, GMICRO, PRHODJ, KMI, PTHS, &
PRCS, PRRS, PRIS, PRSS, PRGS, PRHS, &
PCCS, PCRS, PCIS )
! #######################################################################
@@ -141,21 +141,24 @@ END MODULE MODI_LIMA_MIXED_FAST_PROCESSES
!! Original ??/??/13
!! C. Barthe * LACy * jan. 2014 add budgets
! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
-!
+! P. Wautelet 03/2020: use the new data structures and subroutines for budgets
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
+use modd_budget, only: lbu_enable, nbumod, &
+ lbudget_th, lbudget_rc, lbudget_rr, lbudget_ri, lbudget_rs, lbudget_rg, lbudget_rh, lbudget_sv, &
+ NBUDGET_TH, NBUDGET_RC, NBUDGET_RR, NBUDGET_RI, NBUDGET_RS, NBUDGET_RG, NBUDGET_RH, NBUDGET_SV1, &
+ tbudgets
USE MODD_CST
+USE MODD_NSV
USE MODD_PARAM_LIMA
USE MODD_PARAM_LIMA_COLD
USE MODD_PARAM_LIMA_MIXED
-!
-USE MODD_NSV
-USE MODD_BUDGET
-USE MODI_BUDGET
-!
+
+use mode_budget, only: Budget_store_init, Budget_store_end
+
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
@@ -203,7 +206,7 @@ REAL, DIMENSION(:), INTENT(IN) :: ZLBDAG ! Slope param of the graupel dist
REAL, DIMENSION(:), INTENT(IN) :: ZLBDAH ! Slope param of the hail distr.
!
! used for budget storage
-REAL, DIMENSION(:), INTENT(IN) :: ZRHODJ
+REAL, DIMENSION(:), INTENT(IN) :: PRHODJ1D
LOGICAL, DIMENSION(:,:,:), INTENT(IN) :: GMICRO
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ
INTEGER, INTENT(IN) :: KMI
@@ -238,19 +241,30 @@ REAL :: ZTHRH, ZTHRC
! FAST RS PROCESSES
! #################
!
-IF (LSNOW) THEN
+SNOW: IF (LSNOW) THEN
!
!
!* 1.1 Cloud droplet riming of the aggregates
! -------------------------------------------
!
-!
ZZW1(:,:) = 0.0
!
GRIM(:) = (ZRCT(:)>XRTMIN(2)) .AND. (ZRST(:)>XRTMIN(5)) .AND. (ZRCS(:)>XRTMIN(2)/PTSTEP) .AND. (ZZT(:)<XTT)
IGRIM = COUNT( GRIM(:) )
!
IF( IGRIM>0 ) THEN
+ if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'RIM', &
+ Unpack( zths(:), mask = gmicro(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'RIM', &
+ Unpack( zrcs(:), mask = gmicro(:, :, :), field = prcs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rs ) call Budget_store_init( tbudgets(NBUDGET_RS), 'RIM', &
+ Unpack( zrss(:), mask = gmicro(:, :, :), field = prss(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_init( tbudgets(NBUDGET_RG), 'RIM', &
+ Unpack( zrgs(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'RIM', &
+ Unpack( zccs(:), mask = gmicro(:, :, :), field = pccs(:, :, :) ) * prhodj(:, :, :) )
+ end if
!
! 1.1.0 allocations
!
@@ -323,29 +337,22 @@ IF( IGRIM>0 ) THEN
DEALLOCATE(IVEC1)
DEALLOCATE(ZVEC2)
DEALLOCATE(ZVEC1)
+
+ ! Budget storage
+ if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'RIM', &
+ Unpack( zths(:), mask = gmicro(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'RIM', &
+ Unpack( zrcs(:), mask = gmicro(:, :, :), field = prcs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rs ) call Budget_store_end( tbudgets(NBUDGET_RS), 'RIM', &
+ Unpack( zrss(:), mask = gmicro(:, :, :), field = prss(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG), 'RIM', &
+ Unpack( zrgs(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'RIM', &
+ Unpack( zccs(:), mask = gmicro(:, :, :), field = pccs(:, :, :) ) * prhodj(:, :, :) )
+ end if
END IF
!
-! Budget storage
-IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
- IF (LBUDGET_TH) CALL BUDGET ( &
- UNPACK(ZTHS(:),MASK=GMICRO(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:), &
- NBUDGET_TH,'RIM_BU_RTH')
- IF (LBUDGET_RC) CALL BUDGET ( &
- UNPACK(ZRCS(:),MASK=GMICRO(:,:,:),FIELD=PRCS)*PRHODJ(:,:,:), &
- NBUDGET_RC,'RIM_BU_RRC')
- IF (LBUDGET_RS) CALL BUDGET ( &
- UNPACK(ZRSS(:),MASK=GMICRO(:,:,:),FIELD=PRSS)*PRHODJ(:,:,:), &
- NBUDGET_RS,'RIM_BU_RRS')
- IF (LBUDGET_RG) CALL BUDGET ( &
- UNPACK(ZRGS(:),MASK=GMICRO(:,:,:),FIELD=PRGS)*PRHODJ(:,:,:), &
- NBUDGET_RG,'RIM_BU_RRG')
- IF (LBUDGET_SV) THEN
- CALL BUDGET (UNPACK(ZCCS(:),MASK=GMICRO(:,:,:),FIELD=PCCS)*PRHODJ(:,:,:), &
- NBUDGET_SV1-1+NSV_LIMA_NC,'RIM_BU_RSV')
- END IF
-END IF
-!
-!
!* 1.2 Hallett-Mossop ice multiplication process due to snow riming
! -----------------------------------------------------------------
!
@@ -354,6 +361,16 @@ GRIM(:) = (ZZT(:)<XHMTMAX) .AND. (ZZT(:)>XHMTMIN) &
.AND. (ZRST(:)>XRTMIN(5)) .AND. (ZRCT(:)>XRTMIN(2))
IGRIM = COUNT( GRIM(:) )
IF( IGRIM>0 ) THEN
+ ! Budget storage
+ if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'HMS', &
+ Unpack( zris(:), mask = gmicro(:, :, :), field = pris(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rs ) call Budget_store_init( tbudgets(NBUDGET_RS), 'HMS', &
+ Unpack( zrss(:), mask = gmicro(:, :, :), field = prss(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'HMS', &
+ Unpack( zcis(:), mask = gmicro(:, :, :), field = pcis(:, :, :) ) * prhodj(:, :, :) )
+ end if
+
ALLOCATE(ZVEC1(IGRIM))
ALLOCATE(ZVEC2(IGRIM))
ALLOCATE(IVEC2(IGRIM))
@@ -380,19 +397,16 @@ IF( IGRIM>0 ) THEN
DEALLOCATE(IVEC2)
DEALLOCATE(ZVEC2)
DEALLOCATE(ZVEC1)
-END IF
-!
-! Budget storage
-IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
- IF (LBUDGET_RI) CALL BUDGET ( &
- UNPACK(ZRIS(:),MASK=GMICRO,FIELD=PRIS)*PRHODJ(:,:,:), &
- NBUDGET_RI,'HMS_BU_RRI')
- IF (LBUDGET_RS) CALL BUDGET ( &
- UNPACK(ZRSS(:),MASK=GMICRO,FIELD=PRSS)*PRHODJ(:,:,:), &
- NBUDGET_RS,'HMS_BU_RRS')
- IF (LBUDGET_SV) CALL BUDGET ( &
- UNPACK(ZCIS(:),MASK=GMICRO,FIELD=PCIS)*PRHODJ(:,:,:), &
- NBUDGET_SV1-1+NSV_LIMA_NI,'HMS_BU_RSV')
+
+ ! Budget storage
+ if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'HMS', &
+ Unpack( zris(:), mask = gmicro(:, :, :), field = pris(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rs ) call Budget_store_end( tbudgets(NBUDGET_RS), 'HMS', &
+ Unpack( zrss(:), mask = gmicro(:, :, :), field = prss(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'HMS', &
+ Unpack( zcis(:), mask = gmicro(:, :, :), field = pcis(:, :, :) ) * prhodj(:, :, :) )
+ end if
END IF
!
!
@@ -405,6 +419,19 @@ GACC(:) = (ZRRT(:)>XRTMIN(3)) .AND. (ZRST(:)>XRTMIN(5)) .AND. (ZRRS(:)>XRTMIN(3)
IGACC = COUNT( GACC(:) )
!
IF( IGACC>0 .AND. LRAIN) THEN
+ ! Budget storage
+ if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'ACC', &
+ Unpack( zths(:), mask = gmicro(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'ACC', &
+ Unpack( zrrs(:), mask = gmicro(:, :, :), field = prrs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rs ) call Budget_store_init( tbudgets(NBUDGET_RS), 'ACC', &
+ Unpack( zrss(:), mask = gmicro(:, :, :), field = prss(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_init( tbudgets(NBUDGET_RG), 'ACC', &
+ Unpack( zrgs(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'ACC', &
+ Unpack( zcrs(:), mask = gmicro(:, :, :), field = pcrs(:, :, :) ) * prhodj(:, :, :) )
+ end if
!
! 1.3.0 allocations
!
@@ -510,32 +537,32 @@ IF( IGACC>0 .AND. LRAIN) THEN
DEALLOCATE(ZVEC3)
DEALLOCATE(ZVEC2)
DEALLOCATE(ZVEC1)
+
+ ! Budget storage
+ if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'ACC', &
+ Unpack( zths(:), mask = gmicro(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'ACC', &
+ Unpack( zrrs(:), mask = gmicro(:, :, :), field = prrs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rs ) call Budget_store_end( tbudgets(NBUDGET_RS), 'ACC', &
+ Unpack( zrss(:), mask = gmicro(:, :, :), field = prss(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG), 'ACC', &
+ Unpack( zrgs(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'ACC', &
+ Unpack( zcrs(:), mask = gmicro(:, :, :), field = pcrs(:, :, :) ) * prhodj(:, :, :) )
+ end if
END IF
!
-IF (NBUMOD==KMI .AND. LBU_ENABLE .AND. LRAIN) THEN
- IF (LBUDGET_TH) CALL BUDGET ( &
- UNPACK(ZTHS(:),MASK=GMICRO(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:),&
- NBUDGET_TH,'ACC_BU_RTH')
- IF (LBUDGET_RR) CALL BUDGET ( &
- UNPACK(ZRRS(:),MASK=GMICRO(:,:,:),FIELD=PRRS)*PRHODJ(:,:,:), &
- NBUDGET_RR,'ACC_BU_RRR')
- IF (LBUDGET_RS) CALL BUDGET ( &
- UNPACK(ZRSS(:),MASK=GMICRO(:,:,:),FIELD=PRSS)*PRHODJ(:,:,:), &
- NBUDGET_RS,'ACC_BU_RRS')
- IF (LBUDGET_RG) CALL BUDGET ( &
- UNPACK(ZRGS(:),MASK=GMICRO(:,:,:),FIELD=PRGS)*PRHODJ(:,:,:), &
- NBUDGET_RG,'ACC_BU_RRG')
- IF (LBUDGET_SV) THEN
- CALL BUDGET (UNPACK(ZCRS(:),MASK=GMICRO(:,:,:),FIELD=PCRS)*PRHODJ(:,:,:), &
- NBUDGET_SV1-1+NSV_LIMA_NR,'ACC_BU_RSV')
- END IF
-END IF
-!
-!
!* 1.4 Conversion-Melting of the aggregates
! -----------------------------------------
!
-!
+if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_rs ) call Budget_store_init( tbudgets(NBUDGET_RS), 'CMEL', &
+ Unpack( zrss(:), mask = gmicro(:, :, :), field = prss(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_init( tbudgets(NBUDGET_RG), 'CMEL', &
+ Unpack( zrgs(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) )
+end if
+
ZZW(:) = 0.0
WHERE( (ZRST(:)>XRTMIN(5)) .AND. (ZRSS(:)>XRTMIN(5)/PTSTEP) .AND. (ZZT(:)>XTT) )
ZZW(:) = ZRVT(:)*ZPRES(:)/((XMV/XMD)+ZRVT(:)) ! Vapor pressure
@@ -560,16 +587,14 @@ WHERE( (ZRST(:)>XRTMIN(5)) .AND. (ZRSS(:)>XRTMIN(5)/PTSTEP) .AND. (ZZT(:)>XTT) )
END WHERE
!
! Budget storage
-IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
- IF (LBUDGET_RS) CALL BUDGET ( &
- UNPACK(ZRSS(:),MASK=GMICRO(:,:,:),FIELD=PRSS)*PRHODJ(:,:,:), &
- NBUDGET_RS,'CMEL_BU_RRS')
- IF (LBUDGET_RG) CALL BUDGET ( &
- UNPACK(ZRGS(:),MASK=GMICRO(:,:,:),FIELD=PRGS)*PRHODJ(:,:,:), &
- NBUDGET_RG,'CMEL_BU_RRG')
-END IF
-!
-END IF ! LSNOW
+if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_rs ) call Budget_store_end( tbudgets(NBUDGET_RS), 'CMEL', &
+ Unpack( zrss(:), mask = gmicro(:, :, :), field = prss(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG), 'CMEL', &
+ Unpack( zrgs(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) )
+end if
+
+END IF SNOW
!
!------------------------------------------------------------------------------
!
@@ -581,7 +606,21 @@ END IF ! LSNOW
!* 2.1 Rain contact freezing
! --------------------------
!
-!
+if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'CFRZ', &
+ Unpack( zths(:), mask = gmicro(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'CFRZ', &
+ Unpack( zrrs(:), mask = gmicro(:, :, :), field = prrs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'CFRZ', &
+ Unpack( zris(:), mask = gmicro(:, :, :), field = pris(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_init( tbudgets(NBUDGET_RG), 'CFRZ', &
+ Unpack( zrgs(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'CFRZ', &
+ Unpack( zcrs(:), mask = gmicro(:, :, :), field = pcrs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'CFRZ', &
+ Unpack( zcis(:), mask = gmicro(:, :, :), field = pcis(:, :, :) ) * prhodj(:, :, :) )
+end if
+
ZZW1(:,3:4) = 0.0
WHERE( (ZRIT(:)>XRTMIN(4)) .AND. (ZRRT(:)>XRTMIN(3)) .AND. (ZRIS(:)>XRTMIN(4)/PTSTEP) .AND. (ZRRS(:)>XRTMIN(3)/PTSTEP) )
ZZW1(:,3) = MIN( ZRIS(:),XICFRR * ZRIT(:) * ZCRT(:) & ! RICFRRG
@@ -599,32 +638,48 @@ WHERE( (ZRIT(:)>XRTMIN(4)) .AND. (ZRRT(:)>XRTMIN(3)) .AND. (ZRIS(:)>XRTMIN(4)/PT
ZCIS(:) = MAX( ZCIS(:)-ZZW1(:,3)*(ZCIT(:)/ZRIT(:)),0.0 ) ! CICFRRG
ZCRS(:) = MAX( ZCRS(:)-ZZW1(:,4)*(ZCRT(:)/ZRRT(:)),0.0 ) ! CRCFRIG
END WHERE
-!
-IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
- IF (LBUDGET_TH) CALL BUDGET ( &
- UNPACK(ZTHS(:),MASK=GMICRO(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:), &
- NBUDGET_TH,'CFRZ_BU_RTH')
- IF (LBUDGET_RR) CALL BUDGET ( &
- UNPACK(ZRRS(:),MASK=GMICRO(:,:,:),FIELD=PRRS)*PRHODJ(:,:,:), &
- NBUDGET_RR,'CFRZ_BU_RRR')
- IF (LBUDGET_RI) CALL BUDGET ( &
- UNPACK(ZRIS(:),MASK=GMICRO(:,:,:),FIELD=PRIS)*PRHODJ(:,:,:), &
- NBUDGET_RI,'CFRZ_BU_RRI')
- IF (LBUDGET_RG) CALL BUDGET ( &
- UNPACK(ZRGS(:),MASK=GMICRO(:,:,:),FIELD=PRGS)*PRHODJ(:,:,:), &
- NBUDGET_RG,'CFRZ_BU_RRG')
- IF (LBUDGET_SV) THEN
- CALL BUDGET ( UNPACK(ZCRS(:),MASK=GMICRO(:,:,:),FIELD=PCRS)*PRHODJ(:,:,:), &
- NBUDGET_SV1-1+NSV_LIMA_NR,'CFRZ_BU_RSV')
- CALL BUDGET ( UNPACK(ZCIS(:),MASK=GMICRO(:,:,:),FIELD=PCIS)*PRHODJ(:,:,:), &
- NBUDGET_SV1-1+NSV_LIMA_NI,'CFRZ_BU_RSV')
- END IF
-END IF
-!
+
+if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'CFRZ', &
+ Unpack( zths(:), mask = gmicro(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'CFRZ', &
+ Unpack( zrrs(:), mask = gmicro(:, :, :), field = prrs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'CFRZ', &
+ Unpack( zris(:), mask = gmicro(:, :, :), field = pris(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG), 'CFRZ', &
+ Unpack( zrgs(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'CFRZ', &
+ Unpack( zcrs(:), mask = gmicro(:, :, :), field = pcrs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'CFRZ', &
+ Unpack( zcis(:), mask = gmicro(:, :, :), field = pcis(:, :, :) ) * prhodj(:, :, :) )
+end if
!
!* 2.2 Compute the Dry growth case
! --------------------------------
-!
+if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'WETG', &
+ Unpack( zths(:), mask = gmicro(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'WETG', &
+ Unpack( zrcs(:), mask = gmicro(:, :, :), field = prcs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'WETG', &
+ Unpack( zrrs(:), mask = gmicro(:, :, :), field = prrs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'WETG', &
+ Unpack( zris(:), mask = gmicro(:, :, :), field = pris(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rs ) call Budget_store_init( tbudgets(NBUDGET_RS), 'WETG', &
+ Unpack( zrss(:), mask = gmicro(:, :, :), field = prss(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_init( tbudgets(NBUDGET_RG), 'WETG', &
+ Unpack( zrgs(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rh ) call Budget_store_init( tbudgets(NBUDGET_RH), 'WETG', &
+ Unpack( zrhs(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'WETG', &
+ Unpack( zccs(:), mask = gmicro(:, :, :), field = pccs(:, :, :) ) * prhodj(:, :, :) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'WETG', &
+ Unpack( zcrs(:), mask = gmicro(:, :, :), field = pcrs(:, :, :) ) * prhodj(:, :, :) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'WETG', &
+ Unpack( zcis(:), mask = gmicro(:, :, :), field = pcis(:, :, :) ) * prhodj(:, :, :) )
+ end if
+end if
!
ZZW1(:,:) = 0.0
WHERE( ((ZRCT(:)>XRTMIN(2)) .AND. (ZRGT(:)>XRTMIN(6)) .AND. (ZRCS(:)>XRTMIN(2)/PTSTEP)) .OR. &
@@ -836,40 +891,56 @@ WHERE( ZRGT(:)>XRTMIN(6) .AND. ZZT(:)<XTT &
END WHERE
!
! Budget storage
- IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
- IF (LBUDGET_TH) CALL BUDGET ( &
- UNPACK(ZTHS(:),MASK=GMICRO(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:),&
- NBUDGET_TH,'WETG_BU_RTH')
- IF (LBUDGET_RC) CALL BUDGET ( &
- UNPACK(ZRCS(:),MASK=GMICRO(:,:,:),FIELD=PRCS)*PRHODJ(:,:,:), &
- NBUDGET_RC,'WETG_BU_RRC')
- IF (LBUDGET_RR) CALL BUDGET ( &
- UNPACK(ZRRS(:),MASK=GMICRO(:,:,:),FIELD=PRRS)*PRHODJ(:,:,:), &
- NBUDGET_RR,'WETG_BU_RRR')
- IF (LBUDGET_RI) CALL BUDGET ( &
- UNPACK(ZRIS(:),MASK=GMICRO(:,:,:),FIELD=PRIS)*PRHODJ(:,:,:), &
- NBUDGET_RI,'WETG_BU_RRI')
- IF (LBUDGET_RS) CALL BUDGET ( &
- UNPACK(ZRSS(:),MASK=GMICRO(:,:,:),FIELD=PRSS)*PRHODJ(:,:,:), &
- NBUDGET_RS,'WETG_BU_RRS')
- IF (LBUDGET_RG) CALL BUDGET ( &
- UNPACK(ZRGS(:),MASK=GMICRO(:,:,:),FIELD=PRGS)*PRHODJ(:,:,:), &
- NBUDGET_RG,'WETG_BU_RRG')
- IF (LBUDGET_RH) CALL BUDGET ( &
- UNPACK(ZRHS(:),MASK=GMICRO(:,:,:),FIELD=PRHS)*PRHODJ(:,:,:), &
- NBUDGET_RH,'WETG_BU_RRH')
- IF (LBUDGET_SV) THEN
- CALL BUDGET (UNPACK(ZCCS(:),MASK=GMICRO(:,:,:),FIELD=PCCS)*PRHODJ(:,:,:), &
- NBUDGET_SV1-1+NSV_LIMA_NC,'WETG_BU_RSV')
- CALL BUDGET (UNPACK(ZCRS(:),MASK=GMICRO(:,:,:),FIELD=PCRS)*PRHODJ(:,:,:), &
- NBUDGET_SV1-1+NSV_LIMA_NR,'WETG_BU_RSV')
- CALL BUDGET (UNPACK(ZCIS(:),MASK=GMICRO(:,:,:),FIELD=PCIS)*PRHODJ(:,:,:), &
- NBUDGET_SV1-1+NSV_LIMA_NI,'WETG_BU_RSV')
- END IF
- END IF
+if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'WETG', &
+ Unpack( zths(:), mask = gmicro(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'WETG', &
+ Unpack( zrcs(:), mask = gmicro(:, :, :), field = prcs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'WETG', &
+ Unpack( zrrs(:), mask = gmicro(:, :, :), field = prrs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'WETG', &
+ Unpack( zris(:), mask = gmicro(:, :, :), field = pris(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rs ) call Budget_store_end( tbudgets(NBUDGET_RS), 'WETG', &
+ Unpack( zrss(:), mask = gmicro(:, :, :), field = prss(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG), 'WETG', &
+ Unpack( zrgs(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rh ) call Budget_store_end( tbudgets(NBUDGET_RH), 'WETG', &
+ Unpack( zrhs(:), mask = gmicro(:, :, :), field = prhs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'WETG', &
+ Unpack( zccs(:), mask = gmicro(:, :, :), field = pccs(:, :, :) ) * prhodj(:, :, :) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'WETG', &
+ Unpack( zcrs(:), mask = gmicro(:, :, :), field = pcrs(:, :, :) ) * prhodj(:, :, :) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'WETG', &
+ Unpack( zcis(:), mask = gmicro(:, :, :), field = pcis(:, :, :) ) * prhodj(:, :, :) )
+ end if
+end if
!
! Dry case
!
+if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'DRYG', &
+ Unpack( zths(:), mask = gmicro(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'DRYG', &
+ Unpack( zrcs(:), mask = gmicro(:, :, :), field = prcs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'DRYG', &
+ Unpack( zrrs(:), mask = gmicro(:, :, :), field = prrs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'DRYG', &
+ Unpack( zris(:), mask = gmicro(:, :, :), field = pris(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rs ) call Budget_store_init( tbudgets(NBUDGET_RS), 'DRYG', &
+ Unpack( zrss(:), mask = gmicro(:, :, :), field = prss(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_init( tbudgets(NBUDGET_RG), 'DRYG', &
+ Unpack( zrgs(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'DRYG', &
+ Unpack( zccs(:), mask = gmicro(:, :, :), field = pccs(:, :, :) ) * prhodj(:, :, :) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'DRYG', &
+ Unpack( zcrs(:), mask = gmicro(:, :, :), field = pcrs(:, :, :) ) * prhodj(:, :, :) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'DRYG', &
+ Unpack( zcis(:), mask = gmicro(:, :, :), field = pcis(:, :, :) ) * prhodj(:, :, :) )
+ end if
+end if
+
WHERE( ZRGT(:)>XRTMIN(6) .AND. ZZT(:)<XTT &
.AND. ZRDRYG(:)<ZRWETG(:) .AND. ZRDRYG(:)>0.0 ) ! case
ZRCS(:) = ZRCS(:) - ZZW1(:,1)
@@ -887,40 +958,42 @@ WHERE( ZRGT(:)>XRTMIN(6) .AND. ZZT(:)<XTT &
END WHERE
!
! Budget storage
-IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
- IF (LBUDGET_TH) CALL BUDGET ( &
- UNPACK(ZTHS(:),MASK=GMICRO(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:),&
- NBUDGET_TH,'DRYG_BU_RTH')
- IF (LBUDGET_RC) CALL BUDGET ( &
- UNPACK(ZRCS(:),MASK=GMICRO(:,:,:),FIELD=PRCS)*PRHODJ(:,:,:), &
- NBUDGET_RC,'DRYG_BU_RRC')
- IF (LBUDGET_RR) CALL BUDGET ( &
- UNPACK(ZRRS(:),MASK=GMICRO(:,:,:),FIELD=PRRS)*PRHODJ(:,:,:), &
- NBUDGET_RR,'DRYG_BU_RRR')
- IF (LBUDGET_RI) CALL BUDGET ( &
- UNPACK(ZRIS(:),MASK=GMICRO(:,:,:),FIELD=PRIS)*PRHODJ(:,:,:), &
- NBUDGET_RI,'DRYG_BU_RRI')
- IF (LBUDGET_RS) CALL BUDGET ( &
- UNPACK(ZRSS(:),MASK=GMICRO(:,:,:),FIELD=PRSS)*PRHODJ(:,:,:), &
- NBUDGET_RS,'DRYG_BU_RRS')
- IF (LBUDGET_RG) CALL BUDGET ( &
- UNPACK(ZRGS(:),MASK=GMICRO(:,:,:),FIELD=PRGS)*PRHODJ(:,:,:), &
- NBUDGET_RG,'DRYG_BU_RRG')
- IF (LBUDGET_SV) THEN
- CALL BUDGET ( UNPACK(ZCCS(:),MASK=GMICRO(:,:,:),FIELD=PCCS)*PRHODJ(:,:,:), &
- NBUDGET_SV1-1+NSV_LIMA_NC,'DRYG_BU_RSV')
- CALL BUDGET ( UNPACK(ZCRS(:),MASK=GMICRO(:,:,:),FIELD=PCRS)*PRHODJ(:,:,:), &
- NBUDGET_SV1-1+NSV_LIMA_NR,'DRYG_BU_RSV')
- CALL BUDGET ( UNPACK(ZCIS(:),MASK=GMICRO(:,:,:),FIELD=PCIS)*PRHODJ(:,:,:), &
- NBUDGET_SV1-1+NSV_LIMA_NI,'DRYG_BU_RSV')
- END IF
-END IF
+if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'DRYG', &
+ Unpack( zths(:), mask = gmicro(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'DRYG', &
+ Unpack( zrcs(:), mask = gmicro(:, :, :), field = prcs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'DRYG', &
+ Unpack( zrrs(:), mask = gmicro(:, :, :), field = prrs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'DRYG', &
+ Unpack( zris(:), mask = gmicro(:, :, :), field = pris(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rs ) call Budget_store_end( tbudgets(NBUDGET_RS), 'DRYG', &
+ Unpack( zrss(:), mask = gmicro(:, :, :), field = prss(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG), 'DRYG', &
+ Unpack( zrgs(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'DRYG', &
+ Unpack( zccs(:), mask = gmicro(:, :, :), field = pccs(:, :, :) ) * prhodj(:, :, :) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'DRYG', &
+ Unpack( zcrs(:), mask = gmicro(:, :, :), field = pcrs(:, :, :) ) * prhodj(:, :, :) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'DRYG', &
+ Unpack( zcis(:), mask = gmicro(:, :, :), field = pcis(:, :, :) ) * prhodj(:, :, :) )
+ end if
+end if
!
!
!* 2.5 Hallett-Mossop ice multiplication process due to graupel riming
! --------------------------------------------------------------------
!
-!
+if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'HMG', &
+ Unpack( zris(:), mask = gmicro(:, :, :), field = pris(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_init( tbudgets(NBUDGET_RG), 'HMG', &
+ Unpack( zrgs(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'HMG', &
+ Unpack( zcis(:), mask = gmicro(:, :, :), field = pcis(:, :, :) ) * prhodj(:, :, :) )
+end if
+
GDRY(:) = (ZZT(:)<XHMTMAX) .AND. (ZZT(:)>XHMTMIN) .AND. (ZRDRYG(:)<ZZW(:))&
.AND. (ZRGT(:)>XRTMIN(6)) .AND. (ZRCT(:)>XRTMIN(2))
IGDRY = COUNT( GDRY(:) )
@@ -953,23 +1026,29 @@ IF( IGDRY>0 ) THEN
END IF
!
! Budget storage
-IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
- IF (LBUDGET_RI) CALL BUDGET ( &
- UNPACK(ZRIS(:),MASK=GMICRO,FIELD=PRIS)*PRHODJ(:,:,:), &
- NBUDGET_RI,'HMG_BU_RRI')
- IF (LBUDGET_RG) CALL BUDGET ( &
- UNPACK(ZRGS(:),MASK=GMICRO,FIELD=PRGS)*PRHODJ(:,:,:), &
- NBUDGET_RG,'HMG_BU_RRG')
- IF (LBUDGET_SV) CALL BUDGET ( &
- UNPACK(ZCIS(:),MASK=GMICRO,FIELD=PCIS)*PRHODJ(:,:,:), &
- NBUDGET_SV1-1+NSV_LIMA_NI,'HMG_BU_RSV')
-END IF
-!
+if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'HMG', &
+ Unpack( zris(:), mask = gmicro(:, :, :), field = pris(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG), 'HMG', &
+ Unpack( zrgs(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'HMG', &
+ Unpack( zcis(:), mask = gmicro(:, :, :), field = pcis(:, :, :) ) * prhodj(:, :, :) )
+end if
!
!* 2.6 Melting of the graupeln
! ----------------------------
!
-!
+if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'GMLT', &
+ Unpack( zths(:), mask = gmicro(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'GMLT', &
+ Unpack( zrrs(:), mask = gmicro(:, :, :), field = prrs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_init( tbudgets(NBUDGET_RG), 'GMLT', &
+ Unpack( zrgs(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'GMLT', &
+ Unpack( zcrs(:), mask = gmicro(:, :, :), field = pcrs(:, :, :) ) * prhodj(:, :, :) )
+end if
+
ZZW(:) = 0.0
WHERE( (ZRGT(:)>XRTMIN(6)) .AND. (ZRGS(:)>XRTMIN(6)/PTSTEP) .AND. (ZZT(:)>XTT) )
ZZW(:) = ZRVT(:)*ZPRES(:)/((XMV/XMD)+ZRVT(:)) ! Vapor pressure
@@ -994,21 +1073,16 @@ WHERE( (ZRGT(:)>XRTMIN(6)) .AND. (ZRGS(:)>XRTMIN(6)/PTSTEP) .AND. (ZZT(:)>XTT) )
! Dshed=1mm and 500 microns
END WHERE
!
-IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
- IF (LBUDGET_TH) CALL BUDGET ( &
- UNPACK(ZTHS(:),MASK=GMICRO(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:),&
- NBUDGET_TH,'GMLT_BU_RTH')
- IF (LBUDGET_RR) CALL BUDGET ( &
- UNPACK(ZRRS(:),MASK=GMICRO(:,:,:),FIELD=PRRS)*PRHODJ(:,:,:), &
- NBUDGET_RR,'GMLT_BU_RRR')
- IF (LBUDGET_RG) CALL BUDGET ( &
- UNPACK(ZRGS(:),MASK=GMICRO(:,:,:),FIELD=PRGS)*PRHODJ(:,:,:), &
- NBUDGET_RG,'GMLT_BU_RRG')
- IF (LBUDGET_SV) THEN
- CALL BUDGET ( UNPACK(ZCRS(:),MASK=GMICRO(:,:,:),FIELD=PCRS)*PRHODJ(:,:,:), &
- NBUDGET_SV1-1+NSV_LIMA_NR,'GMLT_BU_RSV')
- END IF
-END IF
+if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'GMLT', &
+ Unpack( zths(:), mask = gmicro(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'GMLT', &
+ Unpack( zrrs(:), mask = gmicro(:, :, :), field = prrs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG), 'GMLT', &
+ Unpack( zrgs(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'GMLT', &
+ Unpack( zcrs(:), mask = gmicro(:, :, :), field = pcrs(:, :, :) ) * prhodj(:, :, :) )
+end if
!
!
!------------------------------------------------------------------------------
@@ -1018,7 +1092,7 @@ END IF
! #################
!
!
-IF (LHAIL) THEN
+HAIL: IF (LHAIL) THEN
!
GHAIL(:) = ZRHT(:)>XRTMIN(7)
IHAIL = COUNT(GHAIL(:))
@@ -1028,6 +1102,31 @@ IF( IHAIL>0 ) THEN
!* 3.1 Wet growth of hail
! ----------------------------
!
+ if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'WETH', &
+ Unpack( zths(:), mask = gmicro(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'WETH', &
+ Unpack( zrcs(:), mask = gmicro(:, :, :), field = prcs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'WETH', &
+ Unpack( zrrs(:), mask = gmicro(:, :, :), field = prrs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'WETH', &
+ Unpack( zris(:), mask = gmicro(:, :, :), field = pris(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rs ) call Budget_store_init( tbudgets(NBUDGET_RS), 'WETH', &
+ Unpack( zrss(:), mask = gmicro(:, :, :), field = prss(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_init( tbudgets(NBUDGET_RG), 'WETH', &
+ Unpack( zrgs(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rh ) call Budget_store_init( tbudgets(NBUDGET_RH), 'WETH', &
+ Unpack( zrhs(:), mask = gmicro(:, :, :), field = prhs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'WETH', &
+ Unpack( zccs(:), mask = gmicro(:, :, :), field = pccs(:, :, :) ) * prhodj(:, :, :) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'WETH', &
+ Unpack( zcrs(:), mask = gmicro(:, :, :), field = pcrs(:, :, :) ) * prhodj(:, :, :) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'WETH', &
+ Unpack( zcis(:), mask = gmicro(:, :, :), field = pcis(:, :, :) ) * prhodj(:, :, :) )
+ end if
+ end if
+
ZZW1(:,:) = 0.0
WHERE( GHAIL(:) .AND. ( (ZRCT(:)>XRTMIN(2) .AND. ZRCS(:)>XRTMIN(2)/PTSTEP) .OR. &
(ZRIT(:)>XRTMIN(4) .AND. ZRIS(:)>XRTMIN(4)/PTSTEP) ) )
@@ -1209,43 +1308,33 @@ IF( IHAIL>0 ) THEN
ZCRS(:) = MAX( ZCRS(:)-MAX( ZZW1(:,4)-ZZW1(:,1),0.0 ) &
*(ZCRT(:)/MAX(ZRRT(:),XRTMIN(3))),0.0 )
END WHERE
-!
+
+ if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'WETH', &
+ Unpack( zths(:), mask = gmicro(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'WETH', &
+ Unpack( zrcs(:), mask = gmicro(:, :, :), field = prcs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'WETH', &
+ Unpack( zrrs(:), mask = gmicro(:, :, :), field = prrs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'WETH', &
+ Unpack( zris(:), mask = gmicro(:, :, :), field = pris(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rs ) call Budget_store_end( tbudgets(NBUDGET_RS), 'WETH', &
+ Unpack( zrss(:), mask = gmicro(:, :, :), field = prss(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG), 'WETH', &
+ Unpack( zrgs(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rh ) call Budget_store_end( tbudgets(NBUDGET_RH), 'WETH', &
+ Unpack( zrhs(:), mask = gmicro(:, :, :), field = prhs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'WETH', &
+ Unpack( zccs(:), mask = gmicro(:, :, :), field = pccs(:, :, :) ) * prhodj(:, :, :) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'WETH', &
+ Unpack( zcrs(:), mask = gmicro(:, :, :), field = pcrs(:, :, :) ) * prhodj(:, :, :) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'WETH', &
+ Unpack( zcis(:), mask = gmicro(:, :, :), field = pcis(:, :, :) ) * prhodj(:, :, :) )
+ end if
+ end if
END IF ! IHAIL>0
!
-!
-IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
- IF (LBUDGET_TH) CALL BUDGET ( &
- UNPACK(ZTHS(:),MASK=GMICRO(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:), &
- NBUDGET_TH,'WETH_BU_RTH')
- IF (LBUDGET_RC) CALL BUDGET ( &
- UNPACK(ZRCS(:),MASK=GMICRO(:,:,:),FIELD=PRCS)*PRHODJ(:,:,:), &
- NBUDGET_RC,'WETH_BU_RRC')
- IF (LBUDGET_RR) CALL BUDGET ( &
- UNPACK(ZRRS(:),MASK=GMICRO(:,:,:),FIELD=PRRS)*PRHODJ(:,:,:), &
- NBUDGET_RR,'WETH_BU_RRR')
- IF (LBUDGET_RI) CALL BUDGET ( &
- UNPACK(ZRIS(:),MASK=GMICRO(:,:,:),FIELD=PRIS)*PRHODJ(:,:,:), &
- NBUDGET_RI,'WETH_BU_RRI')
- IF (LBUDGET_RS) CALL BUDGET ( &
- UNPACK(ZRSS(:),MASK=GMICRO(:,:,:),FIELD=PRSS)*PRHODJ(:,:,:), &
- NBUDGET_RS,'WETH_BU_RRS')
- IF (LBUDGET_RG) CALL BUDGET ( &
- UNPACK(ZRGS(:),MASK=GMICRO(:,:,:),FIELD=PRGS)*PRHODJ(:,:,:), &
- NBUDGET_RG,'WETH_BU_RRG')
- IF (LBUDGET_RH) CALL BUDGET ( &
- UNPACK(ZRHS(:),MASK=GMICRO(:,:,:),FIELD=PRHS)*PRHODJ(:,:,:), &
- NBUDGET_RH,'WETH_BU_RRH')
- IF (LBUDGET_SV) THEN
- CALL BUDGET (UNPACK(ZCCS(:),MASK=GMICRO(:,:,:),FIELD=PCCS)*PRHODJ(:,:,:), &
- NBUDGET_SV1-1+NSV_LIMA_NC,'WETH_BU_RSV')
- CALL BUDGET (UNPACK(ZCRS(:),MASK=GMICRO(:,:,:),FIELD=PCRS)*PRHODJ(:,:,:), &
- NBUDGET_SV1-1+NSV_LIMA_NR,'WETH_BU_RSV')
- CALL BUDGET (UNPACK(ZCIS(:),MASK=GMICRO(:,:,:),FIELD=PCIS)*PRHODJ(:,:,:), &
- NBUDGET_SV1-1+NSV_LIMA_NI,'WETH_BU_RSV')
- END IF
-END IF
-!
-!
! Partial reconversion of hail to graupel when rc and rh are small
!
!
@@ -1253,6 +1342,13 @@ END IF
! -----------------------------------------------
!
IF ( IHAIL>0 ) THEN
+ if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_rg ) call Budget_store_init( tbudgets(NBUDGET_RG), 'COHG', &
+ Unpack( zrgs(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rh ) call Budget_store_init( tbudgets(NBUDGET_RH), 'COHG', &
+ Unpack( zrhs(:), mask = gmicro(:, :, :), field = prhs(:, :, :) ) * prhodj(:, :, :) )
+ end if
+
ZTHRH=0.01E-3
ZTHRC=0.001E-3
ZZW(:) = 0.0
@@ -1266,21 +1362,29 @@ IF ( IHAIL>0 ) THEN
ZRHS(:) = ZRHS(:) - ZZW(:) ! of hail into graupel
!
END WHERE
+
+ if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG), 'COHG', &
+ Unpack( zrgs(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rh ) call Budget_store_end( tbudgets(NBUDGET_RH), 'COHG', &
+ Unpack( zrhs(:), mask = gmicro(:, :, :), field = prhs(:, :, :) ) * prhodj(:, :, :) )
+ end if
END IF
!
-IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
- IF (LBUDGET_RG) CALL BUDGET ( &
- UNPACK(ZRGS(:),MASK=GMICRO(:,:,:),FIELD=PRGS)*PRHODJ(:,:,:), &
- 11,'COHG_BU_RRG')
- IF (LBUDGET_RH) CALL BUDGET ( &
- UNPACK(ZRHS(:),MASK=GMICRO(:,:,:),FIELD=PRHS)*PRHODJ(:,:,:), &
- 12,'COHG_BU_RRH')
-END IF
-!
-!
!* 3.4 Melting of the hailstones
!
IF ( IHAIL>0 ) THEN
+ if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'HMLT', &
+ Unpack( zths(:), mask = gmicro(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'HMLT', &
+ Unpack( zrrs(:), mask = gmicro(:, :, :), field = prrs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rh ) call Budget_store_init( tbudgets(NBUDGET_RH), 'HMLT', &
+ Unpack( zrhs(:), mask = gmicro(:, :, :), field = prhs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'HMLT', &
+ Unpack( zcrs(:), mask = gmicro(:, :, :), field = pcrs(:, :, :) ) * prhodj(:, :, :) )
+ end if
+
ZZW(:) = 0.0
WHERE( GHAIL(:) .AND. (ZRHS(:)>XRTMIN(7)/PTSTEP) .AND. (ZRHT(:)>XRTMIN(7)) .AND. (ZZT(:)>XTT) )
ZZW(:) = ZRVT(:)*ZPRES(:)/((XMV/XMD)+ZRVT(:)) ! Vapor pressure
@@ -1302,25 +1406,20 @@ IF ( IHAIL>0 ) THEN
ZCRS(:) = MAX( ZCRS(:) + ZZW(:)*(XCCH*ZLBDAH(:)**XCXH/ZRHT(:)),0.0 )
!
END WHERE
+
+ if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'HMLT', &
+ Unpack( zths(:), mask = gmicro(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'HMLT', &
+ Unpack( zrrs(:), mask = gmicro(:, :, :), field = prrs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rh ) call Budget_store_end( tbudgets(NBUDGET_RH), 'HMLT', &
+ Unpack( zrhs(:), mask = gmicro(:, :, :), field = prhs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'HMLT', &
+ Unpack( zcrs(:), mask = gmicro(:, :, :), field = pcrs(:, :, :) ) * prhodj(:, :, :) )
+ end if
END IF
-!
-IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
- IF (LBUDGET_TH) CALL BUDGET ( &
- UNPACK(ZTHS(:),MASK=GMICRO(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:),&
- NBUDGET_TH, 'HMLT_BU_RTH')
- IF (LBUDGET_RR) CALL BUDGET ( &
- UNPACK(ZRRS(:),MASK=GMICRO(:,:,:),FIELD=PRRS)*PRHODJ(:,:,:), &
- NBUDGET_RR, 'HMLT_BU_RRR')
- IF (LBUDGET_RH) CALL BUDGET ( &
- UNPACK(ZRHS(:),MASK=GMICRO(:,:,:),FIELD=PRHS)*PRHODJ(:,:,:), &
- NBUDGET_RH, 'HMLT_BU_RRH')
- IF (LBUDGET_SV) THEN
- CALL BUDGET ( UNPACK(ZCRS(:),MASK=GMICRO(:,:,:),FIELD=PCRS)*PRHODJ(:,:,:), &
- NBUDGET_SV1-1+NSV_LIMA_NR, 'HMLT_BU_RSV')
- END IF
-END IF
-!
-END IF
+
+END IF HAIL
!
!------------------------------------------------------------------------------
!
diff --git a/src/MNH/lima_mixed_slow_processes.f90 b/src/MNH/lima_mixed_slow_processes.f90
index bf559a2b5812c4cf8dcd92efa2bd0b4ea3e0f37f..0c5570bd1464ae53b86079d410db37e913f0991f 100644
--- a/src/MNH/lima_mixed_slow_processes.f90
+++ b/src/MNH/lima_mixed_slow_processes.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 2013-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2013-2020 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.
@@ -14,7 +14,7 @@ INTERFACE
ZRVS, ZRCS, ZRIS, ZRGS, ZTHS, &
ZCCS, ZCIS, ZIFS, ZINS, &
ZLBDAI, ZLBDAG, &
- ZRHODJ, GMICRO, PRHODJ, KMI, &
+ PRHODJ1D, GMICRO, PRHODJ, KMI,&
PTHS, PRVS, PRCS, PRIS, PRGS, &
PCCS, PCIS )
!
@@ -46,7 +46,7 @@ REAL, DIMENSION(:), INTENT(IN) :: ZLBDAI ! Slope parameter of the ice crys
REAL, DIMENSION(:), INTENT(IN) :: ZLBDAG ! Slope parameter of the graupel distr.
!
! used for budget storage
-REAL, DIMENSION(:), INTENT(IN) :: ZRHODJ
+REAL, DIMENSION(:), INTENT(IN) :: PRHODJ1D
LOGICAL, DIMENSION(:,:,:), INTENT(IN) :: GMICRO
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ
INTEGER, INTENT(IN) :: KMI
@@ -69,7 +69,7 @@ END MODULE MODI_LIMA_MIXED_SLOW_PROCESSES
ZRVS, ZRCS, ZRIS, ZRGS, ZTHS, &
ZCCS, ZCIS, ZIFS, ZINS, &
ZLBDAI, ZLBDAG, &
- ZRHODJ, GMICRO, PRHODJ, KMI, &
+ PRHODJ1D, GMICRO, PRHODJ, KMI,&
PTHS, PRVS, PRCS, PRIS, PRGS, &
PCCS, PCIS )
! #######################################################################
@@ -110,23 +110,25 @@ END MODULE MODI_LIMA_MIXED_SLOW_PROCESSES
!! -------------
!! Original ??/??/13
!! C. Barthe * LACy * jan. 2014 add budgets
-!!
+! P. Wautelet 03/2020: use the new data structures and subroutines for budgets
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
+use modd_budget, only: lbu_enable, nbumod, &
+ lbudget_th, lbudget_rv, lbudget_rc, lbudget_rc, lbudget_ri, lbudget_rg, lbudget_sv, &
+ NBUDGET_TH, NBUDGET_RV, NBUDGET_RC, NBUDGET_RC, NBUDGET_RI, NBUDGET_RG, NBUDGET_SV1, &
+ tbudgets
USE MODD_CST, ONLY : XTT, XALPI, XBETAI, XGAMI, &
XALPW, XBETAW, XGAMW
+USE MODD_NSV
USE MODD_PARAM_LIMA, ONLY : XRTMIN, XCTMIN, NMOD_IFN, LSNOW
-USE MODD_PARAM_LIMA_COLD, ONLY : XDI, X0DEPI, X2DEPI, XSCFAC
+USE MODD_PARAM_LIMA_COLD, ONLY : XDI, X0DEPI, X2DEPI, XSCFAC
USE MODD_PARAM_LIMA_MIXED, ONLY : XLBG, XLBEXG, XLBDAG_MAX, &
- X0DEPG, XEX0DEPG, X1DEPG, XEX1DEPG
-!
-USE MODD_NSV
-USE MODD_BUDGET
-USE MODI_BUDGET
-!
+ X0DEPG, XEX0DEPG, X1DEPG, XEX1DEPG
+use mode_budget, only: Budget_store_add, Budget_store_init, Budget_store_end
+
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
@@ -159,7 +161,7 @@ REAL, DIMENSION(:), INTENT(IN) :: ZLBDAI ! Slope parameter of the ice crys
REAL, DIMENSION(:), INTENT(IN) :: ZLBDAG ! Slope parameter of the graupel distr.
!
! used for budget storage
-REAL, DIMENSION(:), INTENT(IN) :: ZRHODJ
+REAL, DIMENSION(:), INTENT(IN) :: PRHODJ1D
LOGICAL, DIMENSION(:,:,:), INTENT(IN) :: GMICRO
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ
INTEGER, INTENT(IN) :: KMI
@@ -196,24 +198,31 @@ IF (LSNOW) THEN
END WHERE
!
! Budget storage
- IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
- IF (LBUDGET_TH) CALL BUDGET ( &
- UNPACK(ZTHS(:),MASK=GMICRO(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:),&
- NBUDGET_TH,'DEPG_BU_RTH')
- IF (LBUDGET_RV) CALL BUDGET ( &
- UNPACK(ZRVS(:),MASK=GMICRO(:,:,:),FIELD=PRVS)*PRHODJ(:,:,:),&
- NBUDGET_RV,'DEPG_BU_RRV')
- IF (LBUDGET_RG) CALL BUDGET ( &
- UNPACK(ZRGS(:),MASK=GMICRO(:,:,:),FIELD=PRGS)*PRHODJ(:,:,:), &
- NBUDGET_RG,'DEPG_BU_RRG')
- END IF
+ if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'DEPG', &
+ Unpack( zzw(:) * zlsfact(:) * prhodj1d(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rv ) call Budget_store_add( tbudgets(NBUDGET_RV), 'DEPG', &
+ Unpack( -zzw(:) * prhodj1d(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rg ) call Budget_store_add( tbudgets(NBUDGET_RG), 'DEPG', &
+ Unpack( zzw(:) * prhodj1d(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
END IF
!
!
!* 2 cloud ice Melting: RIMLTC and CIMLTC
! -----------------------------------------
!
-!
+ if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'IMLT', &
+ Unpack( zths(:), mask = gmicro(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'IMLT', prcs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'IMLT', pris(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'IMLT', pccs(:, :, :) * prhodj(:, :, :) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'IMLT', pcis(:, :, :) * prhodj(:, :, :) )
+ end if
+ end if
+
ZMASK(:) = 1.0
WHERE( (ZRIS(:)>XRTMIN(4)/PTSTEP) .AND. (ZZT(:)>XTT) )
ZRCS(:) = ZRCS(:) + ZRIS(:)
@@ -231,29 +240,33 @@ END IF
ENDDO
!
! Budget storage
- IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
- IF (LBUDGET_TH) CALL BUDGET ( &
- UNPACK(ZTHS(:),MASK=GMICRO(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:),&
- NBUDGET_TH,'IMLT_BU_RTH')
- IF (LBUDGET_RC) CALL BUDGET ( &
- UNPACK(ZRCS(:),MASK=GMICRO(:,:,:),FIELD=PRCS)*PRHODJ(:,:,:), &
- NBUDGET_RC,'IMLT_BU_RRC')
- IF (LBUDGET_RI) CALL BUDGET ( &
- UNPACK(ZRIS(:),MASK=GMICRO(:,:,:),FIELD=PRIS)*PRHODJ(:,:,:), &
- NBUDGET_RI,'IMLT_BU_RRI')
- IF (LBUDGET_SV) THEN
- CALL BUDGET (UNPACK(ZCCS(:),MASK=GMICRO(:,:,:),FIELD=PCCS)*PRHODJ(:,:,:), &
- NBUDGET_SV1-1+NSV_LIMA_NC,'IMLT_BU_RSV')
- CALL BUDGET (UNPACK(ZCIS(:),MASK=GMICRO(:,:,:),FIELD=PCIS)*PRHODJ(:,:,:), &
- NBUDGET_SV1-1+NSV_LIMA_NI,'IMLT_BU_RSV')
- END IF
- END IF
-!
+ if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'IMLT', &
+ Unpack( zths(:), mask = gmicro(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'IMLT', &
+ Unpack( zrcs(:), mask = gmicro(:, :, :), field = prcs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'IMLT', &
+ Unpack( zris(:), mask = gmicro(:, :, :), field = pris(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'IMLT', &
+ Unpack( zccs(:), mask = gmicro(:, :, :), field = pccs(:, :, :) ) * prhodj(:, :, :) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'IMLT', &
+ Unpack( zcis(:), mask = gmicro(:, :, :), field = pcis(:, :, :) ) * prhodj(:, :, :) )
+ end if
+ end if
!
!* 3 Bergeron-Findeisen effect: RCBERI
! --------------------------------------
!
-!
+ if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'BERFI', &
+ Unpack( zths(:), mask = gmicro(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'BERFI', &
+ Unpack( zrcs(:), mask = gmicro(:, :, :), field = prcs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'BERFI', &
+ Unpack( zris(:), mask = gmicro(:, :, :), field = pris(:, :, :) ) * prhodj(:, :, :) )
+ end if
+
ZZW(:) = 0.0
WHERE( (ZRCS(:)>XRTMIN(2)/PTSTEP) .AND. (ZRIS(:)>XRTMIN(4)/PTSTEP) .AND. (ZCIT(:)>XCTMIN(4)) )
ZZW(:) = EXP( (XALPW-XALPI) - (XBETAW-XBETAI)/ZZT(:) &
@@ -267,18 +280,14 @@ END IF
END WHERE
!
! Budget storage
- IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
- IF (LBUDGET_TH) CALL BUDGET ( &
- UNPACK(ZTHS(:),MASK=GMICRO(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:),&
- NBUDGET_TH,'BERFI_BU_RTH')
- IF (LBUDGET_RC) CALL BUDGET ( &
- UNPACK(ZRCS(:),MASK=GMICRO(:,:,:),FIELD=PRCS)*PRHODJ(:,:,:), &
- NBUDGET_RC,'BERFI_BU_RRC')
- IF (LBUDGET_RI) CALL BUDGET ( &
- UNPACK(ZRIS(:),MASK=GMICRO(:,:,:),FIELD=PRIS)*PRHODJ(:,:,:), &
- NBUDGET_RI,'BERFI_BU_RRI')
- END IF
-!
+ if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'BERFI', &
+ Unpack( zths(:), mask = gmicro(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'BERFI', &
+ Unpack( zrcs(:), mask = gmicro(:, :, :), field = prcs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'BERFI', &
+ Unpack( zris(:), mask = gmicro(:, :, :), field = pris(:, :, :) ) * prhodj(:, :, :) )
+ end if
!------------------------------------------------------------------------------
!
END SUBROUTINE LIMA_MIXED_SLOW_PROCESSES
diff --git a/src/MNH/lima_nucleation_procs.f90 b/src/MNH/lima_nucleation_procs.f90
index d7801f90a71d4ff660aab90fa3790b126507cb47..a7b7c98499b1a58c0c8a962cc8d5ff8ff6b5b9dc 100644
--- a/src/MNH/lima_nucleation_procs.f90
+++ b/src/MNH/lima_nucleation_procs.f90
@@ -69,24 +69,27 @@ SUBROUTINE LIMA_NUCLEATION_PROCS (PTSTEP, TPFILE, OCLOSE_OUT, PRHODJ,
!! MODIFICATIONS
!! -------------
!! Original 15/03/2018
-! P. Wautelet 27/02/2020: bugfix: PNFT was not updated after LIMA_CCN_HOM_FREEZING
-! P. Wautelet 27/02/2020: add Z_TH_HINC variable (for budgets)
+! P. Wautelet 27/02/2020: bugfix: PNFT was not updated after LIMA_CCN_HOM_FREEZING
+! P. Wautelet 27/02/2020: add Z_TH_HINC variable (for budgets)
+! P. Wautelet 02/2020: use the new data structures and subroutines for budgets
!-------------------------------------------------------------------------------
!
-USE MODD_PARAM_LIMA, ONLY : LCOLD, LNUCL, LMEYERS, LSNOW, LWARM, LACTI, LRAIN, LHHONI, &
- NMOD_CCN, NMOD_IFN, NMOD_IMM
-USE MODD_BUDGET, ONLY : LBU_ENABLE, LBUDGET_TH, LBUDGET_RV, LBUDGET_RC, LBUDGET_RR, &
- LBUDGET_RI, LBUDGET_RS, LBUDGET_RG, LBUDGET_RH, LBUDGET_SV, &
- NBUDGET_TH, NBUDGET_RV, NBUDGET_RC, NBUDGET_RI, NBUDGET_SV1
+use modd_budget, only: lbu_enable, lbudget_th, lbudget_rv, lbudget_rc, lbudget_rr, &
+ lbudget_ri, lbudget_rs, lbudget_rg, lbudget_rh, lbudget_sv, &
+ NBUDGET_TH, NBUDGET_RV, NBUDGET_RC, NBUDGET_RI, NBUDGET_SV1, &
+ tbudgets
+USE MODD_IO, ONLY: TFILEDATA
USE MODD_NSV, ONLY : NSV_LIMA_NC, NSV_LIMA_NR, NSV_LIMA_CCN_FREE, &
NSV_LIMA_NI, NSV_LIMA_IFN_FREE
-!
-USE MODD_IO, ONLY: TFILEDATA
-USE MODI_BUDGET
+USE MODD_PARAM_LIMA, ONLY : LCOLD, LNUCL, LMEYERS, LSNOW, LWARM, LACTI, LRAIN, LHHONI, &
+ NMOD_CCN, NMOD_IFN, NMOD_IMM
+
+use mode_budget, only: Budget_store_add, Budget_store_init, Budget_store_end
+
USE MODI_LIMA_CCN_ACTIVATION
-USE MODI_LIMA_PHILLIPS_IFN_NUCLEATION
-USE MODI_LIMA_MEYERS_NUCLEATION
USE MODI_LIMA_CCN_HOM_FREEZING
+USE MODI_LIMA_MEYERS_NUCLEATION
+USE MODI_LIMA_PHILLIPS_IFN_NUCLEATION
!
!-------------------------------------------------------------------------------
!
@@ -95,7 +98,7 @@ IMPLICIT NONE
!-------------------------------------------------------------------------------
!
REAL, INTENT(IN) :: PTSTEP ! Double Time step
-TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
LOGICAL, INTENT(IN) :: OCLOSE_OUT ! Conditional closure of
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Reference density
@@ -128,105 +131,83 @@ REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PNHT ! CCN hom. freezing
!-------------------------------------------------------------------------------
!
REAL, DIMENSION(SIZE(PT,1),SIZE(PT,2),SIZE(PT,3)) :: Z_TH_HIND, Z_RI_HIND, Z_CI_HIND, Z_TH_HINC, Z_RC_HINC, Z_CC_HINC
-REAL, DIMENSION(SIZE(PT,1),SIZE(PT,2),SIZE(PT,3)) :: ZTHT, ZRVT, ZRCT, ZRRT, ZRIT, ZRST, ZRGT
-REAL, DIMENSION(SIZE(PT,1),SIZE(PT,2),SIZE(PT,3)) :: ZCCT, ZCRT, ZCIT
-REAL, DIMENSION(SIZE(PT,1),SIZE(PT,2),SIZE(PT,3),NMOD_CCN) :: ZNFT, ZNAT
-REAL, DIMENSION(SIZE(PT,1),SIZE(PT,2),SIZE(PT,3),NMOD_IFN) :: ZIFT, ZINT
-REAL, DIMENSION(SIZE(PT,1),SIZE(PT,2),SIZE(PT,3),NMOD_IMM) :: ZNIT
-REAL, DIMENSION(SIZE(PT,1),SIZE(PT,2),SIZE(PT,3)) :: ZNHT
!
+integer :: idx
INTEGER :: JL
-!-------------------------------------------------------------------------------
-!
-ZTHT(:,:,:) = PTHT(:,:,:)
-ZRVT(:,:,:) = PRVT(:,:,:)
-ZRCT(:,:,:) = PRCT(:,:,:)
-ZCCT(:,:,:) = PCCT(:,:,:)
-ZRRT(:,:,:) = PRRT(:,:,:)
-ZCRT(:,:,:) = PCRT(:,:,:)
-ZRIT(:,:,:) = PRIT(:,:,:)
-ZCIT(:,:,:) = PCIT(:,:,:)
-ZRST(:,:,:) = PRST(:,:,:)
-ZRGT(:,:,:) = PRGT(:,:,:)
-ZNFT(:,:,:,:) = PNFT(:,:,:,:)
-ZNAT(:,:,:,:) = PNAT(:,:,:,:)
-ZIFT(:,:,:,:) = PIFT(:,:,:,:)
-ZINT(:,:,:,:) = PINT(:,:,:,:)
-ZNIT(:,:,:,:) = PNIT(:,:,:,:)
-ZNHT(:,:,:) = PNHT(:,:,:)
!
!-------------------------------------------------------------------------------
!
-IF (LWARM .AND. LACTI .AND. NMOD_CCN.GE.1) THEN
+IF ( LWARM .AND. LACTI .AND. NMOD_CCN >=1 ) THEN
+ if ( lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'HENU', ptht(:, :, :) * prhodj(:, :, :) / ptstep )
+ if ( lbudget_rv ) call Budget_store_init( tbudgets(NBUDGET_RV), 'HENU', prvt(:, :, :) * prhodj(:, :, :) / ptstep )
+ if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'HENU', prct(:, :, :) * prhodj(:, :, :) / ptstep )
+ if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'HENU', pcct(:, :, :) * prhodj(:, :, :) / ptstep )
+ do jl = 1, nmod_ccn
+ idx = NBUDGET_SV1 - 1 + nsv_lima_ccn_free - 1 + jl
+ call Budget_store_init( tbudgets(idx), 'HENU', pnft(:, :, :, jl) * prhodj(:, :, :) / ptstep )
+ end do
+ end if
+ end if
+
CALL LIMA_CCN_ACTIVATION (PTSTEP, TPFILE, OCLOSE_OUT, &
PRHODREF, PEXNREF, PPABST, PT, PTM, PW_NU, &
- ZTHT, ZRVT, ZRCT, ZCCT, ZRRT, ZNFT, ZNAT)
- PTHT(:,:,:) = ZTHT(:,:,:)
- PRVT(:,:,:) = ZRVT(:,:,:)
- PRCT(:,:,:) = ZRCT(:,:,:)
- PCCT(:,:,:) = ZCCT(:,:,:)
- PNFT(:,:,:,:) = ZNFT(:,:,:,:)
- PNAT(:,:,:,:) = ZNAT(:,:,:,:)
-!
-! Call budgets
-!
- IF (LBU_ENABLE) THEN
- IF (LBUDGET_TH) CALL BUDGET (PTHT(:,:,:)*PRHODJ(:,:,:)/PTSTEP, NBUDGET_TH, 'HENU_BU_RTH')
- IF (LBUDGET_RV) CALL BUDGET (PRVT(:,:,:)*PRHODJ(:,:,:)/PTSTEP, NBUDGET_RV, 'HENU_BU_RRV')
- IF (LBUDGET_RC) CALL BUDGET (PRCT(:,:,:)*PRHODJ(:,:,:)/PTSTEP, NBUDGET_RC, 'HENU_BU_RRC')
- IF (LBUDGET_SV) THEN
- CALL BUDGET (PCCT(:,:,:)*PRHODJ(:,:,:)/PTSTEP, NBUDGET_SV1-1+NSV_LIMA_NC, 'HENU_BU_RSV')
- DO JL=1, NMOD_CCN
- CALL BUDGET (PNFT(:,:,:,JL)*PRHODJ(:,:,:)/PTSTEP,NBUDGET_SV1-1+NSV_LIMA_CCN_FREE+JL-1, 'HENU_BU_RSV')
- END DO
- END IF
- END IF
+ PTHT, PRVT, PRCT, PCCT, PRRT, PNFT, PNAT)
+
+ if ( lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'HENU', ptht(:, :, :) * prhodj(:, :, :) / ptstep )
+ if ( lbudget_rv ) call Budget_store_end( tbudgets(NBUDGET_RV), 'HENU', prvt(:, :, :) * prhodj(:, :, :) / ptstep )
+ if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'HENU', prct(:, :, :) * prhodj(:, :, :) / ptstep )
+ if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'HENU', pcct(:, :, :) * prhodj(:, :, :) / ptstep )
+ do jl = 1, nmod_ccn
+ idx = NBUDGET_SV1 - 1 + nsv_lima_ccn_free - 1 + jl
+ call Budget_store_end( tbudgets(idx), 'HENU', pnft(:, :, :, jl) * prhodj(:, :, :) / ptstep )
+ end do
+ end if
+ end if
END IF
!
!-------------------------------------------------------------------------------
!
-IF (LCOLD .AND. LNUCL .AND. .NOT.LMEYERS .AND. NMOD_IFN.GE.1) THEN
+IF ( LCOLD .AND. LNUCL .AND. .NOT.LMEYERS .AND. NMOD_IFN >= 1 ) THEN
+ if ( lbu_enable ) then
+ if ( lbudget_sv ) then
+ do jl = 1, nmod_ifn
+ idx = NBUDGET_SV1 - 1 + nsv_lima_ifn_free - 1 + jl
+ call Budget_store_init( tbudgets(idx), 'HIND', pift(:, :, :, jl) * prhodj(:, :, :) / ptstep )
+ end do
+ end if
+ end if
+
CALL LIMA_PHILLIPS_IFN_NUCLEATION (PTSTEP, &
PRHODREF, PEXNREF, PPABST, &
- ZTHT, ZRVT, ZRCT, ZRRT, ZRIT, ZRST, ZRGT, &
- ZCCT, ZCIT, ZNAT, ZIFT, ZINT, ZNIT, &
+ PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
+ PCCT, PCIT, PNAT, PIFT, PINT, PNIT, &
Z_TH_HIND, Z_RI_HIND, Z_CI_HIND, &
Z_TH_HINC, Z_RC_HINC, Z_CC_HINC )
-!
-! Call budgets
-!
- IF (LBU_ENABLE) THEN
- IF (LBUDGET_TH) CALL BUDGET ((PTHT(:,:,:)+Z_TH_HIND(:,:,:))*PRHODJ(:,:,:)/PTSTEP,NBUDGET_TH, 'HIND_BU_RTH')
- IF (LBUDGET_RV) CALL BUDGET ((PRVT(:,:,:)-Z_RI_HIND(:,:,:))*PRHODJ(:,:,:)/PTSTEP,NBUDGET_RV, 'HIND_BU_RRV')
- IF (LBUDGET_RI) CALL BUDGET ((PRIT(:,:,:)+Z_RI_HIND(:,:,:))*PRHODJ(:,:,:)/PTSTEP,NBUDGET_RI, 'HIND_BU_RRI')
- IF (LBUDGET_SV) THEN
- CALL BUDGET ((PCIT(:,:,:)+Z_CI_HIND(:,:,:))*PRHODJ(:,:,:)/PTSTEP,NBUDGET_SV1-1+NSV_LIMA_NI, 'HIND_BU_RSV')
- IF (NMOD_IFN.GE.1) THEN
- DO JL=1, NMOD_IFN
- CALL BUDGET ((ZIFT(:,:,:,JL))*PRHODJ(:,:,:)/PTSTEP, NBUDGET_SV1-1+NSV_LIMA_IFN_FREE+JL-1,'HIND_BU_RSV')
- END DO
- END IF
- END IF
-!
- IF (LBUDGET_TH) CALL BUDGET (ZTHT(:,:,:)*PRHODJ(:,:,:)/PTSTEP,NBUDGET_TH,'HINC_BU_RTH')
- IF (LBUDGET_RC) CALL BUDGET (ZRCT(:,:,:)*PRHODJ(:,:,:)/PTSTEP,NBUDGET_RC,'HINC_BU_RRC')
- IF (LBUDGET_RI) CALL BUDGET (ZRIT(:,:,:)*PRHODJ(:,:,:)/PTSTEP,NBUDGET_RI,'HINC_BU_RRI')
- IF (LBUDGET_SV) THEN
- CALL BUDGET (ZCCT(:,:,:)*PRHODJ(:,:,:)/PTSTEP,NBUDGET_SV1-1+NSV_LIMA_NC,'HINC_BU_RSV')
- CALL BUDGET (ZCIT(:,:,:)*PRHODJ(:,:,:)/PTSTEP,NBUDGET_SV1-1+NSV_LIMA_NI,'HINC_BU_RSV')
- END IF
- END IF
-!
- PTHT(:,:,:) = ZTHT(:,:,:)
- PRVT(:,:,:) = ZRVT(:,:,:)
- PRCT(:,:,:) = ZRCT(:,:,:)
- PCCT(:,:,:) = ZCCT(:,:,:)
- PRIT(:,:,:) = ZRIT(:,:,:)
- PCIT(:,:,:) = ZCIT(:,:,:)
- PNAT(:,:,:,:) = ZNAT(:,:,:,:)
- PIFT(:,:,:,:) = ZIFT(:,:,:,:)
- PINT(:,:,:,:) = ZINT(:,:,:,:)
- PNIT(:,:,:,:) = ZNIT(:,:,:,:)
+
+ if ( lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'HIND', z_th_hind(:, :, :) * prhodj(:, :, :) / ptstep )
+ if ( lbudget_rv ) call Budget_store_add( tbudgets(NBUDGET_RV), 'HIND', -z_ri_hind(:, :, :) * prhodj(:, :, :) / ptstep )
+ if ( lbudget_ri ) call Budget_store_add( tbudgets(NBUDGET_RI), 'HIND', z_ri_hind(:, :, :) * prhodj(:, :, :) / ptstep )
+ if ( lbudget_sv ) then
+ call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'HIND', z_ci_hind(:, :, :) * prhodj(:, :, :) / ptstep )
+ do jl = 1, nmod_ifn
+ idx = NBUDGET_SV1 - 1 + nsv_lima_ifn_free - 1 + jl
+ call Budget_store_end( tbudgets(idx), 'HIND', pift(:, :, :, jl) * prhodj(:, :, :) / ptstep )
+ end do
+ end if
+
+ if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'HINC', z_th_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
+ if ( lbudget_rc ) call Budget_store_add( tbudgets(NBUDGET_RC), 'HINC', z_rc_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
+ if ( lbudget_ri ) call Budget_store_add( tbudgets(NBUDGET_RI), 'HINC', -z_rc_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
+ if ( lbudget_sv ) then
+ call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'HINC', z_cc_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
+ call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'HINC', -z_cc_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
+ end if
+ end if
END IF
!
!-------------------------------------------------------------------------------
@@ -234,64 +215,60 @@ END IF
IF (LCOLD .AND. LNUCL .AND. LMEYERS) THEN
CALL LIMA_MEYERS_NUCLEATION (PTSTEP, &
PRHODREF, PEXNREF, PPABST, &
- ZTHT, ZRVT, ZRCT, ZRRT, ZRIT, ZRST, ZRGT, &
- ZCCT, ZCIT, ZINT, &
+ PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
+ PCCT, PCIT, PINT, &
Z_TH_HIND, Z_RI_HIND, Z_CI_HIND, &
Z_TH_HINC, Z_RC_HINC, Z_CC_HINC )
-!
-! Call budgets
-!
- IF (LBU_ENABLE) THEN
- IF (LBUDGET_TH) CALL BUDGET ((PTHT(:,:,:)+Z_TH_HIND(:,:,:))*PRHODJ(:,:,:)/PTSTEP,NBUDGET_TH, 'HIND_BU_RTH')
- IF (LBUDGET_RV) CALL BUDGET ((PRVT(:,:,:)-Z_RI_HIND(:,:,:))*PRHODJ(:,:,:)/PTSTEP,NBUDGET_RV, 'HIND_BU_RRV')
- IF (LBUDGET_RI) CALL BUDGET ((PRIT(:,:,:)+Z_RI_HIND(:,:,:))*PRHODJ(:,:,:)/PTSTEP,NBUDGET_RI, 'HIND_BU_RRI')
- IF (LBUDGET_SV) CALL BUDGET ((PCIT(:,:,:)+Z_CI_HIND(:,:,:))*PRHODJ(:,:,:)/PTSTEP,NBUDGET_SV1-1+NSV_LIMA_NI,'HIND_BU_RSV')
-!
- IF (LBUDGET_TH) CALL BUDGET (ZTHT(:,:,:)*PRHODJ(:,:,:)/PTSTEP,NBUDGET_TH,'HINC_BU_RTH')
- IF (LBUDGET_RC) CALL BUDGET (ZRCT(:,:,:)*PRHODJ(:,:,:)/PTSTEP,NBUDGET_RC,'HINC_BU_RRC')
- IF (LBUDGET_RI) CALL BUDGET (ZRIT(:,:,:)*PRHODJ(:,:,:)/PTSTEP,NBUDGET_RI,'HINC_BU_RRI')
- IF (LBUDGET_SV) THEN
- CALL BUDGET (ZCCT(:,:,:)*PRHODJ(:,:,:)/PTSTEP,NBUDGET_SV1-1+NSV_LIMA_NC,'HINC_BU_RSV')
- CALL BUDGET (ZCIT(:,:,:)*PRHODJ(:,:,:)/PTSTEP,NBUDGET_SV1-1+NSV_LIMA_NI,'HINC_BU_RSV')
- END IF
- END IF
-!
-PTHT(:,:,:) = ZTHT(:,:,:)
-PRVT(:,:,:) = ZRVT(:,:,:)
-PRCT(:,:,:) = ZRCT(:,:,:)
-PCCT(:,:,:) = ZCCT(:,:,:)
-PRIT(:,:,:) = ZRIT(:,:,:)
-PCIT(:,:,:) = ZCIT(:,:,:)
-PINT(:,:,:,:) = ZINT(:,:,:,:)
+
+ if ( lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'HIND', z_th_hind(:, :, :) * prhodj(:, :, :) / ptstep )
+ if ( lbudget_rv ) call Budget_store_add( tbudgets(NBUDGET_RV), 'HIND', -z_ri_hind(:, :, :) * prhodj(:, :, :) / ptstep )
+ if ( lbudget_ri ) call Budget_store_add( tbudgets(NBUDGET_RI), 'HIND', z_ri_hind(:, :, :) * prhodj(:, :, :) / ptstep )
+ if ( lbudget_sv ) &
+ call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'HIND', z_ci_hind(:, :, :) * prhodj(:, :, :) / ptstep )
+
+ if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'HINC', z_th_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
+ if ( lbudget_rc ) call Budget_store_add( tbudgets(NBUDGET_RC), 'HINC', z_rc_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
+ if ( lbudget_ri ) call Budget_store_add( tbudgets(NBUDGET_RI), 'HINC', -z_rc_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
+ if ( lbudget_sv ) then
+ call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'HINC', z_cc_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
+ call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'HINC', -z_cc_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
+ end if
+ end if
END IF
!
!-------------------------------------------------------------------------------
!
-IF (LCOLD .AND. LNUCL .AND. LHHONI .AND. NMOD_CCN.GE.1) THEN
- CALL LIMA_CCN_HOM_FREEZING (PRHODREF, PEXNREF, PPABST, PW_NU, &
- ZTHT, ZRVT, ZRCT, ZRRT, ZRIT, ZRST, ZRGT, &
- ZCCT, ZCRT, ZCIT, ZNFT, ZNHT )
-!
-! Call budgets
-!
- IF (LBU_ENABLE) THEN
- IF (LBUDGET_TH) CALL BUDGET (ZTHT(:,:,:)*PRHODJ(:,:,:)/PTSTEP, NBUDGET_TH, 'HONH_BU_RTH')
- IF (LBUDGET_RV) CALL BUDGET (ZRVT(:,:,:)*PRHODJ(:,:,:)/PTSTEP, NBUDGET_RV, 'HONH_BU_RRV')
- IF (LBUDGET_RI) CALL BUDGET (ZRIT(:,:,:)*PRHODJ(:,:,:)/PTSTEP, NBUDGET_RI, 'HONH_BU_RRI')
- IF (LBUDGET_SV) THEN
- CALL BUDGET (ZCIT(:,:,:)*PRHODJ(:,:,:)/PTSTEP, NBUDGET_SV1-1+NSV_LIMA_NI, 'HONH_BU_RSV')
- DO JL=1, NMOD_CCN
- CALL BUDGET (ZNFT(:,:,:,JL)*PRHODJ(:,:,:)/PTSTEP,NBUDGET_SV1-1+NSV_LIMA_CCN_FREE+JL-1,'HONH_BU_RSV')
- END DO
- END IF
- END IF
-!
-PTHT(:,:,:) = ZTHT(:,:,:)
-PRVT(:,:,:) = ZRVT(:,:,:)
-PRIT(:,:,:) = ZRIT(:,:,:)
-PCIT(:,:,:) = ZCIT(:,:,:)
-PNFT(:,:,:,:) = ZNFT(:,:,:,:)
-PNHT(:,:,:) = ZNHT(:,:,:)
+IF ( LCOLD .AND. LNUCL .AND. LHHONI .AND. NMOD_CCN >= 1) THEN
+ if ( lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'HONH', PTHT(:, :, :) * prhodj(:, :, :) / ptstep )
+ if ( lbudget_rv ) call Budget_store_init( tbudgets(NBUDGET_RV), 'HONH', PRVT(:, :, :) * prhodj(:, :, :) / ptstep )
+ if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'HONH', PRIT(:, :, :) * prhodj(:, :, :) / ptstep )
+ if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'HONH', PCIT(:, :, :) * prhodj(:, :, :) / ptstep )
+ do jl = 1, nmod_ccn
+ idx = NBUDGET_SV1 - 1 + nsv_lima_ccn_free - 1 + jl
+ call Budget_store_end( tbudgets(idx), 'HONH', PNFT(:, :, :, jl) * prhodj(:, :, :) / ptstep )
+ end do
+ end if
+ end if
+
+ CALL LIMA_CCN_HOM_FREEZING (PRHODREF, PEXNREF, PPABST, PW_NU, &
+ PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
+ PCCT, PCRT, PCIT, PNFT, PNHT )
+
+ if ( lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'HONH', PTHT(:, :, :) * prhodj(:, :, :) / ptstep )
+ if ( lbudget_rv ) call Budget_store_end( tbudgets(NBUDGET_RV), 'HONH', PRVT(:, :, :) * prhodj(:, :, :) / ptstep )
+ if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'HONH', PRIT(:, :, :) * prhodj(:, :, :) / ptstep )
+ if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'HONH', PCIT(:, :, :) * prhodj(:, :, :) / ptstep )
+ do jl = 1, nmod_ccn
+ idx = NBUDGET_SV1 - 1 + nsv_lima_ccn_free - 1 + jl
+ call Budget_store_end( tbudgets(idx), 'HONH', PNFT(:, :, :, jl) * prhodj(:, :, :) / ptstep )
+ end do
+ end if
+ end if
ENDIF
!
!-------------------------------------------------------------------------------
diff --git a/src/MNH/lima_phillips.f90 b/src/MNH/lima_phillips.f90
index 3f654dc33906688113acbe0b12b66fe1a4aae9c0..d16f094780114439616471e22014754f57f57d4e 100644
--- a/src/MNH/lima_phillips.f90
+++ b/src/MNH/lima_phillips.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 2013-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2013-2020 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.
@@ -115,15 +115,18 @@ END MODULE MODI_LIMA_PHILLIPS
!! -------------
!! Original ??/??/13
!! C. Barthe * LACy * jan. 2014 add budgets
-!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet 05/2016-04/2018: new data structures and calls for I/O
! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90
-!
+! P. Wautelet 03/2020: use the new data structures and subroutines for budgets
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_BUDGET
+use modd_budget, only: lbu_enable, nbumod, &
+ lbudget_th, lbudget_rv, lbudget_rc, lbudget_ri, lbudget_sv, &
+ NBUDGET_TH, NBUDGET_RV, NBUDGET_RC, NBUDGET_RI, NBUDGET_SV1, &
+ tbudgets
USE MODD_CST, ONLY : XP00, XRD, XMV, XMD, XCPD, XCPV, XCL, XCI, &
XTT, XLSTT, XLVTT, XALPI, XBETAI, XGAMI, &
XALPW, XBETAW, XGAMW, XPI
@@ -134,9 +137,9 @@ USE MODD_PARAM_LIMA, ONLY : NMOD_IFN, NSPECIE, XFRAC,
XDSI0, XRTMIN, XCTMIN, NPHILLIPS
USE MODD_PARAM_LIMA_COLD, ONLY : XMNU0
+use mode_budget, only: Budget_store_init, Budget_store_end
use mode_tools, only: Countjv
-USE MODI_BUDGET
USE MODI_LIMA_PHILLIPS_INTEG
USE MODI_LIMA_PHILLIPS_REF_SPECTRUM
@@ -189,6 +192,7 @@ REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PNIS ! Activated ice nuclei C. sou
INTEGER :: IIB, IIE, IJB, IJE, IKB, IKE ! Physical domain
INTEGER :: JL, JMOD_CCN, JMOD_IFN, JSPECIE, JMOD_IMM ! Loop index
INTEGER :: INEGT ! Case number of sedimentation, nucleation,
+integer :: idx
!
LOGICAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) &
:: GNEGT ! Test where to compute the nucleation
@@ -432,8 +436,19 @@ CALL LIMA_PHILLIPS_INTEG(ZZT, ZSI, ZSI0, ZSW, ZZY, Z_FRAC_ACT)
!* 5. COMPUTE THE HETEROGENEOUS NUCLEATION OF INSOLUBLE IFN
! -----------------------------------------------------
!
-!
-!
+if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'HIND', pths(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rv ) call Budget_store_init( tbudgets(NBUDGET_RV), 'HIND', prvs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'HIND', pris(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'HIND', pcis(:, :, :) * prhodj(:, :, :) )
+ do jl = 1, nmod_ifn
+ idx = NBUDGET_SV1 - 1 + nsv_lima_ifn_free -1 + jl
+ call Budget_store_init( tbudgets(NBUDGET_RI), 'HIND', pifs(:, :, :, jl) * prhodj(:, :, :) )
+ end do
+ end if
+end if
+
DO JMOD_IFN = 1,NMOD_IFN ! IFN modes
ZZX(:)=0.
DO JSPECIE = 1, NSPECIE ! Each IFN mode is mixed with DM1, DM2, BC, O
@@ -467,34 +482,40 @@ END DO
!
!
! Budget storage
-IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
- IF (LBUDGET_TH) CALL BUDGET ( &
- UNPACK(ZTHS(:),MASK=GNEGT(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:),&
- NBUDGET_TH,'HIND_BU_RTH')
- IF (LBUDGET_RV) CALL BUDGET ( &
- UNPACK(ZRVS(:),MASK=GNEGT(:,:,:),FIELD=PRVS)*PRHODJ(:,:,:),&
- NBUDGET_RV,'HIND_BU_RRV')
- IF (LBUDGET_RI) CALL BUDGET ( &
- UNPACK(ZRIS(:),MASK=GNEGT(:,:,:),FIELD=PRIS)*PRHODJ(:,:,:),&
- NBUDGET_RI,'HIND_BU_RRI')
- IF (LBUDGET_SV) THEN
- CALL BUDGET ( UNPACK(ZCIS(:),MASK=GNEGT(:,:,:),FIELD=PCIS)*PRHODJ(:,:,:),&
- NBUDGET_SV1-1+NSV_LIMA_NI,'HIND_BU_RSV')
- IF (NMOD_IFN.GE.1) THEN
- DO JL=1, NMOD_IFN
- CALL BUDGET ( PIFS(:,:,:,JL)*PRHODJ(:,:,:),NBUDGET_SV1-1+NSV_LIMA_IFN_FREE+JL-1,'HIND_BU_RSV')
- END DO
- END IF
- END IF
-END IF
-!
-!
+if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'HIND', &
+ Unpack ( zths(:), mask = gnegt(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rv ) call Budget_store_end( tbudgets(NBUDGET_RV), 'HIND', &
+ Unpack ( zrvs(:), mask = gnegt(:, :, :), field = prvs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'HIND', &
+ Unpack ( zris(:), mask = gnegt(:, :, :), field = pris(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'HIND', &
+ Unpack ( zcis(:), mask = gnegt(:, :, :), field = pcis(:, :, :) ) * prhodj(:, :, :) )
+ do jl = 1, nmod_ifn
+ idx = NBUDGET_SV1 - 1 + nsv_lima_ifn_free -1 + jl
+ call Budget_store_end( tbudgets(NBUDGET_RI), 'HIND', pifs(:, :, :, jl) * prhodj(:, :, :) )
+ end do
+ end if
+end if
!-------------------------------------------------------------------------------
!
!
!* 6. COMPUTE THE HETEROGENEOUS NUCLEATION OF COATED IFN
! --------------------------------------------------
!
+if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'HINC', &
+ Unpack ( zths(:), mask = gnegt(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'HINC', prcs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'HINC', &
+ Unpack ( zris(:), mask = gnegt(:, :, :), field = pris(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'HINC', pccs(:, :, :) * prhodj(:, :, :) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'HINC', &
+ Unpack ( zcis(:), mask = gnegt(:, :, :), field = pcis(:, :, :) ) * prhodj(:, :, :) )
+ end if
+end if
!
! Heterogeneous nucleation by immersion of the activated CCN
! Currently, we represent coated IFN as a pure aerosol type (NIND_SPECIE)
@@ -537,25 +558,20 @@ DO JMOD_IMM = 1,NMOD_IMM ! Coated IFN modes
END DO
!
! Budget storage
-IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
- IF (LBUDGET_TH) CALL BUDGET ( &
- UNPACK(ZTHS(:),MASK=GNEGT(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:),&
- NBUDGET_TH,'HINC_BU_RTH')
- IF (LBUDGET_RC) CALL BUDGET ( &
- UNPACK(ZRCS(:),MASK=GNEGT(:,:,:),FIELD=PRCS)*PRHODJ(:,:,:),&
- NBUDGET_RC,'HINC_BU_RRC')
- IF (LBUDGET_RI) CALL BUDGET ( &
- UNPACK(ZRIS(:),MASK=GNEGT(:,:,:),FIELD=PRIS)*PRHODJ(:,:,:),&
- NBUDGET_RI,'HINC_BU_RRI')
- IF (LBUDGET_SV) THEN
- CALL BUDGET ( UNPACK(ZCCS(:),MASK=GNEGT(:,:,:),FIELD=PCCS)*PRHODJ(:,:,:),&
- NBUDGET_SV1-1+NSV_LIMA_NC,'HINC_BU_RSV')
- CALL BUDGET ( UNPACK(ZCIS(:),MASK=GNEGT(:,:,:),FIELD=PCIS)*PRHODJ(:,:,:),&
- NBUDGET_SV1-1+NSV_LIMA_NI,'HINC_BU_RSV')
- END IF
-END IF
-!
-!
+if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'HINC', &
+ Unpack ( zths(:), mask = gnegt(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'HINC', &
+ Unpack ( zrcs(:), mask = gnegt(:, :, :), field = prcs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'HINC', &
+ Unpack ( zris(:), mask = gnegt(:, :, :), field = pris(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'HINC', &
+ Unpack ( zccs(:), mask = gnegt(:, :, :), field = pccs(:, :, :) ) * prhodj(:, :, :) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'HINC', &
+ Unpack ( zcis(:), mask = gnegt(:, :, :), field = pcis(:, :, :) ) * prhodj(:, :, :) )
+ end if
+end if
!-------------------------------------------------------------------------------
!
!
@@ -619,46 +635,6 @@ DEALLOCATE(ZZY)
DEALLOCATE(ZSI_W)
!--cb--
!
-!
-ELSE
-!
-! Advance the budget calls
-!
- IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
- IF (LBUDGET_TH) THEN
- ZW(:,:,:) = PTHS(:,:,:)*PRHODJ(:,:,:)
- CALL BUDGET (ZW,NBUDGET_TH,'HIND_BU_RTH')
- CALL BUDGET (ZW,NBUDGET_TH,'HINC_BU_RTH')
- ENDIF
- IF (LBUDGET_RV) THEN
- ZW(:,:,:) = PRVS(:,:,:)*PRHODJ(:,:,:)
- CALL BUDGET (ZW,NBUDGET_RV,'HIND_BU_RRV')
- ENDIF
- IF (LBUDGET_RC) THEN
- ZW(:,:,:) = PRCS(:,:,:)*PRHODJ(:,:,:)
- CALL BUDGET (ZW,NBUDGET_RC,'HINC_BU_RRC')
- ENDIF
- IF (LBUDGET_RI) THEN
- ZW(:,:,:) = PRIS(:,:,:)*PRHODJ(:,:,:)
- CALL BUDGET (ZW,NBUDGET_RI,'HIND_BU_RRI')
- CALL BUDGET (ZW,NBUDGET_RI,'HINC_BU_RRI')
- ENDIF
- IF (LBUDGET_SV) THEN
-!print*, 'LBUDGET_SV dans lima_phillips = ', LBUDGET_SV
- ZW(:,:,:) = PCCS(:,:,:)*PRHODJ(:,:,:)
- CALL BUDGET (ZW,NBUDGET_SV1-1+NSV_LIMA_NC,'HINC_BU_RSV')
- ZW(:,:,:) = PCIS(:,:,:)*PRHODJ(:,:,:)
- CALL BUDGET (ZW,NBUDGET_SV1-1+NSV_LIMA_NI,'HIND_BU_RSV')
- CALL BUDGET (ZW,NBUDGET_SV1-1+NSV_LIMA_NI,'HINC_BU_RSV')
- IF (NMOD_IFN.GE.1) THEN
- DO JL=1, NMOD_IFN
- CALL BUDGET ( PIFS(:,:,:,JL)*PRHODJ(:,:,:),NBUDGET_SV1-1+NSV_LIMA_IFN_FREE+JL-1,'HIND_BU_RSV')
- END DO
- END IF
- END IF
- END IF
-!
-!
END IF ! INEGT > 0
!
!-------------------------------------------------------------------------------
diff --git a/src/MNH/lima_phillips_ifn_nucleation.f90 b/src/MNH/lima_phillips_ifn_nucleation.f90
index 440a53f1550937df07b86365ce60cb8e2c61a0f9..14733bb6dfca257eaf472f3cce873463cae419dd 100644
--- a/src/MNH/lima_phillips_ifn_nucleation.f90
+++ b/src/MNH/lima_phillips_ifn_nucleation.f90
@@ -111,7 +111,6 @@ END MODULE MODI_LIMA_PHILLIPS_IFN_NUCLEATION
!* 0. DECLARATIONS
! ------------
!
-USE MODD_BUDGET
USE MODD_CST, ONLY : XP00, XRD, XMV, XMD, XCPD, XCPV, XCL, XCI, &
XTT, XLSTT, XLVTT, XALPI, XBETAI, XGAMI, &
XALPW, XBETAW, XGAMW, XPI
@@ -124,7 +123,6 @@ USE MODD_PARAM_LIMA_COLD, ONLY : XMNU0
use mode_tools, only: Countjv
-USE MODI_BUDGET
USE MODI_LIMA_PHILLIPS_INTEG
USE MODI_LIMA_PHILLIPS_REF_SPECTRUM
diff --git a/src/MNH/lima_precip_scavenging.f90 b/src/MNH/lima_precip_scavenging.f90
index 71de50a5e048d2814b37f93786e4679a745494be..a456a17bd4bea93ee63e3a353c1f94c4abac6e5b 100644
--- a/src/MNH/lima_precip_scavenging.f90
+++ b/src/MNH/lima_precip_scavenging.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 2013-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2013-2020 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.
@@ -98,12 +98,13 @@ END MODULE MODI_LIMA_PRECIP_SCAVENGING
!! Philippe Wautelet 28/05/2018: corrected truncated integer division (3/2 -> 1.5)
! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90
+! P. Wautelet 03/2020: use the new data structures and subroutines for budgets
!-------------------------------------------------------------------------------
!
!* 0.DECLARATIONS
! --------------
!
-USE MODD_BUDGET
+use modd_budget, only: lbudget_sv, NBUDGET_SV1, tbudgets
USE MODD_CST
USE MODD_NSV
USE MODD_PARAMETERS
@@ -116,9 +117,9 @@ USE MODD_PARAM_LIMA, ONLY: NMOD_IFN, NSPECIE, XFRAC,
XRTMIN, XCTMIN
USE MODD_PARAM_LIMA_WARM, ONLY: XCR, XDR
+use mode_budget, only: Budget_store_init, Budget_store_end
use mode_tools, only: Countjv
-USE MODI_BUDGET
USE MODI_GAMMA
USE MODI_INI_NSV
USE MODI_LIMA_FUNCTIONS
@@ -240,6 +241,7 @@ REAL, DIMENSION(:,:), ALLOCATABLE :: &
ZVOLDR_INV ! INV of Mean volumic Raindrop diameter [m]
REAL :: ZDENS_RATIO_SQRT
INTEGER :: SV_VAR, NM, JM
+integer :: idx
REAL :: XMDIAMP
REAL :: XSIGMAP
REAL :: XRHOP
@@ -248,7 +250,17 @@ REAL :: XFRACP
!
!
!------------------------------------------------------------------------------
-!
+
+if ( lbudget_sv ) then
+ do jl = 1, nmod_ccn
+ idx = nsv_lima_ccn_free - 1 + jl
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + idx), 'SCAV', prsvs(:, :, :, idx) )
+ end do
+ do jl = 1, nmod_ifn
+ idx = nsv_lima_ifn_free - 1 + jl
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + idx), 'SCAV', prsvs(:, :, :, idx) )
+ end do
+end if
!
!* 1. PRELIMINARY COMPUTATIONS
! ------------------------
@@ -555,21 +567,16 @@ DO JSV = 1, NMOD_CCN+NMOD_IFN
ENDIF
ENDDO
!
-IF (LBUDGET_SV) THEN
- IF (NMOD_CCN.GE.1) THEN
- DO JL=1, NMOD_CCN
- CALL BUDGET ( PRSVS(:,:,:,NSV_LIMA_CCN_FREE+JL-1), &
- NBUDGET_SV1-1+NSV_LIMA_CCN_FREE+JL-1,'SCAV_BU_RSV')
- END DO
- END IF
- IF (NMOD_IFN.GE.1) THEN
- DO JL=1, NMOD_IFN
- CALL BUDGET ( PRSVS(:,:,:,NSV_LIMA_IFN_FREE+JL-1), &
- NBUDGET_SV1-1+NSV_LIMA_IFN_FREE+JL-1,'SCAV_BU_RSV')
- END DO
- END IF
-END IF
-!
+if ( lbudget_sv ) then
+ do jl = 1, nmod_ccn
+ idx = nsv_lima_ccn_free - 1 + jl
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + idx), 'SCAV', prsvs(:, :, :, idx) )
+ end do
+ do jl = 1, nmod_ifn
+ idx = nsv_lima_ifn_free - 1 + jl
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + idx), 'SCAV', prsvs(:, :, :, idx) )
+ end do
+end if
!------------------------------------------------------------------------------
!
!
diff --git a/src/MNH/lima_warm.f90 b/src/MNH/lima_warm.f90
index e896e999a8d3e3134821a947a3f2d0a6839c3e6e..d47b2f25e1b24a9899d5dd731239c1d6551fc584 100644
--- a/src/MNH/lima_warm.f90
+++ b/src/MNH/lima_warm.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 2013-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2013-2020 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.
@@ -126,30 +126,31 @@ END MODULE MODI_LIMA_WARM
!! Original ??/??/13
!! C. Barthe * LACy * jan. 2014 add budgets
!! J. Escobar : for real*4 , use XMNH_HUGE
-!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
-!!
+! P. Wautelet 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet 02/2020: use the new data structures and subroutines for budgets (no more budget calls in this subroutine)
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_PARAMETERS
-USE MODD_CST
+use modd_budget, only: lbudget_th, lbudget_rv, lbudget_rc, lbudget_rr, lbudget_sv, &
+ NBUDGET_TH, NBUDGET_RV, NBUDGET_RC, NBUDGET_RR, NBUDGET_SV1, &
+ tbudgets
USE MODD_CONF
+USE MODD_CST
+USE MODD_IO, ONLY: TFILEDATA
+USE MODD_LUNIT_n, ONLY: TLUOUT
+USE MODD_NSV
+USE MODD_PARAMETERS
USE MODD_PARAM_LIMA
USE MODD_PARAM_LIMA_WARM
-USE MODD_NSV
-!
-!
-USE MODD_BUDGET
-USE MODI_BUDGET
-!
-USE MODI_LIMA_WARM_SEDIMENTATION
-USE MODI_LIMA_WARM_NUCL
+
+use mode_budget, only: Budget_store_init, Budget_store_end
+
USE MODI_LIMA_WARM_COAL
USE MODI_LIMA_WARM_EVAP
-USE MODD_IO, ONLY: TFILEDATA
-USE MODD_LUNIT_n, ONLY: TLUOUT
+USE MODI_LIMA_WARM_NUCL
+USE MODI_LIMA_WARM_SEDIMENTATION
!
IMPLICIT NONE
!
@@ -231,6 +232,7 @@ REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) &
:: ZT, ZTM
REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) &
:: ZWLBDR,ZWLBDR3,ZWLBDC,ZWLBDC3
+integer :: idx
INTEGER :: JL
!
LOGICAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2)) :: GDEP
@@ -315,6 +317,13 @@ END IF
! -------------------------------------
!
!
+if ( lbudget_rc .and. osedc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'SEDI', prcs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rr .and. orain ) call Budget_store_init( tbudgets(NBUDGET_RR), 'SEDI', prrs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_sv ) then
+ if ( osedc ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'SEDI', pccs(:, :, :) * prhodj(:, :, :) )
+ if ( orain ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'SEDI', pcrs(:, :, :) * prhodj(:, :, :) )
+end if
+
CALL LIMA_WARM_SEDIMENTATION (OSEDC, KSPLITR, PTSTEP, KMI, &
PZZ, PRHODREF, PPABST, ZT, &
ZWLBDC, &
@@ -322,17 +331,20 @@ CALL LIMA_WARM_SEDIMENTATION (OSEDC, KSPLITR, PTSTEP, KMI, &
PRCS, PRRS, PCCS, PCRS, &
PINPRC, PINPRR, &
PINPRR3D )
-!
-IF (LBUDGET_RC .AND. OSEDC) CALL BUDGET (PRCS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RC,'SEDI_BU_RRC')
-IF (LBUDGET_RR .AND. ORAIN) CALL BUDGET (PRRS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RR,'SEDI_BU_RRR')
-IF (LBUDGET_SV) THEN
- IF (OSEDC) CALL BUDGET (PCCS(:,:,:)*PRHODJ(:,:,:),NBUDGET_SV1-1+NSV_LIMA_NC,'SEDI_BU_RSV')
- IF (ORAIN) CALL BUDGET (PCRS(:,:,:)*PRHODJ(:,:,:),NBUDGET_SV1-1+NSV_LIMA_NR,'SEDI_BU_RSV')
-END IF
+
+if ( lbudget_rc .and. osedc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'SEDI', prcs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rr .and. orain ) call Budget_store_end( tbudgets(NBUDGET_RR), 'SEDI', prrs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_sv ) then
+ if ( osedc ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'SEDI', pccs(:, :, :) * prhodj(:, :, :) )
+ if ( orain ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'SEDI', pcrs(:, :, :) * prhodj(:, :, :) )
+end if
!
! 2.bis Deposition at 1st level above ground
!
IF (LDEPOC) THEN
+ if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'DEPO', prcs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'DEPO', pccs(:, :, :) * prhodj(:, :, :) )
+
PINDEP(:,:)=0.
GDEP(:,:) = .FALSE.
GDEP(:,:) = PRCS(:,:,2) >0 .AND. PCCS(:,:,2) >0
@@ -342,9 +354,9 @@ IF (LDEPOC) THEN
PINPRC(:,:) = PINPRC(:,:) + XVDEPOC * PRCT(:,:,2) * PRHODREF(:,:,2) /XRHOLW
PINDEP(:,:) = XVDEPOC * PRCT(:,:,2) * PRHODREF(:,:,2) /XRHOLW
END WHERE
-!
- IF ( LBUDGET_RC ) CALL BUDGET (PRCS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RC, 'DEPO_BU_RRC')
- IF ( LBUDGET_SV ) CALL BUDGET (PCCS(:,:,:)*PRHODJ(:,:,:), NBUDGET_SV1-1+NSV_LIMA_NC, 'DEPO_BU_RSV')
+
+ if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'DEPO', prcs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'DEPO', pccs(:, :, :) * prhodj(:, :, :) )
END IF
!
!-------------------------------------------------------------------------------
@@ -353,23 +365,33 @@ END IF
! --------------------------------------
!
!
-IF (LACTI .AND. NMOD_CCN.GE.1) THEN
-!
- CALL LIMA_WARM_NUCL (OACTIT, PTSTEP, KMI, TPFILE, OCLOSE_OUT,&
+IF ( LACTI .AND. NMOD_CCN > 0 ) THEN
+ if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'HENU', pths(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rv ) call Budget_store_init( tbudgets(NBUDGET_RV), 'HENU', prvs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'HENU', prcs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'HENU', pccs(:, :, :) * prhodj(:, :, :) )
+ do jl = 1, nmod_ccn
+ idx = NBUDGET_SV1 - 1 + nsv_lima_ccn_free - 1 + jl
+ call Budget_store_init( tbudgets(idx), 'HENU', pnfs(:, :, :, jl) * prhodj(:, :, :) )
+ end do
+ end if
+
+ CALL LIMA_WARM_NUCL (OACTIT, PTSTEP, KMI, TPFILE, OCLOSE_OUT,&
PRHODREF, PEXNREF, PPABST, ZT, ZTM, PW_NU, &
PRCM, PRVT, PRCT, PRRT, &
PTHS, PRVS, PRCS, PCCS, PNFS, PNAS )
-!
- IF (LBUDGET_TH) CALL BUDGET (PTHS(:,:,:)*PRHODJ(:,:,:),NBUDGET_TH,'HENU_BU_RTH')
- IF (LBUDGET_RV) CALL BUDGET (PRVS(:,:,:)*PRHODJ(:,:,:),NBUDGET_RV,'HENU_BU_RRV')
- IF (LBUDGET_RC) CALL BUDGET (PRCS(:,:,:)*PRHODJ(:,:,:),NBUDGET_RC,'HENU_BU_RRC')
- IF (LBUDGET_SV) THEN
- CALL BUDGET (PCCS(:,:,:)*PRHODJ(:,:,:),NBUDGET_SV1-1+NSV_LIMA_NC,'HENU_BU_RSV') ! RCN
- DO JL=1, NMOD_CCN
- CALL BUDGET ( PNFS(:,:,:,JL)*PRHODJ(:,:,:),NBUDGET_SV1-1+NSV_LIMA_CCN_FREE+JL-1,'HENU_BU_RSV')
- END DO
- END IF
-!
+
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'HENU', pths(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rv ) call Budget_store_end( tbudgets(NBUDGET_RV), 'HENU', prvs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'HENU', prcs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'HENU', pccs(:, :, :) * prhodj(:, :, :) )
+ do jl = 1, nmod_ccn
+ idx = NBUDGET_SV1 - 1 + nsv_lima_ccn_free - 1 + jl
+ call Budget_store_end( tbudgets(idx), 'HENU', pnfs(:, :, :, jl) * prhodj(:, :, :) )
+ end do
+ end if
END IF ! LACTI
!
!
@@ -393,27 +415,34 @@ END IF ! LACTI
!
!
IF (ORAIN) THEN
-!
+
+ if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'REVA', pths(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rv ) call Budget_store_init( tbudgets(NBUDGET_RV), 'REVA', prvs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'REVA', prcs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'REVA', prrs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'REVA', pccs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'REVA', pcrs(:, :, :) * prhodj(:, :, :) )
+
CALL LIMA_WARM_EVAP (PTSTEP, KMI, &
PRHODREF, PEXNREF, PPABST, ZT, &
ZWLBDC3, ZWLBDC, ZWLBDR3, ZWLBDR, &
PRVT, PRCT, PRRT, PCRT, &
PRVS, PRCS, PRRS, PCCS, PCRS, PTHS, &
PEVAP3D )
-!
- IF (LBUDGET_RV) CALL BUDGET (PRVS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RV,'REVA_BU_RRV')
- IF (LBUDGET_RC) CALL BUDGET (PRCS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RC,'REVA_BU_RRC')
- IF (LBUDGET_RR) CALL BUDGET (PRRS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RR,'REVA_BU_RRR')
- IF (LBUDGET_TH) CALL BUDGET (PTHS(:,:,:)*PRHODJ(:,:,:), NBUDGET_TH,'REVA_BU_RTH')
- IF (LBUDGET_SV) CALL BUDGET (PCCS(:,:,:)*PRHODJ(:,:,:),NBUDGET_SV1-1+NSV_LIMA_NC,'REVA_BU_RSV')
- IF (LBUDGET_SV) CALL BUDGET (PCRS(:,:,:)*PRHODJ(:,:,:),NBUDGET_SV1-1+NSV_LIMA_NR,'REVA_BU_RSV')
-!
-!
+
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'REVA', pths(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rv ) call Budget_store_end( tbudgets(NBUDGET_RV), 'REVA', prvs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'REVA', prcs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'REVA', prrs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'REVA', pccs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'REVA', pcrs(:, :, :) * prhodj(:, :, :) )
!-------------------------------------------------------------------------------
!
! 5. SPONTANEOUS BREAK-UP (NUMERICAL FILTER)
! --------------------
!
+ if ( lbudget_sv ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'BRKU', pcrs(:, :, :) * prhodj(:, :, :) )
+
ZWLBDR(:,:,:) = 1.E10
WHERE (PRRS(:,:,:)>XRTMIN(3)/PTSTEP.AND.PCRS(:,:,:)>XCTMIN(3)/PTSTEP )
ZWLBDR3(:,:,:) = XLBR * PCRS(:,:,:) / PRRS(:,:,:)
@@ -425,11 +454,7 @@ IF (ORAIN) THEN
END WHERE
!
! Budget storage
- IF (LBUDGET_SV) &
- CALL BUDGET (PCRS(:,:,:)*PRHODJ(:,:,:),NBUDGET_SV1-1+NSV_LIMA_NR,&
- &'BRKU_BU_RSV')
-
-!
+ if ( lbudget_sv ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'BRKU', pcrs(:, :, :) * prhodj(:, :, :) )
ENDIF ! ORAIN
!
!------------------------------------------------------------------------------
diff --git a/src/MNH/lima_warm_coal.f90 b/src/MNH/lima_warm_coal.f90
index ff32fb82922bd0eb4cae1109b199538bc69d7dba..4ec69ac5823e786c1dc06b9149d655e772db9e40 100644
--- a/src/MNH/lima_warm_coal.f90
+++ b/src/MNH/lima_warm_coal.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 2013-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2013-2020 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.
@@ -95,24 +95,23 @@ END MODULE MODI_LIMA_WARM_COAL
!! -------------
!! Original ??/??/13
!! C. Barthe * LACy * jan. 2014 add budgets
-!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet 05/2016-04/2018: new data structures and calls for I/O
! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90
-!
+! P. Wautelet 02/2020: use the new data structures and subroutines for budgets (no more budget calls in this subroutine)
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_BUDGET
+use modd_budget, only: lbudget_rc, lbudget_rr, lbudget_sv, NBUDGET_RC, NBUDGET_RR, NBUDGET_SV1, tbudgets
USE MODD_NSV, ONLY: NSV_LIMA_NC, NSV_LIMA_NR
USE MODD_PARAMETERS, ONLY: JPHEXT, JPVEXT
USE MODD_PARAM_LIMA
USE MODD_PARAM_LIMA_WARM
+use mode_budget, only: Budget_store_init, Budget_store_end
use mode_tools, only: Countjv
-USE MODI_BUDGET
-
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
@@ -249,6 +248,8 @@ IF (LRAIN) THEN
! ------------------------------------
!
!
+ if ( lbudget_sv ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'SELF', pccs(:, :, :) * prhodj(:, :, :) )
+
GSELF(:) = ZCCT(:)>XCTMIN(2)
ISELF = COUNT(GSELF(:))
IF( ISELF>0 ) THEN
@@ -257,14 +258,10 @@ IF (LRAIN) THEN
ZCCS(:) = ZCCS(:) - MIN( ZCCS(:),ZZW1(:) )
END WHERE
END IF
-!
-!
- ZW(:,:,:) = PCCS(:,:,:)
- IF (LBUDGET_SV) CALL BUDGET ( &
- UNPACK(ZCCS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:))&
- &*PRHODJ(:,:,:),NBUDGET_SV1-1+NSV_LIMA_NC,'SELF_BU_RSV')
-!
-!
+
+ if ( lbudget_sv ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'SELF', &
+ Unpack( zccs(:), mask = gmicro(:, :, :), field = pccs(:, :, :) ) * prhodj(:, :, :) )
+
!-------------------------------------------------------------------------------
!
!
@@ -273,6 +270,13 @@ IF (LRAIN) THEN
!
!
!
+ if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'AUTO', prcs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'AUTO', prrs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_sv ) then
+ !call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'AUTO', pccs(:, :, :) * prhodj(:, :, :) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'AUTO', pcrs(:, :, :) * prhodj(:, :, :) )
+ end if
+
ZZW2(:) = 0.0
ZZW1(:) = 0.0
WHERE( ZRCT(:)>XRTMIN(2) )
@@ -292,28 +296,19 @@ IF (LRAIN) THEN
ZZW3(:) = ZZW3(:) * MAX( 0.0,ZZW1(:) )**3 / XAC
ZCRS(:) = ZCRS(:) + ZZW3(:)
END WHERE
-!
-!
- ZW(:,:,:) = PRCS(:,:,:)
- IF (LBUDGET_RC) CALL BUDGET ( &
- UNPACK(ZRCS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:)) &
- *PRHODJ(:,:,:), NBUDGET_RC,'AUTO_BU_RRC')
- ZW(:,:,:) = PRRS(:,:,:)
- IF (LBUDGET_RR) CALL BUDGET ( &
- UNPACK(ZRRS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:)) &
- *PRHODJ(:,:,:), NBUDGET_RR,'AUTO_BU_RRR')
- ZW(:,:,:) = PCRS(:,:,:)
- IF (LBUDGET_SV) THEN
- ZW(:,:,:) = PCRS(:,:,:)
- CALL BUDGET (UNPACK(ZCRS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:)) &
- *PRHODJ(:,:,:),NBUDGET_SV1-1+NSV_LIMA_NR,'AUTO_BU_RSV')
- ZW(:,:,:) = PCCS(:,:,:)
- CALL BUDGET (UNPACK(ZCCS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:)) &
- *PRHODJ(:,:,:),NBUDGET_SV1-1+NSV_LIMA_NC,'AUTO_BU_RSV')
- END IF
-!
-!
+ if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'AUTO', &
+ Unpack( zrcs(:), mask = gmicro(:, :, :), field = prcs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'AUTO', &
+ Unpack( zrrs(:), mask = gmicro(:, :, :), field = prrs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) then
+ !This budget is = 0 for nsv_lima_nc => not necessary to call it (ZCCS is not modified in this part)
+ !call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'AUTO', &
+ ! Unpack( zccs(:), mask = gmicro(:, :, :), field = pccs(:, :, :) ) * prhodj(:, :, :) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'AUTO', &
+ Unpack( zcrs(:), mask = gmicro(:, :, :), field = pcrs(:, :, :) ) * prhodj(:, :, :) )
+ end if
+
!-------------------------------------------------------------------------------
!
!
@@ -321,7 +316,7 @@ IF (LRAIN) THEN
! --------------------
!
!
- GACCR(:) = ZRRT(:)>XRTMIN(3) .AND. ZCRT(:)>XCTMIN(3)
+ GACCR(:) = ZRRT(:)>XRTMIN(3) .AND. ZCRT(:)>XCTMIN(3)
IACCR = COUNT(GACCR(:))
IF( IACCR>0 ) THEN
ALLOCATE(ZZW4(IMICRO)); ZZW4(:) = XACCR1/ZLBDR(:)
@@ -333,6 +328,12 @@ IF (LRAIN) THEN
!
IACCR = COUNT(GACCR(:))
IF( IACCR>0 ) THEN
+ if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'ACCR', &
+ Unpack( zrcs(:), mask = gmicro(:, :, :), field = prcs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'ACCR', &
+ Unpack( zrrs(:), mask = gmicro(:, :, :), field = prrs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'ACCR', &
+ Unpack( zccs(:), mask = gmicro(:, :, :), field = pccs(:, :, :) ) * prhodj(:, :, :) )
WHERE( GACCR(:).AND.(ZZW4(:)>1.E-4) ) ! Accretion for D>100 10-6 m
ZZW3(:) = ZLBDC3(:) / ZLBDR3(:)
ZZW1(:) = ( ZCCT(:)*ZCRT(:) / ZLBDC3(:) )*ZRHODREF(:)
@@ -358,23 +359,14 @@ IF (LRAIN) THEN
ZRCS(:) = ZRCS(:) - ZZW2(:)
ZRRS(:) = ZRRS(:) + ZZW2(:)
END WHERE
+
+ if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'ACCR', &
+ Unpack( zrcs(:), mask = gmicro(:, :, :), field = prcs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'ACCR', &
+ Unpack( zrrs(:), mask = gmicro(:, :, :), field = prrs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'ACCR', &
+ Unpack( zccs(:), mask = gmicro(:, :, :), field = pccs(:, :, :) ) * prhodj(:, :, :) )
END IF
-!
-!
- ZW(:,:,:) = PRCS(:,:,:)
- IF (LBUDGET_RC) CALL BUDGET ( &
- UNPACK(ZRCS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:)) &
- *PRHODJ(:,:,:), NBUDGET_RC,'ACCR_BU_RRC')
- ZW(:,:,:) = PRRS(:,:,:)
- IF (LBUDGET_RR) CALL BUDGET ( &
- UNPACK(ZRRS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:)) &
- *PRHODJ(:,:,:), NBUDGET_RR,'ACCR_BU_RRR')
- ZW(:,:,:) = PCCS(:,:,:)
- IF (LBUDGET_SV) CALL BUDGET ( &
- UNPACK(ZCCS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:)) &
- *PRHODJ(:,:,:),NBUDGET_SV1-1+NSV_LIMA_NC,'ACCR_BU_RSV')
-!
-!
!-------------------------------------------------------------------------------
!
!
@@ -389,6 +381,8 @@ IF (LRAIN) THEN
ISCBU = 0.0
END IF
IF( ISCBU>0 ) THEN
+ if ( lbudget_sv ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'SCBU', &
+ Unpack( zcrs(:), mask = gmicro(:, :, :), field = pcrs(:, :, :) ) * prhodj(:, :, :) )
!
!* 5.1 efficiencies
!
@@ -416,14 +410,9 @@ IF (LRAIN) THEN
END WHERE
ZCRS(:) = ZCRS(:) - MIN( ZCRS(:),ZZW3(:) * ZRHODREF(:) )
DEALLOCATE(ZSCBU)
+ if ( lbudget_sv ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'SCBU', &
+ Unpack( zcrs(:), mask = gmicro(:, :, :), field = pcrs(:, :, :) ) * prhodj(:, :, :) )
END IF
-!
-!
- ZW(:,:,:) = PCRS(:,:,:)
- IF (LBUDGET_SV) CALL BUDGET ( &
- UNPACK(ZCRS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:)) &
- *PRHODJ(:,:,:),NBUDGET_SV1-1+NSV_LIMA_NR,'SCBU_BU_RSV')
-!
END IF ! LRAIN
!
!
@@ -464,28 +453,6 @@ END IF ! LRAIN
DEALLOCATE(ZLBDC3)
DEALLOCATE(ZLBDR)
DEALLOCATE(ZLBDC)
-!
-!
-!-------------------------------------------------------------------------------
-!
-ELSE
-!* 7. Budgets are forwarded
-! ------------------------
-!
-!
- IF (LBUDGET_SV .AND. LRAIN) CALL BUDGET (PCCS(:,:,:)*PRHODJ(:,:,:), NBUDGET_SV1-1+NSV_LIMA_NC, 'SELF_BU_RSV')
-!
- IF (LBUDGET_RC .AND. LRAIN) CALL BUDGET (PRCS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RC, 'AUTO_BU_RRC')
- IF (LBUDGET_RR .AND. LRAIN) CALL BUDGET (PRRS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RR, 'AUTO_BU_RRR')
- IF (LBUDGET_SV .AND. LRAIN) CALL BUDGET (PCRS(:,:,:)*PRHODJ(:,:,:), NBUDGET_SV1-1+NSV_LIMA_NR, 'AUTO_BU_RSV')
- IF (LBUDGET_SV .AND. LRAIN) CALL BUDGET (PCCS(:,:,:)*PRHODJ(:,:,:), NBUDGET_SV1-1+NSV_LIMA_NC, 'AUTO_BU_RSV')
-!
- IF (LBUDGET_RC .AND. LRAIN) CALL BUDGET (PRCS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RC, 'ACCR_BU_RRC')
- IF (LBUDGET_RR .AND. LRAIN) CALL BUDGET (PRRS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RR, 'ACCR_BU_RRR')
- IF (LBUDGET_SV .AND. LRAIN) CALL BUDGET (PCCS(:,:,:)*PRHODJ(:,:,:), NBUDGET_SV1-1+NSV_LIMA_NC, 'ACCR_BU_RSV')
-!
- IF (LBUDGET_SV .AND. LRAIN) CALL BUDGET (PCRS(:,:,:)*PRHODJ(:,:,:), NBUDGET_SV1-1+NSV_LIMA_NR, 'SCBU_BU_RSV')
-
END IF ! IMICRO
!
!-------------------------------------------------------------------------------
diff --git a/src/MNH/modeln.f90 b/src/MNH/modeln.f90
index 0fa0909ad5b44896b7613266531241c7111598b3..bd89250169a983f88fb404b8f5902c9f0b2dd4e5 100644
--- a/src/MNH/modeln.f90
+++ b/src/MNH/modeln.f90
@@ -1615,8 +1615,10 @@ CALL MPPDB_CHECK3DM("before RAD_BOUND :XRU/V/WS",PRECISION,XRUS,XRVS,XRWS)
ZRUS=XRUS
ZRVS=XRVS
ZRWS=XRWS
-!
-if ( lbudget_u ) call Budget_store_init( tbudgets(NBUDGET_U), 'PRES', xrus )
+
+if ( lbudget_u ) call Budget_store_init( tbudgets(NBUDGET_U), 'PRES', xrus(:, :, :) )
+if ( lbudget_v ) call Budget_store_init( tbudgets(NBUDGET_V), 'PRES', xrvs(:, :, :) )
+if ( lbudget_w ) call Budget_store_init( tbudgets(NBUDGET_W), 'PRES', xrws(:, :, :) )
CALL RAD_BOUND (CLBCX,CLBCY,CTURB,XCARPKMAX, &
XTSTEP, &
diff --git a/src/MNH/nudging.f90 b/src/MNH/nudging.f90
index d65ad77ee1bfa21eefee0508da8dcd37bf732728..943a4f10355c4e2b20d1e4eb90982d0967d0be66 100644
--- a/src/MNH/nudging.f90
+++ b/src/MNH/nudging.f90
@@ -74,7 +74,7 @@ END MODULE MODI_NUDGING
!! MODIFICATIONS
!! -------------
!! Original 15/05/06
-! P. Wautelet 28/01/2020: use the new data structures and subroutines for budgets for U
+! P. Wautelet 02/2020: use the new data structures and subroutines for budgets
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -86,8 +86,6 @@ use modd_budget, only: lbudget_u, lbudget_v, lbudget_w, lbudget_th, lbudget_
use mode_budget, only: Budget_store_init, Budget_store_end
-USE MODI_BUDGET
-!
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
@@ -115,7 +113,11 @@ REAL :: ZINVTAU ! inverse of nudging time scale
!
ZINVTAU=1./PTNUDGING
-if ( lbudget_u ) call Budget_store_init( tbudgets(NBUDGET_U), 'NUD', prus )
+if ( lbudget_u ) call Budget_store_init( tbudgets(NBUDGET_U ), 'NUD', prus (:, :, :) )
+if ( lbudget_v ) call Budget_store_init( tbudgets(NBUDGET_V ), 'NUD', prvs (:, :, :) )
+if ( lbudget_w ) call Budget_store_init( tbudgets(NBUDGET_W ), 'NUD', prws (:, :, :) )
+if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'NUD', prths(:, :, :) )
+if ( lbudget_rv ) call Budget_store_init( tbudgets(NBUDGET_RV), 'NUD', prrs (:, :, :, 1) )
!
!* 1. NUGDGING TOWARDS LS FIELDS
! --------------------------
@@ -131,11 +133,10 @@ IF (OUSERV) &
!* 2. BUDGET CALLS
! ------------
!
-if ( lbudget_u ) call Budget_store_end( tbudgets(NBUDGET_U), 'NUD', prus )
+if ( lbudget_u ) call Budget_store_end( tbudgets(NBUDGET_U ), 'NUD', prus (:, :, :) )
+if ( lbudget_v ) call Budget_store_end( tbudgets(NBUDGET_V ), 'NUD', prvs (:, :, :) )
+if ( lbudget_w ) call Budget_store_end( tbudgets(NBUDGET_W ), 'NUD', prws (:, :, :) )
+if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'NUD', prths(:, :, :) )
+if ( lbudget_rv ) call Budget_store_end( tbudgets(NBUDGET_RV), 'NUD', prrs (:, :, :, 1) )
-IF (LBUDGET_V) CALL BUDGET (PRVS,NBUDGET_V,'NUD_BU_RV')
-IF (LBUDGET_W) CALL BUDGET (PRWS,NBUDGET_W,'NUD_BU_RW')
-IF (LBUDGET_TH) CALL BUDGET (PRTHS,NBUDGET_TH,'NUD_BU_RTH')
-IF (LBUDGET_RV) CALL BUDGET (PRRS(:,:,:,1),NBUDGET_RV,'NUD_BU_RRV')
-!
END SUBROUTINE NUDGING
diff --git a/src/MNH/num_diff.f90 b/src/MNH/num_diff.f90
index eb0f21630d5fcd6d3af803625722e046cef8ccb9..df99a7930a628eb1e5f36b802856900946605095 100644
--- a/src/MNH/num_diff.f90
+++ b/src/MNH/num_diff.f90
@@ -212,7 +212,7 @@ END MODULE MODI_NUM_DIFF
!! J.Escobar : 05/12/2017 : Pb SegFault , correct IF(ONUMDIFTH/OZDIFFU) nesting
! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
! J. Escobar 09/07/2019: add TTZHALO2*LIST structure, to match all cases of diffusion/U/TH activation T/F
-! P. Wautelet 28/01/2020: use the new data structures and subroutines for budgets for U
+! P. Wautelet 02/2020: use the new data structures and subroutines for budgets
!
!-------------------------------------------------------------------------------
!
@@ -233,7 +233,6 @@ use mode_budget, only: Budget_store_init, Budget_store_end
USE MODE_ll
USE MODE_TYPE_ZDIFFU
-USE MODI_BUDGET
USE MODI_SHUMAN
IMPLICIT NONE
@@ -304,7 +303,23 @@ IKU=SIZE(PUM,3)
!
GTKEALLOC = SIZE(PTKEM,1) /= 0
-if ( lbudget_u .and. onumdifu ) call Budget_store_init( tbudgets(NBUDGET_U), 'DIF', prus )
+if ( lbudget_u .and. onumdifu ) call Budget_store_init( tbudgets(NBUDGET_U ), 'DIF', prus (:, :, :) )
+if ( lbudget_v .and. onumdifu ) call Budget_store_init( tbudgets(NBUDGET_V ), 'DIF', prvs (:, :, :) )
+if ( lbudget_w .and. onumdifu ) call Budget_store_init( tbudgets(NBUDGET_W ), 'DIF', prws (:, :, :) )
+if ( lbudget_th .and. onumdifth ) call Budget_store_init( tbudgets(NBUDGET_TH ), 'DIF', prths (:, :, :) )
+if ( lbudget_tke .and. onumdifth ) call Budget_store_init( tbudgets(NBUDGET_TKE), 'DIF', prtkes(:, :, :) )
+if ( lbudget_rv .and. onumdifth ) call Budget_store_init( tbudgets(NBUDGET_RV ), 'DIF', prrs (:, :, :, 1) )
+if ( lbudget_rc .and. onumdifth ) call Budget_store_init( tbudgets(NBUDGET_RC ), 'DIF', prrs (:, :, :, 2) )
+if ( lbudget_rr .and. onumdifth ) call Budget_store_init( tbudgets(NBUDGET_RR ), 'DIF', prrs (:, :, :, 3) )
+if ( lbudget_ri .and. onumdifth ) call Budget_store_init( tbudgets(NBUDGET_RI ), 'DIF', prrs (:, :, :, 4) )
+if ( lbudget_rs .and. onumdifth ) call Budget_store_init( tbudgets(NBUDGET_RS ), 'DIF', prrs (:, :, :, 5) )
+if ( lbudget_rg .and. onumdifth ) call Budget_store_init( tbudgets(NBUDGET_RG ), 'DIF', prrs (:, :, :, 6) )
+if ( lbudget_rh .and. onumdifth ) call Budget_store_init( tbudgets(NBUDGET_RH ), 'DIF', prrs (:, :, :, 7) )
+if ( lbudget_sv .and. onumdifsv ) then
+ do jsv = 1, ksv
+ call Budget_store_init( tbudgets(jsv + NBUDGET_SV1 - 1), 'DIF', prsvs(:, :, :, jsv) )
+ end do
+end if
!-------------------------------------------------------------------------------
!
@@ -448,24 +463,24 @@ END IF
!* 3. STORES FIELDS IN BUDGET ARRAYS
! ------------------------------
!
-if ( lbudget_u .and. onumdifu ) call Budget_store_end( tbudgets(NBUDGET_U), 'DIF', prus )
-
-IF ( LBUDGET_V .AND. ONUMDIFU ) CALL BUDGET( PRVS, NBUDGET_V, 'DIF_BU_RV' )
-IF ( LBUDGET_W .AND. ONUMDIFU ) CALL BUDGET( PRWS, NBUDGET_W, 'DIF_BU_RW' )
-IF ( LBUDGET_TH .AND. ONUMDIFTH ) CALL BUDGET( PRTHS, NBUDGET_TH, 'DIF_BU_RTH' )
-IF ( LBUDGET_TKE .AND. ONUMDIFTH ) CALL BUDGET( PRTKES, NBUDGET_TKE, 'DIF_BU_RTKE' )
-IF ( LBUDGET_RV .AND. ONUMDIFTH ) CALL BUDGET( PRRS(:, :, :, 1 ), NBUDGET_RV, 'DIF_BU_RRV' )
-IF ( LBUDGET_RC .AND. ONUMDIFTH ) CALL BUDGET( PRRS(:, :, :, 2 ), NBUDGET_RC, 'DIF_BU_RRC' )
-IF ( LBUDGET_RR .AND. ONUMDIFTH ) CALL BUDGET( PRRS(:, :, :, 3 ), NBUDGET_RR, 'DIF_BU_RRR' )
-IF ( LBUDGET_RI .AND. ONUMDIFTH ) CALL BUDGET( PRRS(:, :, :, 4 ), NBUDGET_RI, 'DIF_BU_RRI' )
-IF ( LBUDGET_RS .AND. ONUMDIFTH ) CALL BUDGET( PRRS(:, :, :, 5 ), NBUDGET_RS, 'DIF_BU_RRS' )
-IF ( LBUDGET_RG .AND. ONUMDIFTH ) CALL BUDGET( PRRS(:, :, :, 6 ), NBUDGET_RG, 'DIF_BU_RRG' )
-IF ( LBUDGET_RH .AND. ONUMDIFTH ) CALL BUDGET( PRRS(:, :, :, 7 ), NBUDGET_RH, 'DIF_BU_RRH' )
-IF ( LBUDGET_SV .AND. ONUMDIFSV ) THEN
- DO JSV=1,KSV
- CALL BUDGET( PRSVS(:, :, :, JSV ), NBUDGET_SV1 - 1 + JSV, 'DIF_BU_RSV' )
- END DO
-END IF
+if ( lbudget_u .and. onumdifu ) call Budget_store_end( tbudgets(NBUDGET_U ), 'DIF', prus (:, :, :) )
+if ( lbudget_v .and. onumdifu ) call Budget_store_end( tbudgets(NBUDGET_V ), 'DIF', prvs (:, :, :) )
+if ( lbudget_w .and. onumdifu ) call Budget_store_end( tbudgets(NBUDGET_W ), 'DIF', prws (:, :, :) )
+if ( lbudget_th .and. onumdifth ) call Budget_store_end( tbudgets(NBUDGET_TH ), 'DIF', prths (:, :, :) )
+if ( lbudget_tke .and. onumdifth ) call Budget_store_end( tbudgets(NBUDGET_TKE), 'DIF', prtkes(:, :, :) )
+if ( lbudget_rv .and. onumdifth ) call Budget_store_end( tbudgets(NBUDGET_RV ), 'DIF', prrs (:, :, :, 1) )
+if ( lbudget_rc .and. onumdifth ) call Budget_store_end( tbudgets(NBUDGET_RC ), 'DIF', prrs (:, :, :, 2) )
+if ( lbudget_rr .and. onumdifth ) call Budget_store_end( tbudgets(NBUDGET_RR ), 'DIF', prrs (:, :, :, 3) )
+if ( lbudget_ri .and. onumdifth ) call Budget_store_end( tbudgets(NBUDGET_RI ), 'DIF', prrs (:, :, :, 4) )
+if ( lbudget_rs .and. onumdifth ) call Budget_store_end( tbudgets(NBUDGET_RS ), 'DIF', prrs (:, :, :, 5) )
+if ( lbudget_rg .and. onumdifth ) call Budget_store_end( tbudgets(NBUDGET_RG ), 'DIF', prrs (:, :, :, 6) )
+if ( lbudget_rh .and. onumdifth ) call Budget_store_end( tbudgets(NBUDGET_RH ), 'DIF', prrs (:, :, :, 7) )
+if ( lbudget_sv .and. onumdifsv ) then
+ do jsv = 1, ksv
+ call Budget_store_end( tbudgets(jsv + NBUDGET_SV1 - 1), 'DIF', prsvs(:, :, :, jsv) )
+ end do
+end if
+
!-------------------------------------------------------------------------------
!
!
diff --git a/src/MNH/phys_paramn.f90 b/src/MNH/phys_paramn.f90
index 70d3fb4411aa6ae6e3fd8f2064de5efe09b16d68..016a04fdb729dc6f9a967a611536571d05d40f0a 100644
--- a/src/MNH/phys_paramn.f90
+++ b/src/MNH/phys_paramn.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1995-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1995-2020 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.
@@ -240,107 +240,104 @@ END MODULE MODI_PHYS_PARAM_n
!
!* 0. DECLARATIONS
! ------------
-!
-USE MODE_DATETIME
-USE MODE_ll
-USE MODD_ARGSLIST_ll, ONLY : LIST_ll
!
+USE MODD_ADV_n, ONLY : XRTKEMS
+USE MODD_ARGSLIST_ll, ONLY : LIST_ll
USE MODD_BLANK
-USE MODD_CST
-USE MODD_DYN
+use modd_budget, only: lbudget_th, lbudget_rv, lbudget_rc, lbudget_ri, lbudget_sv, &
+ NBUDGET_TH, NBUDGET_RV, NBUDGET_RC, NBUDGET_RI, NBUDGET_SV1, &
+ tbudgets, xtime_bu_process
+USE MODD_CH_AEROSOL
+USE MODD_CH_MNHC_n, ONLY : LUSECHEM, &! indicates if chemistry is used
+ LCH_CONV_SCAV, &
+ LCH_CONV_LINOX
+USE MODD_CLOUD_MF_n
+USE MODD_CONDSAMP
USE MODD_CONF
-USE MODD_FRC
-USE MODD_IO, ONLY: TFILEDATA
-USE MODD_PARAMETERS
-USE MODD_GRID
-USE MODD_NSV
-USE MODD_LES
-USE MODD_LES_BUDGET
-!
USE MODD_CONF_n
+USE MODD_CST
USE MODD_CURVCOR_n
+USE MODD_DEEP_CONVECTION_n
+USE MODD_DEF_EDDY_FLUX_n ! Ajout PP
+USE MODD_DEF_EDDYUV_FLUX_n ! Ajout PP
+USE MODD_DRAGTREE
+USE MODD_DUST
+USE MODD_DYN
USE MODD_DYN_n
USE MODD_FIELD_n
-USE MODD_LSFIELD_n
+USE MODD_FRC
+USE MODD_GRID
USE MODD_GRID_n
-USE MODD_METRICS_n
+USE MODD_ICE_C1R3_DESCR, ONLY : XRTMIN_C1R3=>XRTMIN
+USE MODD_IO, ONLY: TFILEDATA
+USE MODD_LATZ_EDFLX
USE MODD_LBC_n
-USE MODD_REF_n
+USE MODD_LES
+USE MODD_LES_BUDGET
+USE MODD_LSFIELD_n
USE MODD_LUNIT_n
+USE MODD_METRICS_n
+USE MODD_MNH_SURFEX_n
+USE MODD_NESTING, ONLY : XWAY,NDAD, NDXRATIO_ALL, NDYRATIO_ALL
+USE MODD_NSV
USE MODD_OUT_n
+USE MODD_PARAM_C2R2, ONLY : LSEDC
+USE MODD_PARAMETERS
+USE MODD_PARAM_ICE, ONLY : LSEDIC
+USE MODD_PARAM_KAFR_n
+USE MODD_PARAM_LIMA, ONLY : MSEDC => LSEDC, XRTMIN_LIMA=>XRTMIN
+USE MODD_PARAM_MFSHALL_n
USE MODD_PARAM_n
USE MODD_PARAM_RAD_n
-USE MODD_PARAM_KAFR_n
+USE MODD_PASPOL
+USE MODD_PASPOL_n
+USE MODD_PRECIP_n
+use modd_precision, only: MNHTIME
USE MODD_RADIATIONS_n
+USE MODD_RAIN_ICE_DESCR, ONLY : XRTMIN
+USE MODD_REF_n
+USE MODD_SALT
USE MODD_SHADOWS_n
-USE MODD_DEEP_CONVECTION_n
+USE MODD_SUB_PHYS_PARAM_n
USE MODD_TIME_n
-USE MODD_TURB_n
-USE MODD_CH_MNHC_n, ONLY : LUSECHEM, &! indicates if chemistry is used
- LCH_CONV_SCAV, &
- LCH_CONV_LINOX
-USE MODD_PRECIP_n
-USE MODD_PASPOL_n
-USE MODD_BUDGET
-USE MODD_RAIN_ICE_DESCR, ONLY : XRTMIN
-USE MODD_ICE_C1R3_DESCR, ONLY : XRTMIN_C1R3=>XRTMIN
+USE MODD_TIME_n
+USE MODD_TIME, ONLY : TDTEXP ! Ajout PP
USE MODD_TURB_CLOUD, ONLY : CTURBLEN_CLOUD,NMODEL_CLOUD, &
XCEI,XCEI_MIN,XCEI_MAX,XCOEF_AMPL_SAT
-USE MODD_NESTING, ONLY : XWAY,NDAD, NDXRATIO_ALL, NDYRATIO_ALL
-USE MODD_PARAM_ICE, ONLY : LSEDIC
-USE MODD_PARAM_C2R2, ONLY : LSEDC
-USE MODD_SUB_PHYS_PARAM_n
-!
-USE MODD_PARAM_MFSHALL_n
-USE MODI_SHALLOW_MF_PACK
-USE MODD_CLOUD_MF_n
-USE MODD_ADV_n, ONLY : XRTKEMS
-use modd_precision, only: MNHTIME
-!
-USE MODI_SURF_RAD_MODIF
-USE MODI_GROUND_PARAM_n
-USE MODI_TURB
-USE MODI_SUNPOS_n
-USE MODI_RADIATIONS
-USE MODI_CONVECTION
-USE MODI_BUDGET
-USE MODI_PASPOL
-USE MODI_CONDSAMP
-USE MODE_MODELN_HANDLER
-USE MODI_SEDIM_DUST
-USE MODI_SEDIM_SALT
-USE MODI_DUST_FILTER
-USE MODI_SALT_FILTER
-USE MODI_DRAG_VEG
-USE MODD_DUST
-USE MODD_SALT
-USE MODD_PASPOL
-USE MODD_CONDSAMP
-USE MODD_CH_AEROSOL
-USE MODE_DUST_PSD
-USE MODE_SALT_PSD
+USE MODD_TURB_FLUX_AIRCRAFT_BALLOON, ONLY : XTHW_FLUX, XRCW_FLUX, XSVW_FLUX
+USE MODD_TURB_n
+
USE MODE_AERO_PSD
+use mode_budget, only: Budget_store_end, Budget_store_init
+USE MODE_DATETIME
+USE MODE_DUST_PSD
+USE MODE_ll
USE MODE_MNH_TIMING
-USE MODD_TURB_FLUX_AIRCRAFT_BALLOON, ONLY : XTHW_FLUX, XRCW_FLUX, XSVW_FLUX
-USE MODD_DRAGTREE
-!
-USE MODD_TIME, ONLY : TDTEXP ! Ajout PP
+USE MODE_MODELN_HANDLER
+USE MODE_MPPDB
+USE MODE_SALT_PSD
+
USE MODI_AEROZON ! Ajout PP
-!
+USE MODI_CONDSAMP
+USE MODI_CONVECTION
+USE MODI_DRAG_VEG
+USE MODI_DUST_FILTER
USE MODI_EDDY_FLUX_n ! Ajout PP
-USE MODI_EDDYUV_FLUX_n ! Ajout PP
USE MODI_EDDY_FLUX_ONE_WAY_n ! Ajout PP
+USE MODI_EDDYUV_FLUX_n ! Ajout PP
USE MODI_EDDYUV_FLUX_ONE_WAY_n ! Ajout PP
-USE MODD_DEF_EDDY_FLUX_n ! Ajout PP
-USE MODD_DEF_EDDYUV_FLUX_n ! Ajout PP
-USE MODD_LATZ_EDFLX
-USE MODD_MNH_SURFEX_n
+USE MODI_GROUND_PARAM_n
+USE MODI_PASPOL
+USE MODI_RADIATIONS
+USE MODI_SALT_FILTER
+USE MODI_SEDIM_DUST
+USE MODI_SEDIM_SALT
+USE MODI_SHALLOW_MF_PACK
+USE MODI_SUNPOS_n
+USE MODI_SURF_RAD_MODIF
USE MODI_SWITCH_SBG_LES_N
-USE MODD_TIME_n
-!
-USE MODD_PARAM_LIMA, ONLY : MSEDC => LSEDC, XRTMIN_LIMA=>XRTMIN
-!
-USE MODE_MPPDB
+USE MODI_TURB
+
IMPLICIT NONE
!
!* 0.1 declarations of arguments
@@ -446,7 +443,7 @@ REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZSAVE_INPRC,ZSAVE_PRCONV,ZSAVE_PRSCONV
REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZSAVE_DIRFLASWD, ZSAVE_SCAFLASWD,ZSAVE_DIRSRFSWD
!
!-----------------------------------------------------------------------------
-!
+
NULLIFY(TZFIELDS_ll)
IMI=GET_CURRENT_MODEL_INDEX()
!
@@ -784,14 +781,11 @@ END IF
! ------------------------------
!
IF (CRAD /='NONE') THEN
+ if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'RAD', xrths(:, :, :) )
XRTHS(:,:,:) = XRTHS(:,:,:) + XRHODJ(:,:,:)*XDTHRAD(:,:,:)
+ if ( lbudget_th ) call Budget_store_end ( tbudgets(NBUDGET_TH), 'RAD', xrths(:, :, :) )
END IF
!
-!* 1.6 budget storage
-! --------------
-!
-IF (CRAD/='NONE' .AND. LBUDGET_TH) CALL BUDGET (XRTHS,NBUDGET_TH,'RAD_BU_RTH')
-!
CALL SECOND_MNH2(ZTIME2)
!
PRAD = PRAD + ZTIME2 - ZTIME1 &
@@ -811,7 +805,17 @@ XTIME_LES_BU_PROCESS = 0.
!
CALL SECOND_MNH2(ZTIME1)
!
-IF( CDCONV /= 'NONE' .OR. CSCONV == 'KAFR' ) THEN
+IF( CDCONV == 'KAFR' .OR. CSCONV == 'KAFR' ) THEN
+
+ if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'DCONV', xrths(:, :, :) )
+ if ( lbudget_rv ) call Budget_store_init( tbudgets(NBUDGET_RV), 'DCONV', xrrs (:, :, :, 1) )
+ if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'DCONV', xrrs (:, :, :, 2) )
+ if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'DCONV', xrrs (:, :, :, 4) )
+ if ( lbudget_sv .and. lchtrans ) then
+ do jsv = 1, size( xrsvs, 4 )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + jsv), 'DCONV', xrsvs (:, :, :, jsv) )
+ end do
+ end if
!
! test to see if the deep convection scheme should be called
!
@@ -1045,21 +1049,17 @@ END IF
XRTHS(:,:,:) = XRTHS(:,:,:) - XRHODJ(:,:,:) / XCPD * ( &
XLVTT * XDRCCONV(:,:,:) + XLSTT * XDRICONV(:,:,:) ) *&
( XP00 / XPABST(:,:,:) ) ** ( XRD / XCPD )
- END IF
-END IF
-!
-! budget storage
-!
-IF (CDCONV == 'KAFR' .OR. CSCONV == 'KAFR' ) THEN
- IF (LBUDGET_TH) CALL BUDGET (XRTHS,NBUDGET_TH,'DCONV_BU_RTH')
- IF (LBUDGET_RV) CALL BUDGET (XRRS(:,:,:,1),NBUDGET_RV,'DCONV_BU_RRV')
- IF (LBUDGET_RC) CALL BUDGET (XRRS(:,:,:,2),NBUDGET_RC,'DCONV_BU_RRC')
- IF (LBUDGET_RI) CALL BUDGET (XRRS(:,:,:,4),NBUDGET_RI,'DCONV_BU_RRI')
- IF (LCHTRANS .AND. LBUDGET_SV) THEN
- DO JSV = 1, SIZE(XRSVS,4)
- CALL BUDGET (XRSVS(:,:,:,JSV),NBUDGET_SV1-1+JSV,'DCONV_BU_RSV')
- END DO
END IF
+
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'DCONV', xrths(:, :, :) )
+ if ( lbudget_rv ) call Budget_store_end( tbudgets(NBUDGET_RV), 'DCONV', xrrs (:, :, :, 1) )
+ if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'DCONV', xrrs (:, :, :, 2) )
+ if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'DCONV', xrrs (:, :, :, 4) )
+ if ( lbudget_sv .and. lchtrans ) then
+ do jsv = 1, size( xrsvs, 4 )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + jsv), 'DCONV', xrsvs (:, :, :, jsv) )
+ end do
+ end if
END IF
!
CALL SECOND_MNH2(ZTIME2)
diff --git a/src/MNH/pressure.f90 b/src/MNH/pressure.f90
index def6e23709f4238a9506f4a8fbc84bfdd9685ba1..b64d1d913590da9ae17381cad6a7dc986ec01aae 100644
--- a/src/MNH/pressure.f90
+++ b/src/MNH/pressure.f90
@@ -221,7 +221,6 @@ USE MODI_CONRESOL
USE MODI_GRADIENT_M
USE MODI_SHUMAN
USE MODI_P_ABS
-USE MODI_BUDGET
!
USE MODD_ARGSLIST_ll, ONLY : LIST_ll
@@ -366,7 +365,9 @@ ZPABS_N(:,:) = 0.
ZPABS_E(:,:) = 0.
ZPABS_W(:,:) = 0.
-! if ( lbudget_u ) call Budget_store_init( tbudgets(NBUDGET_U), 'PRES', prus )
+! if ( lbudget_u ) call Budget_store_init( tbudgets(NBUDGET_U), 'PRES', prus(:, :, :) )
+! if ( lbudget_v ) call Budget_store_init( tbudgets(NBUDGET_V), 'PRES', prvs(:, :, :) )
+! if ( lbudget_w ) call Budget_store_init( tbudgets(NBUDGET_W), 'PRES', prws(:, :, :) )
!-------------------------------------------------------------------------------
!
@@ -614,10 +615,9 @@ ENDIF
!* 7. STORAGE OF THE FIELDS IN BUDGET ARRAYS
! --------------------------------------
!
-if ( lbudget_u ) call Budget_store_end( tbudgets(NBUDGET_U), 'PRES', prus )
-
-IF (LBUDGET_V) CALL BUDGET (PRVS,NBUDGET_V,'PRES_BU_RV')
-IF (LBUDGET_W) CALL BUDGET (PRWS,NBUDGET_W,'PRES_BU_RW')
+if ( lbudget_u ) call Budget_store_end( tbudgets(NBUDGET_U), 'PRES', prus(:, :, :) )
+if ( lbudget_v ) call Budget_store_end( tbudgets(NBUDGET_V), 'PRES', prvs(:, :, :) )
+if ( lbudget_w ) call Budget_store_end( tbudgets(NBUDGET_W), 'PRES', prws(:, :, :) )
!
!-------------------------------------------------------------------------------
!
diff --git a/src/MNH/pressurez.f90 b/src/MNH/pressurez.f90
index 72e24f8ad5f6b76c5b9a4cdff588439e8c1fb81b..ba64b6d964666b0c7150a4c1c909e90533d0feb0 100644
--- a/src/MNH/pressurez.f90
+++ b/src/MNH/pressurez.f90
@@ -405,7 +405,9 @@ ZPABS_E(:,:) = 0.
ZPABS_W(:,:) = 0.
! Done in model_n before call to Rad_bound
-! if ( lbudget_u ) call Budget_store_init( tbudgets(NBUDGET_U), 'PRES', prus )
+! if ( lbudget_u ) call Budget_store_init( tbudgets(NBUDGET_U), 'PRES', prus(:, :, :) )
+! if ( lbudget_v ) call Budget_store_init( tbudgets(NBUDGET_V), 'PRES', prvs(:, :, :) )
+! if ( lbudget_w ) call Budget_store_init( tbudgets(NBUDGET_W), 'PRES', prws(:, :, :) )
!-------------------------------------------------------------------------------
!
@@ -681,10 +683,9 @@ ENDIF
!* 7. STORAGE OF THE FIELDS IN BUDGET ARRAYS
! --------------------------------------
!
-if ( lbudget_u ) call Budget_store_end( tbudgets(NBUDGET_U), 'PRES', prus )
-
-IF (LBUDGET_V) CALL BUDGET (PRVS,NBUDGET_V,'PRES_BU_RV')
-IF (LBUDGET_W) CALL BUDGET (PRWS,NBUDGET_W,'PRES_BU_RW')
+if ( lbudget_u ) call Budget_store_end( tbudgets(NBUDGET_U), 'PRES', prus(:, :, :) )
+if ( lbudget_v ) call Budget_store_end( tbudgets(NBUDGET_V), 'PRES', prvs(:, :, :) )
+if ( lbudget_w ) call Budget_store_end( tbudgets(NBUDGET_W), 'PRES', prws(:, :, :) )
!
!-------------------------------------------------------------------------------
!
diff --git a/src/MNH/rain_c2r2_khko.f90 b/src/MNH/rain_c2r2_khko.f90
index edf07222d71ebb35983dfab5777dad41570e1cfd..715a8cba57738c0fc64309a347ad41393e70a204 100644
--- a/src/MNH/rain_c2r2_khko.f90
+++ b/src/MNH/rain_c2r2_khko.f90
@@ -215,12 +215,15 @@ END MODULE MODI_RAIN_C2R2_KHKO
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90
+! P. Wautelet 02/2020: use the new data structures and subroutines for budgets
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_BUDGET
+use modd_budget, only: lbudget_th, lbudget_rv, lbudget_rc, lbudget_rr, lbudget_sv, &
+ NBUDGET_TH, NBUDGET_RV, NBUDGET_RC, NBUDGET_RR, NBUDGET_SV1, &
+ tbudgets
USE MODD_CH_AEROSOL
USE MODD_CONF
USE MODD_CST
@@ -234,13 +237,13 @@ USE MODD_RAIN_C2R2_DESCR
USE MODD_RAIN_C2R2_KHKO_PARAM
USE MODD_SALT
+use mode_budget, only: Budget_store_init, Budget_store_end
USE MODE_IO_FIELD_WRITE, only: IO_Field_write
USE MODE_ll
use mode_tools, only: Countjv
-USE MODI_BUDGET
USE MODI_GAMMA
-!
+
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
@@ -502,6 +505,8 @@ IF (ORAIN) THEN
! 5. SPONTANEOUS BREAK-UP (NUMERICAL FILTER)
! --------------------
!
+ if ( lbudget_sv ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_c2r2beg + 2), 'BRKU', pcrs(:, :, :) * prhodj(:, :, :) )
+
ZWLBDR(:,:,:) = 1.E10
WHERE (PRRS(:,:,:)>0.0.AND.PCRS(:,:,:)>0.0 )
ZWLBDR3(:,:,:) = XLBR * PCRS(:,:,:) / (PRHODREF(:,:,:) * PRRS(:,:,:))
@@ -511,13 +516,9 @@ IF (ORAIN) THEN
PCRS(:,:,:) = PCRS(:,:,:)*MAX((1.+XSPONCOEF2*(XACCR1/ZWLBDR(:,:,:)-XSPONBUD1)**2),&
(XACCR1/ZWLBDR(:,:,:)/XSPONBUD3)**3)
END WHERE
-!
+
+ if ( lbudget_sv ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_c2r2beg + 2), 'BRKU', pcrs(:, :, :) * prhodj(:, :, :) )
ENDIF
-!
-IF (LBUDGET_SV) &
- CALL BUDGET (PCRS(:,:,:)*PRHODJ(:,:,:),NBUDGET_SV1-1+NSV_C2R2BEG+2,&
- &'BRKU_BU_RSV') ! RCR
-
!-------------------------------------------------------------------------------
!* 6. COMPUTE THE SEDIMENTATION (RS) SOURCE
! -------------------------------------
@@ -575,6 +576,15 @@ INTEGER :: JL ! and PACK intrinsics
INTEGER :: J1
!
!-------------------------------------------------------------------------------
+
+if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'HENU', pths(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rv ) call Budget_store_init( tbudgets(NBUDGET_RV), 'HENU', prvs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'HENU', prcs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_c2r2beg ), 'HENU', pcns(:, :, :) * prhodj(:, :, :) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_c2r2beg + 1), 'HENU', pccs(:, :, :) * prhodj(:, :, :) )
+end if
+
! Modification of XCHEN according to theta vertical gradient (J. Rangonio)
!ZZA(:,:,2) = 1.
!DO JK=IKB,IKE-1
@@ -888,14 +898,14 @@ END IF
!
!* 3.4 budget storage
!
-IF (LBUDGET_TH) CALL BUDGET (PTHS(:,:,:)*PRHODJ(:,:,:),NBUDGET_TH,'HENU_BU_RTH')
-IF (LBUDGET_RV) CALL BUDGET (PRVS(:,:,:)*PRHODJ(:,:,:),NBUDGET_RV,'HENU_BU_RRV')
-IF (LBUDGET_RC) CALL BUDGET (PRCS(:,:,:)*PRHODJ(:,:,:),NBUDGET_RC,'HENU_BU_RRC')
-IF (LBUDGET_SV) THEN
- CALL BUDGET (PCNS(:,:,:)*PRHODJ(:,:,:),NBUDGET_SV1-1+NSV_C2R2BEG, 'HENU_BU_RSV') ! RCN
- CALL BUDGET (PCCS(:,:,:)*PRHODJ(:,:,:),NBUDGET_SV1-1+NSV_C2R2BEG+2,'HENU_BU_RSV') ! RCC
-END IF
-!
+if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'HENU', pths(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rv ) call Budget_store_end( tbudgets(NBUDGET_RV), 'HENU', prvs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'HENU', prcs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_c2r2beg ), 'HENU', pcns(:, :, :) * prhodj(:, :, :) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_c2r2beg + 1), 'HENU', pccs(:, :, :) * prhodj(:, :, :) )
+end if
+
END SUBROUTINE C2R2_KHKO_NUCLEATION
!
!-------------------------------------------------------------------------------
@@ -920,6 +930,14 @@ INTEGER :: J1
INTEGER :: JSV
!
!-------------------------------------------------------------------------------
+
+if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'HENU', pths(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rv ) call Budget_store_init( tbudgets(NBUDGET_RV), 'HENU', prvs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'HENU', prcs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_c2r2beg ), 'HENU', pcns(:, :, :) * prhodj(:, :, :) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_c2r2beg + 1), 'HENU', pccs(:, :, :) * prhodj(:, :, :) )
+end if
!
! compute the saturation vapor mixing ratio
! the radiative tendency
@@ -1088,13 +1106,13 @@ END IF
!* budget storage
!
!
-IF (LBUDGET_TH) CALL BUDGET (PTHS(:,:,:)*PRHODJ(:,:,:),NBUDGET_TH,'HENU_BU_RTH')
-IF (LBUDGET_RV) CALL BUDGET (PRVS(:,:,:)*PRHODJ(:,:,:),NBUDGET_RV,'HENU_BU_RRV')
-IF (LBUDGET_RC) CALL BUDGET (PRCS(:,:,:)*PRHODJ(:,:,:),NBUDGET_RC,'HENU_BU_RRC')
-IF (LBUDGET_SV) THEN
- CALL BUDGET (PCNS(:,:,:)*PRHODJ(:,:,:),NBUDGET_SV1-1+NSV_C2R2BEG, 'HENU_BU_RSV') ! RCN
- CALL BUDGET (PCCS(:,:,:)*PRHODJ(:,:,:),NBUDGET_SV1-1+NSV_C2R2BEG+1,'HENU_BU_RSV') ! RCC
-END IF
+if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'HENU', pths(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rv ) call Budget_store_end( tbudgets(NBUDGET_RV), 'HENU', prvs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'HENU', prcs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_c2r2beg ), 'HENU', pcns(:, :, :) * prhodj(:, :, :) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_c2r2beg + 1), 'HENU', pccs(:, :, :) * prhodj(:, :, :) )
+end if
END SUBROUTINE AER_NUCLEATION
!
@@ -1163,6 +1181,8 @@ IF( IMICRO >= 1 ) THEN
!
!* 4.1 Self-collection of cloud droplets
!
+ if ( lbudget_sv ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_c2r2beg + 1), 'SELF', pccs(:, :, :) * prhodj(:, :, :) )
+
GSELF(:) = ZCCT(:)>XCTMIN(2)
ISELF = COUNT(GSELF(:))
IF( ISELF>0 ) THEN
@@ -1171,15 +1191,17 @@ IF( IMICRO >= 1 ) THEN
ZCCS(:) = ZCCS(:) - MIN( ZCCS(:),ZZW1(:) )
END WHERE
END IF
-!
- ZW(:,:,:) = PCCS(:,:,:)
- IF (LBUDGET_SV) CALL BUDGET ( &
- UNPACK(ZCCS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:))&
- &*PRHODJ(:,:,:),NBUDGET_SV1-1+NSV_C2R2BEG+1,'SELF_BU_RSV') ! RCC
+
+ if ( lbudget_sv ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_c2r2beg + 1), 'SELF', &
+ Unpack( zccs(:), mask = gmicro(:, :, :), field = pccs(:, :, :) ) * prhodj(:, :, :) )
!
!* 4.2 Autoconversion of cloud droplets
! using a Berry-Reinhardt parameterization
!
+ if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'AUTO', prcs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RR), 'AUTO', prrs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_c2r2beg + 2), 'AUTO', pcrs(:, :, :) * prhodj(:, :, :) )
+
ZZW2(:) = 0.0
ZZW1(:) = 0.0
WHERE( ZRCT(:)>XRTMIN(2) )
@@ -1199,25 +1221,23 @@ IF( IMICRO >= 1 ) THEN
ZZW3(:) = ZZW3(:) * ZRHODREF(:)**2 * MAX( 0.0,ZZW1(:) )**3 / XAC
ZCRS(:) = ZCRS(:) + ZZW3(:)
END WHERE
-!
- ZW(:,:,:) = PRCS(:,:,:)
- IF (LBUDGET_RC) CALL BUDGET ( &
- UNPACK(ZRCS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:)) &
- *PRHODJ(:,:,:), NBUDGET_RC,'AUTO_BU_RRC')
-
- ZW(:,:,:) = PRRS(:,:,:)
- IF (LBUDGET_RR) CALL BUDGET ( &
- UNPACK(ZRRS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:)) &
- *PRHODJ(:,:,:), NBUDGET_RR,'AUTO_BU_RRR')
- ZW(:,:,:) = PCRS(:,:,:)
- IF (LBUDGET_SV) CALL BUDGET ( &
- UNPACK(ZCRS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:)) &
- &*PRHODJ(:,:,:),NBUDGET_SV1-1+NSV_C2R2BEG+2,'AUTO_BU_RSV') ! RCR
+ if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'AUTO', &
+ Unpack( zrcs(:), mask = gmicro(:, :, :), field = prcs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'AUTO', &
+ Unpack( zrrs(:), mask = gmicro(:, :, :), field = prrs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_c2r2beg + 2), 'AUTO', &
+ Unpack( zcrs(:), mask = gmicro(:, :, :), field = pcrs(:, :, :) ) * prhodj(:, :, :) )
!
!
!* 4.3 Accretion sources
!
+ if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'ACCR', &
+ Unpack( zrcs(:), mask = gmicro(:, :, :), field = prcs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'ACCR', &
+ Unpack( zrrs(:), mask = gmicro(:, :, :), field = prrs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_c2r2beg + 1), 'ACCR', &
+ Unpack( zccs(:), mask = gmicro(:, :, :), field = pccs(:, :, :) ) * prhodj(:, :, :) )
!
!* 4.31 test the criterium Df>Dh or Nr>Nrm
!
@@ -1259,23 +1279,19 @@ IF( IMICRO >= 1 ) THEN
ZRRS(:) = ZRRS(:) + ZZW2(:)
END WHERE
END IF
-!
- ZW(:,:,:) = PRCS(:,:,:)
- IF (LBUDGET_RC) CALL BUDGET ( &
- UNPACK(ZRCS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:)) &
- *PRHODJ(:,:,:), NBUDGET_RC,'ACCR_BU_RRC')
- ZW(:,:,:) = PRRS(:,:,:)
- IF (LBUDGET_RR) CALL BUDGET ( &
- UNPACK(ZRRS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:)) &
- *PRHODJ(:,:,:), NBUDGET_RR,'ACCR_BU_RRR')
- ZW(:,:,:) = PCCS(:,:,:)
- IF (LBUDGET_SV) CALL BUDGET ( &
- UNPACK(ZCCS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:)) &
- *PRHODJ(:,:,:),NBUDGET_SV1-1+NSV_C2R2BEG+1,'ACCR_BU_RSV') ! RCC
+ if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'ACCR', &
+ Unpack( zrcs(:), mask = gmicro(:, :, :), field = prcs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'ACCR', &
+ Unpack( zrrs(:), mask = gmicro(:, :, :), field = prrs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_c2r2beg + 1), 'ACCR', &
+ Unpack( zccs(:), mask = gmicro(:, :, :), field = pccs(:, :, :) ) * prhodj(:, :, :) )
!
!* 4.4 Self collection - Coalescence/Break-up
!
+ if ( lbudget_sv ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_c2r2beg + 2), 'SCBU', &
+ Unpack( zcrs(:), mask = gmicro(:, :, :), field = pcrs(:, :, :) ) * prhodj(:, :, :) )
+
IF( IACCR>0 ) THEN
GSCBU(:) = ZCRT(:)>XCTMIN(3) .AND. GENABLE_ACCR_SCBU(:)
ISCBU = COUNT(GSCBU(:))
@@ -1321,10 +1337,9 @@ IF( IMICRO >= 1 ) THEN
PCCS(:,:,:) = UNPACK( ZCCS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
ZW(:,:,:) = PCRS(:,:,:)
PCRS(:,:,:) = UNPACK( ZCRS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
-!
- IF (LBUDGET_SV) CALL BUDGET(PCRS(:,:,:)*PRHODJ(:,:,:)&
- &,NBUDGET_SV1-1+NSV_C2R2BEG+2,'SCBU_BU_RSV') ! RCR
-!
+
+ if ( lbudget_sv ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_c2r2beg + 2), 'SCBU', pcrs(:, :, :) * prhodj(:, :, :) )
+
DEALLOCATE(ZRCT)
DEALLOCATE(ZRRT)
DEALLOCATE(ZCCT)
@@ -1350,25 +1365,6 @@ IF( IMICRO >= 1 ) THEN
DEALLOCATE(IVEC1)
DEALLOCATE(ZVEC1)
END IF
-ELSE
-!
-!* 4.5 Budgets are forwarded
-!
- IF (LBUDGET_SV) CALL BUDGET (PCCS(:,:,:)*PRHODJ(:,:,:), NBUDGET_SV1-1+NSV_C2R2BEG+1,&
- &'SELF_BU_RSV') ! RCC
-!
- IF (LBUDGET_RC) CALL BUDGET (PRCS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RC,'AUTO_BU_RRC')
- IF (LBUDGET_RR) CALL BUDGET (PRRS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RR,'AUTO_BU_RRR')
- IF (LBUDGET_SV) CALL BUDGET (PCRS(:,:,:)*PRHODJ(:,:,:), NBUDGET_SV1-1+NSV_C2R2BEG+2,&
- &'AUTO_BU_RSV') ! RCR
-!
- IF (LBUDGET_RC) CALL BUDGET (PRCS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RC,'ACCR_BU_RRC')
- IF (LBUDGET_RR) CALL BUDGET (PRRS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RR,'ACCR_BU_RRR')
- IF (LBUDGET_SV) CALL BUDGET (PCCS(:,:,:)*PRHODJ(:,:,:), NBUDGET_SV1-1+NSV_C2R2BEG+1,&
- &'ACCR_BU_RSV') ! RCC
-!
- IF (LBUDGET_SV) CALL BUDGET (PCRS(:,:,:)*PRHODJ(:,:,:), NBUDGET_SV1-1+NSV_C2R2BEG+2,&
- &'SCBU_BU_RSV') ! RCR
END IF
!
END SUBROUTINE C2R2_COALESCENCE
@@ -1421,6 +1417,12 @@ IF( IMICRO >= 1 ) THEN
!
!* 4.1.1 autoconversion
!
+ if ( lbudget_sv ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_c2r2beg + 1), 'SELF', pccs(:, :, :) * prhodj(:, :, :) )
+
+ if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'AUTO', prcs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'AUTO', prrs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_c2r2beg + 2), 'AUTO', pcrs(:, :, :) * prhodj(:, :, :) )
+
WHERE ( ZRCT(:) .GT. XRTMIN(2) .AND. ZCCT(:) .GT. XCTMIN(2) &
.AND. (ZRCS(:) .GT. 0.0) .AND. (ZCCS(:) .GT. 0.0))
!
@@ -1447,14 +1449,18 @@ IF( IMICRO >= 1 ) THEN
!
!* 4.1.2 budget storage
!
- IF (LBUDGET_SV) CALL BUDGET (PCCS(:,:,:)*PRHODJ(:,:,:), NBUDGET_SV1-1+NSV_C2R2BEG+1,&
- &'SELF_BU_RSV') ! RCC
- IF (LBUDGET_RC) CALL BUDGET (PRCS*PRHODJ(:,:,:), NBUDGET_RC,'AUTO_BU_RRC')
- IF (LBUDGET_SV) CALL BUDGET (PCRS*PRHODJ(:,:,:), NBUDGET_SV1-1+NSV_C2R2BEG+2,'AUTO_BU_RSV')
- IF (LBUDGET_RR) CALL BUDGET (PRRS*PRHODJ(:,:,:), NBUDGET_RR,'AUTO_BU_RRR')
+ if ( lbudget_sv ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_c2r2beg + 1), 'SELF', pccs(:, :, :) * prhodj(:, :, :) )
+
+ if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'AUTO', prcs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'AUTO', prrs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_c2r2beg + 2), 'AUTO', pcrs(:, :, :) * prhodj(:, :, :) )
!
!* 4.2.1 Accretion sources
!
+ if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'ACCR', prcs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'ACCR', prrs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_c2r2beg + 1), 'ACCR', pccs(:, :, :) * prhodj(:, :, :) )
+
WHERE ( (ZRCT(:) .GT. XRTMIN(2)) .AND. (ZRRT(:) .GT. XRTMIN(3)) &
.AND. (ZRCS(:) .GT. 0.0) .AND. (ZCCS(:) .GT. 0.0))
@@ -1487,25 +1493,9 @@ IF( IMICRO >= 1 ) THEN
!
!* 4.2.2 budget storage
!
- IF (LBUDGET_SV) CALL BUDGET (PCCS(:,:,:)*PRHODJ(:,:,:), NBUDGET_SV1-1+NSV_C2R2BEG+1,&
- &'ACCR_BU_RSV') ! RCC
- IF (LBUDGET_RC) CALL BUDGET (PRCS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RC,'ACCR_BU_RRC')
- IF (LBUDGET_RR) CALL BUDGET (PRRS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RR,'ACCR_BU_RRR')
-!
-ELSE
-!
-!* 4.3 Budgets are forwarded
-!
- IF (LBUDGET_SV) CALL BUDGET (PCCS(:,:,:)*PRHODJ(:,:,:),NBUDGET_SV1-1+NSV_C2R2BEG+1,&
- &'SELF_BU_RSV') ! RCC
- IF (LBUDGET_RC) CALL BUDGET (PRCS*PRHODJ(:,:,:), NBUDGET_RC,'AUTO_BU_RRC')
- IF (LBUDGET_SV) CALL BUDGET (PCRS*PRHODJ(:,:,:), NBUDGET_SV1-1+NSV_C2R2BEG+2,'AUTO_BU_RSV')
- IF (LBUDGET_RR) CALL BUDGET (PRRS*PRHODJ(:,:,:), NBUDGET_RR,'AUTO_BU_RRR')
- IF (LBUDGET_SV) CALL BUDGET (PCCS(:,:,:)*PRHODJ(:,:,:), NBUDGET_SV1-1+NSV_C2R2BEG+1,&
- &'ACCR_BU_RSV') ! RCC
- IF (LBUDGET_RC) CALL BUDGET (PRCS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RC,'ACCR_BU_RRC')
- IF (LBUDGET_RR) CALL BUDGET (PRRS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RR,'ACCR_BU_RRR')
-
+ if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'ACCR', prcs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'ACCR', prrs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_c2r2beg + 1), 'ACCR', pccs(:, :, :) * prhodj(:, :, :) )
END IF
!
END SUBROUTINE KHKO_COALESCENCE
@@ -1525,7 +1515,11 @@ INTEGER , DIMENSION(SIZE(GNUCT)) :: I1,I2,I3 ! Used to replace the COUNT
INTEGER :: JL ! and PACK intrinsics
!
!-------------------------------------------------------------------------------
-!
+
+if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'REVA', pths(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rv ) call Budget_store_init( tbudgets(NBUDGET_RV), 'REVA', prvs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'REVA', prrs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_sv ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_c2r2beg + 2), 'REVA', pcrs(:, :, :) * prhodj(:, :, :) )
!
! optimization by looking for locations where
! the raindrop mixing ratio is non-zero
@@ -1714,12 +1708,12 @@ ELSE ! KHKO
PRRS(:,:,:) = 0.0
END WHERE
ENDIF
-!
-IF (LBUDGET_RV) CALL BUDGET (PRVS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RV,'REVA_BU_RRV')
-IF (LBUDGET_RR) CALL BUDGET (PRRS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RR,'REVA_BU_RRR')
-IF (LBUDGET_TH) CALL BUDGET (PTHS(:,:,:)*PRHODJ(:,:,:), NBUDGET_TH,'REVA_BU_RTH')
-IF (LBUDGET_SV) CALL BUDGET (PCRS(:,:,:)*PRHODJ(:,:,:), NBUDGET_SV1-1+NSV_C2R2BEG+2,'CEVA_BU_RSV')
-!
+
+if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'REVA', pths(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rv ) call Budget_store_end( tbudgets(NBUDGET_RV), 'REVA', prvs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'REVA', prrs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_sv ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_c2r2beg + 2), 'REVA', pcrs(:, :, :) * prhodj(:, :, :) )
+
END SUBROUTINE C2R2_KHKO_EVAPORATION
!
!-------------------------------------------------------------------------------
@@ -1738,6 +1732,13 @@ INTEGER , DIMENSION(SIZE(GSEDIM)) :: I1,I2,I3 ! Used to replace the COUNT
INTEGER :: JL ! and PACK intrinsics
!
!-------------------------------------------------------------------------------
+
+if ( lbudget_rc .and. osedc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'SEDI', prcs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'SEDI', prrs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_sv ) then
+ if ( osedc ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_c2r2beg + 1), 'SEDI', pccs(:, :, :) * prhodj(:, :, :) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_c2r2beg + 2), 'SEDI', pcrs(:, :, :) * prhodj(:, :, :) )
+end if
!
!* 2.1 compute the fluxes
!
@@ -1928,19 +1929,19 @@ END DO
!
!* 2.5 budget storage
!
-IF (LBUDGET_RC.AND.OSEDC) &
- CALL BUDGET (PRCS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RC,'SEDI_BU_RRC')
-IF (LBUDGET_RR) CALL BUDGET (PRRS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RR,'SEDI_BU_RRR')
-IF (LBUDGET_SV) THEN
- IF (OSEDC) CALL BUDGET (PCCS(:,:,:)*PRHODJ(:,:,:), NBUDGET_SV1-1+NSV_C2R2BEG+1,&
- &'SEDI_BU_RSV') ! RCC
- CALL BUDGET (PCRS(:,:,:)*PRHODJ(:,:,:), NBUDGET_SV1-1+NSV_C2R2BEG+2,&
- &'SEDI_BU_RSV') ! RCR
-END IF
+if ( lbudget_rc .and. osedc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'SEDI', prcs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'SEDI', prrs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_sv ) then
+ if ( osedc ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_c2r2beg + 1), 'SEDI', pccs(:, :, :) * prhodj(:, :, :) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_c2r2beg + 2), 'SEDI', pcrs(:, :, :) * prhodj(:, :, :) )
+end if
!
!* 2.6 DROPLET DEPOSITION AT THE 1ST LEVEL ABOVE GROUND
!
IF (LDEPOC) THEN
+ if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'DEPO', prcs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_c2r2beg + 1), 'DEPO', pccs(:, :, :) * prhodj(:, :, :) )
+
GDEP(:,:) = .FALSE.
GDEP(IIB:IIE,IJB:IJE) = PRCS(IIB:IIE,IJB:IJE,2) >0 .AND. &
PCCS(IIB:IIE,IJB:IJE,2) >0
@@ -1950,15 +1951,11 @@ IF (LDEPOC) THEN
PINPRC(:,:) = PINPRC(:,:) + XVDEPOC * PRCT(:,:,2) * PRHODREF(:,:,2) /XRHOLW
PINDEP(:,:) = XVDEPOC * PRCT(:,:,2) * PRHODREF(:,:,2) /XRHOLW
END WHERE
+
+ if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'DEPO', prcs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_c2r2beg + 1), 'DEPO', pccs(:, :, :) * prhodj(:, :, :) )
END IF
-!
-!* 2.7 budget storage
-!
-IF ( LBUDGET_RC .AND. LDEPOC ) &
- CALL BUDGET (PRCS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RC,'DEPO_BU_RRC')
-IF ( LBUDGET_SV .AND. LDEPOC ) &
- CALL BUDGET (PCCS(:,:,:)*PRHODJ(:,:,:), NBUDGET_SV1-1+NSV_C2R2BEG+1,'DEPO_BU_RSV')
-!
+
END SUBROUTINE C2R2_KHKO_SEDIMENTATION
!-------------------------------------------------------------------------------
!
diff --git a/src/MNH/rain_ice.f90 b/src/MNH/rain_ice.f90
index b2ba41a713963f3ceeeafdafe61ed2306ae3788a..47dd05e85865feb0ac12fc8bba044ba2cc7c1d6e 100644
--- a/src/MNH/rain_ice.f90
+++ b/src/MNH/rain_ice.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1995-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1995-2020 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.
@@ -135,34 +135,6 @@ END MODULE MODI_RAIN_ICE
!! function over liquid water
!! XALPI,XBETAI,XGAMI ! Constants for saturation vapor pressure
!! function over solid ice
-!! Module MODD_BUDGET:
-!! NBUMOD : model in which budget is calculated
-!! CBUTYPE : type of desired budget
-!! 'CART' for cartesian box configuration
-!! 'MASK' for budget zone defined by a mask
-!! 'NONE' ' for no budget
-!! NBUPROCCTR : process counter used for each budget variable
-!! LBU_RTH : logical for budget of RTH (potential temperature)
-!! .TRUE. = budget of RTH
-!! .FALSE. = no budget of RTH
-!! LBU_RRV : logical for budget of RRV (water vapor)
-!! .TRUE. = budget of RRV
-!! .FALSE. = no budget of RRV
-!! LBU_RRC : logical for budget of RRC (cloud water)
-!! .TRUE. = budget of RRC
-!! .FALSE. = no budget of RRC
-!! LBU_RRI : logical for budget of RRI (cloud ice)
-!! .TRUE. = budget of RRI
-!! .FALSE. = no budget of RRI
-!! LBU_RRR : logical for budget of RRR (rain water)
-!! .TRUE. = budget of RRR
-!! .FALSE. = no budget of RRR
-!! LBU_RRS : logical for budget of RRS (aggregates)
-!! .TRUE. = budget of RRS
-!! .FALSE. = no budget of RRS
-!! LBU_RRG : logical for budget of RRG (graupeln)
-!! .TRUE. = budget of RRG
-!! .FALSE. = no budget of RRG
!!
!! REFERENCE
!! ---------
@@ -244,14 +216,13 @@ END MODULE MODI_RAIN_ICE
! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90
! P. Wautelet 29/05/2019: remove PACK/UNPACK intrinsics (to get more performance and better OpenACC support)
! J. Escobar 09/07/2019: for reproductiblity MPPDB_CHECK, add missing LCHECK test in ZRHODJ de/allocate
+! P. Wautelet 02/2020: use the new data structures and subroutines for budgets (no more budget calls in this subroutine)
+!-----------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-use MODD_BUDGET, only: LBU_ENABLE, LBUDGET_TH, LBUDGET_RV, LBUDGET_RC, LBUDGET_RR, &
- LBUDGET_RI, LBUDGET_RS, LBUDGET_RG, LBUDGET_RH, &
- NBUDGET_TH, NBUDGET_RV, NBUDGET_RC, NBUDGET_RR, &
- NBUDGET_RI, NBUDGET_RS, NBUDGET_RG, NBUDGET_RH
+use modd_budget, only: lbu_enable
use MODD_CONF, only: LCHECK
use MODD_CST, only: XCI, XCL, XCPD, XCPV, XLSTT, XLVTT, XTT, &
XALPI, XBETAI, XGAMI, XMD, XMV, XTT
@@ -274,7 +245,6 @@ use MODE_RAIN_ICE_WARM, only: RAIN_ICE_WARM
use mode_tools, only: Countjv
use mode_tools_ll, only: GET_INDICE_ll
-use MODI_BUDGET
USE MODI_ICE4_RAINFR_VERT
IMPLICIT NONE
@@ -939,96 +909,6 @@ IF( IMICRO >= 0 ) THEN
DEALLOCATE(ZRCRAUTC)
DEALLOCATE(ZHLC_HRCLOCAL)
DEALLOCATE(ZHLC_LRCLOCAL)
-!
- ELSE
-!
-! Advance the budget calls
-!
-! Reordered for compability with flexible structures like in AROME
-
- ! rain_ice_slow
- IF (LBUDGET_TH) CALL BUDGET (PTHS(:,:,:)*PRHODJ(:,:,:),NBUDGET_TH,'HON_BU_RTH')
- IF (LBUDGET_RC) CALL BUDGET (PRCS(:,:,:)*PRHODJ(:,:,:),NBUDGET_RC,'HON_BU_RRC')
- IF (LBUDGET_RI) CALL BUDGET (PRIS(:,:,:)*PRHODJ(:,:,:),NBUDGET_RI,'HON_BU_RRI')
- IF (LBUDGET_TH) CALL BUDGET (PTHS(:,:,:)*PRHODJ(:,:,:),NBUDGET_TH,'SFR_BU_RTH')
- IF (LBUDGET_RR) CALL BUDGET (PRRS(:,:,:)*PRHODJ(:,:,:),NBUDGET_RR,'SFR_BU_RRR')
- IF (LBUDGET_RG) CALL BUDGET (PRGS(:,:,:)*PRHODJ(:,:,:),NBUDGET_RG,'SFR_BU_RRG')
- IF (LBUDGET_TH) CALL BUDGET (PTHS(:,:,:)*PRHODJ(:,:,:),NBUDGET_TH,'DEPS_BU_RTH')
- IF (LBUDGET_RV) CALL BUDGET (PRVS(:,:,:)*PRHODJ(:,:,:),NBUDGET_RV,'DEPS_BU_RRV')
- IF (LBUDGET_RS) CALL BUDGET (PRSS(:,:,:)*PRHODJ(:,:,:),NBUDGET_RS,'DEPS_BU_RRS')
- IF (LBUDGET_RI) CALL BUDGET (PRIS(:,:,:)*PRHODJ(:,:,:),NBUDGET_RI,'AGGS_BU_RRI')
- IF (LBUDGET_RS) CALL BUDGET (PRSS(:,:,:)*PRHODJ(:,:,:),NBUDGET_RS,'AGGS_BU_RRS')
- IF (LBUDGET_RI) CALL BUDGET (PRIS(:,:,:)*PRHODJ(:,:,:),NBUDGET_RI,'AUTS_BU_RRI')
- IF (LBUDGET_RS) CALL BUDGET (PRSS(:,:,:)*PRHODJ(:,:,:),NBUDGET_RS,'AUTS_BU_RRS')
- IF (LBUDGET_TH) CALL BUDGET (PTHS(:,:,:)*PRHODJ(:,:,:),NBUDGET_TH,'DEPG_BU_RTH')
- IF (LBUDGET_RV) CALL BUDGET (PRVS(:,:,:)*PRHODJ(:,:,:),NBUDGET_RV,'DEPG_BU_RRV')
- IF (LBUDGET_RG) CALL BUDGET (PRGS(:,:,:)*PRHODJ(:,:,:),NBUDGET_RG,'DEPG_BU_RRG')
-
- IF (OWARM) THEN ! rain_ice_warm
- IF (LBUDGET_RC) CALL BUDGET (PRCS(:,:,:)*PRHODJ(:,:,:),NBUDGET_RC,'AUTO_BU_RRC')
- IF (LBUDGET_RR) CALL BUDGET (PRRS(:,:,:)*PRHODJ(:,:,:),NBUDGET_RR,'AUTO_BU_RRR')
- IF (LBUDGET_RC) CALL BUDGET (PRCS(:,:,:)*PRHODJ(:,:,:),NBUDGET_RC,'ACCR_BU_RRC')
- IF (LBUDGET_RR) CALL BUDGET (PRRS(:,:,:)*PRHODJ(:,:,:),NBUDGET_RR,'ACCR_BU_RRR')
- IF (LBUDGET_TH) CALL BUDGET (PTHS(:,:,:)*PRHODJ(:,:,:),NBUDGET_TH,'REVA_BU_RTH')
- IF (LBUDGET_RV) CALL BUDGET (PRVS(:,:,:)*PRHODJ(:,:,:),NBUDGET_RV,'REVA_BU_RRV')
- IF (LBUDGET_RR) CALL BUDGET (PRRS(:,:,:)*PRHODJ(:,:,:),NBUDGET_RR,'REVA_BU_RRR')
- ENDIF
-
- !rain_ice_fast_rs
- IF (LBUDGET_TH) CALL BUDGET (PTHS(:,:,:)*PRHODJ(:,:,:),NBUDGET_TH,'RIM_BU_RTH')
- IF (LBUDGET_RC) CALL BUDGET (PRCS(:,:,:)*PRHODJ(:,:,:),NBUDGET_RC,'RIM_BU_RRC')
- IF (LBUDGET_RS) CALL BUDGET (PRSS(:,:,:)*PRHODJ(:,:,:),NBUDGET_RS,'RIM_BU_RRS')
- IF (LBUDGET_RG) CALL BUDGET (PRGS(:,:,:)*PRHODJ(:,:,:),NBUDGET_RG,'RIM_BU_RRG')
- IF (LBUDGET_TH) CALL BUDGET (PTHS(:,:,:)*PRHODJ(:,:,:),NBUDGET_TH,'ACC_BU_RTH')
- IF (LBUDGET_RR) CALL BUDGET (PRRS(:,:,:)*PRHODJ(:,:,:),NBUDGET_RR,'ACC_BU_RRR')
- IF (LBUDGET_RS) CALL BUDGET (PRSS(:,:,:)*PRHODJ(:,:,:),NBUDGET_RS,'ACC_BU_RRS')
- IF (LBUDGET_RG) CALL BUDGET (PRGS(:,:,:)*PRHODJ(:,:,:),NBUDGET_RG,'ACC_BU_RRG')
- IF (LBUDGET_RS) CALL BUDGET (PRSS(:,:,:)*PRHODJ(:,:,:),NBUDGET_RS,'CMEL_BU_RRS')
- IF (LBUDGET_RG) CALL BUDGET (PRGS(:,:,:)*PRHODJ(:,:,:),NBUDGET_RG,'CMEL_BU_RRG')
-
- !rain_ice_fast_rg
- IF (LBUDGET_TH) CALL BUDGET (PTHS(:,:,:)*PRHODJ(:,:,:),NBUDGET_TH,'CFRZ_BU_RTH')
- IF (LBUDGET_RR) CALL BUDGET (PRRS(:,:,:)*PRHODJ(:,:,:),NBUDGET_RR,'CFRZ_BU_RRR')
- IF (LBUDGET_RI) CALL BUDGET (PRIS(:,:,:)*PRHODJ(:,:,:),NBUDGET_RI,'CFRZ_BU_RRI')
- IF (LBUDGET_RG) CALL BUDGET (PRGS(:,:,:)*PRHODJ(:,:,:),NBUDGET_RG,'CFRZ_BU_RRG')
- IF (LBUDGET_TH) CALL BUDGET (PTHS(:,:,:)*PRHODJ(:,:,:),NBUDGET_TH,'WETG_BU_RTH')
- IF (LBUDGET_RC) CALL BUDGET (PRCS(:,:,:)*PRHODJ(:,:,:),NBUDGET_RC,'WETG_BU_RRC')
- IF (LBUDGET_RR) CALL BUDGET (PRRS(:,:,:)*PRHODJ(:,:,:),NBUDGET_RR,'WETG_BU_RRR')
- IF (LBUDGET_RI) CALL BUDGET (PRIS(:,:,:)*PRHODJ(:,:,:),NBUDGET_RI,'WETG_BU_RRI')
- IF (LBUDGET_RS) CALL BUDGET (PRSS(:,:,:)*PRHODJ(:,:,:),NBUDGET_RS,'WETG_BU_RRS')
- IF (LBUDGET_RG) CALL BUDGET (PRGS(:,:,:)*PRHODJ(:,:,:),NBUDGET_RG,'WETG_BU_RRG')
- IF (LBUDGET_RH) CALL BUDGET (PRHS(:,:,:)*PRHODJ(:,:,:),NBUDGET_RH,'WETG_BU_RRH')
- IF (LBUDGET_TH) CALL BUDGET (PTHS(:,:,:)*PRHODJ(:,:,:),NBUDGET_TH,'DRYG_BU_RTH')
- IF (LBUDGET_RC) CALL BUDGET (PRCS(:,:,:)*PRHODJ(:,:,:),NBUDGET_RC,'DRYG_BU_RRC')
- IF (LBUDGET_RR) CALL BUDGET (PRRS(:,:,:)*PRHODJ(:,:,:),NBUDGET_RR,'DRYG_BU_RRR')
- IF (LBUDGET_RI) CALL BUDGET (PRIS(:,:,:)*PRHODJ(:,:,:),NBUDGET_RI,'DRYG_BU_RRI')
- IF (LBUDGET_RS) CALL BUDGET (PRSS(:,:,:)*PRHODJ(:,:,:),NBUDGET_RS,'DRYG_BU_RRS')
- IF (LBUDGET_RG) CALL BUDGET (PRGS(:,:,:)*PRHODJ(:,:,:),NBUDGET_RG,'DRYG_BU_RRG')
- IF (LBUDGET_TH) CALL BUDGET (PTHS(:,:,:)*PRHODJ(:,:,:),NBUDGET_TH,'GMLT_BU_RTH')
- IF (LBUDGET_RR) CALL BUDGET (PRRS(:,:,:)*PRHODJ(:,:,:),NBUDGET_RR,'GMLT_BU_RRR')
- IF (LBUDGET_RG) CALL BUDGET (PRGS(:,:,:)*PRHODJ(:,:,:),NBUDGET_RG,'GMLT_BU_RRG')
-
- IF(KRR==7) THEN ! rain_ice_fast_rh
- IF (LBUDGET_TH) CALL BUDGET (PTHS(:,:,:)*PRHODJ(:,:,:),NBUDGET_TH,'WETH_BU_RTH')
- IF (LBUDGET_RC) CALL BUDGET (PRCS(:,:,:)*PRHODJ(:,:,:),NBUDGET_RC,'WETH_BU_RRC')
- IF (LBUDGET_RR) CALL BUDGET (PRRS(:,:,:)*PRHODJ(:,:,:),NBUDGET_RR,'WETH_BU_RRR')
- IF (LBUDGET_RI) CALL BUDGET (PRIS(:,:,:)*PRHODJ(:,:,:),NBUDGET_RI,'WETH_BU_RRI')
- IF (LBUDGET_RS) CALL BUDGET (PRSS(:,:,:)*PRHODJ(:,:,:),NBUDGET_RS,'WETH_BU_RRS')
- IF (LBUDGET_RG) CALL BUDGET (PRGS(:,:,:)*PRHODJ(:,:,:),NBUDGET_RG,'WETH_BU_RRG')
- IF (LBUDGET_RH) CALL BUDGET (PRHS(:,:,:)*PRHODJ(:,:,:),NBUDGET_RH,'WETH_BU_RRH')
- IF (LBUDGET_TH) CALL BUDGET (PTHS(:,:,:)*PRHODJ(:,:,:),NBUDGET_TH,'HMLT_BU_RTH')
- IF (LBUDGET_RR) CALL BUDGET (PRRS(:,:,:)*PRHODJ(:,:,:),NBUDGET_RR,'HMLT_BU_RRR')
- IF (LBUDGET_RH) CALL BUDGET (PRHS(:,:,:)*PRHODJ(:,:,:),NBUDGET_RH,'HMLT_BU_RRH')
- ENDIF
-
- !rain_ice_fast_ri
- IF (LBUDGET_TH) CALL BUDGET (PTHS(:,:,:)*PRHODJ(:,:,:),NBUDGET_TH,'IMLT_BU_RTH')
- IF (LBUDGET_RC) CALL BUDGET (PRCS(:,:,:)*PRHODJ(:,:,:),NBUDGET_RC,'IMLT_BU_RRC')
- IF (LBUDGET_RI) CALL BUDGET (PRIS(:,:,:)*PRHODJ(:,:,:),NBUDGET_RI,'IMLT_BU_RRI')
- IF (LBUDGET_TH) CALL BUDGET (PTHS(:,:,:)*PRHODJ(:,:,:),NBUDGET_TH,'BERFI_BU_RTH')
- IF (LBUDGET_RC) CALL BUDGET (PRCS(:,:,:)*PRHODJ(:,:,:),NBUDGET_RC,'BERFI_BU_RRC')
- IF (LBUDGET_RI) CALL BUDGET (PRIS(:,:,:)*PRHODJ(:,:,:),NBUDGET_RI,'BERFI_BU_RRI')
-!
END IF
!
!-------------------------------------------------------------------------------
diff --git a/src/MNH/rain_ice_elec.f90 b/src/MNH/rain_ice_elec.f90
index 645869054d24eadaa79d8f031101830ccf847844..a80086f5984c2057d0da60dbba688a3baf9528d6 100644
--- a/src/MNH/rain_ice_elec.f90
+++ b/src/MNH/rain_ice_elec.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 2002-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2002-2020 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.
@@ -157,37 +157,6 @@ END MODULE MODI_RAIN_ICE_ELEC
!! function over liquid water
!! XALPI,XBETAI,XGAMI ! Constants for saturation vapor pressure
!! function over solid ice
-!! Module MODD_BUDGET:
-!! NBUMOD : model in which budget is calculated
-!! CBUTYPE : type of desired budget
-!! 'CART' for cartesian box configuration
-!! 'MASK' for budget zone defined by a mask
-!! 'NONE' ' for no budget
-!! NBUPROCCTR : process counter used for each budget variable
-!! LBU_RTH : logical for budget of RTH (potential temperature)
-!! .TRUE. = budget of RTH
-!! .FALSE. = no budget of RTH
-!! LBU_RRV : logical for budget of RRV (water vapor)
-!! .TRUE. = budget of RRV
-!! .FALSE. = no budget of RRV
-!! LBU_RRC : logical for budget of RRC (cloud water)
-!! .TRUE. = budget of RRC
-!! .FALSE. = no budget of RRC
-!! LBU_RRI : logical for budget of RRI (cloud ice)
-!! .TRUE. = budget of RRI
-!! .FALSE. = no budget of RRI
-!! LBU_RRR : logical for budget of RRR (rain water)
-!! .TRUE. = budget of RRR
-!! .FALSE. = no budget of RRR
-!! LBU_RRS : logical for budget of RRS (aggregates)
-!! .TRUE. = budget of RRS
-!! .FALSE. = no budget of RRS
-!! LBU_RRG : logical for budget of RRG (graupeln)
-!! .TRUE. = budget of RRG
-!! .FALSE. = no budget of RRG
-!! LBU_RSV : logical for budget of RSV (scalar variables for charge)
-!! .TRUE. = budget of RSV
-!! .FALSE. = no budget of RSV
!!
!! REFERENCE
!! ---------
@@ -224,16 +193,21 @@ END MODULE MODI_RAIN_ICE_ELEC
!! J-P Pinty 25/04/14 Many bugs with ZWQ1(:,...) = 0.0
!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
!! J.Escobar : 10/2017 : for real*4 , limit exp() in RAIN_ICE_ELEC_SLOW with XMNH_HUGE_12_LOG
-!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet 05/2016-04/2018: new data structures and calls for I/O
! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90
-!
+! P. Wautelet 03/2020: use the new data structures and subroutines for budgets
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_BUDGET
+use modd_budget, only: lbu_enable, &
+ lbudget_th, lbudget_rv, lbudget_rc, lbudget_rr, lbudget_ri, &
+ lbudget_rs, lbudget_rg, lbudget_rh, lbudget_sv, &
+ NBUDGET_TH, NBUDGET_RV, NBUDGET_RC, NBUDGET_RR, NBUDGET_RI, &
+ NBUDGET_RS, NBUDGET_RG, NBUDGET_RH, NBUDGET_SV1, &
+ tbudgets
USE MODD_CONF
USE MODD_CST
USE MODD_ELEC_DESCR
@@ -248,12 +222,12 @@ USE MODD_RAIN_ICE_DESCR
USE MODD_RAIN_ICE_PARAM
USE MODD_REF, ONLY: XTHVREFZ
+use mode_budget, only: Budget_store_add, Budget_store_init, Budget_store_end
#ifdef MNH_PGI
USE MODE_PACK_PGI
#endif
use mode_tools, only: Countjv
-USE MODI_BUDGET
USE MODI_MOMG
IMPLICIT NONE
@@ -1100,153 +1074,6 @@ IF (IMICRO > 0) THEN
IF (ALLOCATED( ZEFIELDV )) DEALLOCATE( ZEFIELDV )
DEALLOCATE( ZLATHAMIAGGS )
!
-ELSE
-!
-! Advance the budget calls
-!
-! Reordered for compability with flexible structures like in AROME
-
-! rain_ice_slow
- IF (LBUDGET_TH) CALL BUDGET (PTHS(:,:,:)*PRHODJ(:,:,:),NBUDGET_TH,'HON_BU_RTH')
- IF (LBUDGET_RC) CALL BUDGET (PRCS(:,:,:)*PRHODJ(:,:,:),NBUDGET_RC,'HON_BU_RRC')
- IF (LBUDGET_RI) CALL BUDGET (PRIS(:,:,:)*PRHODJ(:,:,:),NBUDGET_RI,'HON_BU_RRI')
- IF (LBUDGET_TH) CALL BUDGET (PTHS(:,:,:)*PRHODJ(:,:,:),NBUDGET_TH,'SFR_BU_RTH')
- IF (LBUDGET_RR) CALL BUDGET (PRRS(:,:,:)*PRHODJ(:,:,:),NBUDGET_RR,'SFR_BU_RRR')
- IF (LBUDGET_RG) CALL BUDGET (PRGS(:,:,:)*PRHODJ(:,:,:),NBUDGET_RG,'SFR_BU_RRG')
- IF (LBUDGET_TH) CALL BUDGET (PTHS(:,:,:)*PRHODJ(:,:,:),NBUDGET_TH,'DEPS_BU_RTH')
- IF (LBUDGET_RV) CALL BUDGET (PRVS(:,:,:)*PRHODJ(:,:,:),NBUDGET_RV,'DEPS_BU_RRV')
- IF (LBUDGET_RS) CALL BUDGET (PRSS(:,:,:)*PRHODJ(:,:,:),NBUDGET_RS,'DEPS_BU_RRS')
- IF (LBUDGET_RI) CALL BUDGET (PRIS(:,:,:)*PRHODJ(:,:,:),NBUDGET_RI,'AGGS_BU_RRI')
- IF (LBUDGET_RS) CALL BUDGET (PRSS(:,:,:)*PRHODJ(:,:,:),NBUDGET_RS,'AGGS_BU_RRS')
- IF (LBUDGET_RI) CALL BUDGET (PRIS(:,:,:)*PRHODJ(:,:,:),NBUDGET_RI,'AUTS_BU_RRI')
- IF (LBUDGET_RS) CALL BUDGET (PRSS(:,:,:)*PRHODJ(:,:,:),NBUDGET_RS,'AUTS_BU_RRS')
- IF (LBUDGET_TH) CALL BUDGET (PTHS(:,:,:)*PRHODJ(:,:,:),NBUDGET_TH,'DEPG_BU_RTH')
- IF (LBUDGET_RV) CALL BUDGET (PRVS(:,:,:)*PRHODJ(:,:,:),NBUDGET_RV,'DEPG_BU_RRV')
- IF (LBUDGET_RG) CALL BUDGET (PRGS(:,:,:)*PRHODJ(:,:,:),NBUDGET_RG,'DEPG_BU_RRG')
-!
- IF (OWARM) THEN ! rain_ice_warm
- IF (LBUDGET_RC) CALL BUDGET (PRCS(:,:,:)*PRHODJ(:,:,:),NBUDGET_RC,'AUTO_BU_RRC')
- IF (LBUDGET_RR) CALL BUDGET (PRRS(:,:,:)*PRHODJ(:,:,:),NBUDGET_RR,'AUTO_BU_RRR')
- IF (LBUDGET_RC) CALL BUDGET (PRCS(:,:,:)*PRHODJ(:,:,:),NBUDGET_RC,'ACCR_BU_RRC')
- IF (LBUDGET_RR) CALL BUDGET (PRRS(:,:,:)*PRHODJ(:,:,:),NBUDGET_RR,'ACCR_BU_RRR')
- IF (LBUDGET_TH) CALL BUDGET (PTHS(:,:,:)*PRHODJ(:,:,:),NBUDGET_TH,'REVA_BU_RTH')
- IF (LBUDGET_RV) CALL BUDGET (PRVS(:,:,:)*PRHODJ(:,:,:),NBUDGET_RV,'REVA_BU_RRV')
- IF (LBUDGET_RR) CALL BUDGET (PRRS(:,:,:)*PRHODJ(:,:,:),NBUDGET_RR,'REVA_BU_RRR')
- ENDIF
-!
-! rain_ice_fast_rs
- IF (LBUDGET_TH) CALL BUDGET (PTHS(:,:,:)*PRHODJ(:,:,:),NBUDGET_TH,'RIM_BU_RTH')
- IF (LBUDGET_RC) CALL BUDGET (PRCS(:,:,:)*PRHODJ(:,:,:),NBUDGET_RC,'RIM_BU_RRC')
- IF (LBUDGET_RS) CALL BUDGET (PRSS(:,:,:)*PRHODJ(:,:,:),NBUDGET_RS,'RIM_BU_RRS')
- IF (LBUDGET_RG) CALL BUDGET (PRGS(:,:,:)*PRHODJ(:,:,:),NBUDGET_RG,'RIM_BU_RRG')
- IF (LBUDGET_TH) CALL BUDGET (PTHS(:,:,:)*PRHODJ(:,:,:),NBUDGET_TH,'ACC_BU_RTH')
- IF (LBUDGET_RR) CALL BUDGET (PRRS(:,:,:)*PRHODJ(:,:,:),NBUDGET_RR,'ACC_BU_RRR')
- IF (LBUDGET_RS) CALL BUDGET (PRSS(:,:,:)*PRHODJ(:,:,:),NBUDGET_RS,'ACC_BU_RRS')
- IF (LBUDGET_RG) CALL BUDGET (PRGS(:,:,:)*PRHODJ(:,:,:),NBUDGET_RG,'ACC_BU_RRG')
- IF (LBUDGET_RS) CALL BUDGET (PRSS(:,:,:)*PRHODJ(:,:,:),NBUDGET_RS,'CMEL_BU_RRS')
- IF (LBUDGET_RG) CALL BUDGET (PRGS(:,:,:)*PRHODJ(:,:,:),NBUDGET_RG,'CMEL_BU_RRG')
-
-! rain_ice_fast_rg
- IF (LBUDGET_TH) CALL BUDGET (PTHS(:,:,:)*PRHODJ(:,:,:),NBUDGET_TH,'CFRZ_BU_RTH')
- IF (LBUDGET_RR) CALL BUDGET (PRRS(:,:,:)*PRHODJ(:,:,:),NBUDGET_RR,'CFRZ_BU_RRR')
- IF (LBUDGET_RI) CALL BUDGET (PRIS(:,:,:)*PRHODJ(:,:,:),NBUDGET_RI,'CFRZ_BU_RRI')
- IF (LBUDGET_RG) CALL BUDGET (PRGS(:,:,:)*PRHODJ(:,:,:),NBUDGET_RG,'CFRZ_BU_RRG')
- IF (LBUDGET_TH) CALL BUDGET (PTHS(:,:,:)*PRHODJ(:,:,:),NBUDGET_TH,'WETG_BU_RTH')
- IF (LBUDGET_RC) CALL BUDGET (PRCS(:,:,:)*PRHODJ(:,:,:),NBUDGET_RC,'WETG_BU_RRC')
- IF (LBUDGET_RR) CALL BUDGET (PRRS(:,:,:)*PRHODJ(:,:,:),NBUDGET_RR,'WETG_BU_RRR')
- IF (LBUDGET_RI) CALL BUDGET (PRIS(:,:,:)*PRHODJ(:,:,:),NBUDGET_RI,'WETG_BU_RRI')
- IF (LBUDGET_RS) CALL BUDGET (PRSS(:,:,:)*PRHODJ(:,:,:),NBUDGET_RS,'WETG_BU_RRS')
- IF (LBUDGET_RG) CALL BUDGET (PRGS(:,:,:)*PRHODJ(:,:,:),NBUDGET_RG,'WETG_BU_RRG')
- IF (LBUDGET_RH) CALL BUDGET (PRHS(:,:,:)*PRHODJ(:,:,:),NBUDGET_RH,'WETG_BU_RRH')
- IF (LBUDGET_TH) CALL BUDGET (PTHS(:,:,:)*PRHODJ(:,:,:),NBUDGET_TH,'DRYG_BU_RTH')
- IF (LBUDGET_RC) CALL BUDGET (PRCS(:,:,:)*PRHODJ(:,:,:),NBUDGET_RC,'DRYG_BU_RRC')
- IF (LBUDGET_RR) CALL BUDGET (PRRS(:,:,:)*PRHODJ(:,:,:),NBUDGET_RR,'DRYG_BU_RRR')
- IF (LBUDGET_RI) CALL BUDGET (PRIS(:,:,:)*PRHODJ(:,:,:),NBUDGET_RI,'DRYG_BU_RRI')
- IF (LBUDGET_RS) CALL BUDGET (PRSS(:,:,:)*PRHODJ(:,:,:),NBUDGET_RS,'DRYG_BU_RRS')
- IF (LBUDGET_RG) CALL BUDGET (PRGS(:,:,:)*PRHODJ(:,:,:),NBUDGET_RG,'DRYG_BU_RRG')
- IF (LBUDGET_TH) CALL BUDGET (PTHS(:,:,:)*PRHODJ(:,:,:),NBUDGET_TH,'GMLT_BU_RTH')
- IF (LBUDGET_RR) CALL BUDGET (PRRS(:,:,:)*PRHODJ(:,:,:),NBUDGET_RR,'GMLT_BU_RRR')
- IF (LBUDGET_RG) CALL BUDGET (PRGS(:,:,:)*PRHODJ(:,:,:),NBUDGET_RG,'GMLT_BU_RRG')
-
- IF(KRR==7) THEN ! rain_ice_fast_rh
- IF (LBUDGET_TH) CALL BUDGET (PTHS(:,:,:)*PRHODJ(:,:,:),NBUDGET_TH,'WETH_BU_RTH')
- IF (LBUDGET_RC) CALL BUDGET (PRCS(:,:,:)*PRHODJ(:,:,:),NBUDGET_RC,'WETH_BU_RRC')
- IF (LBUDGET_RR) CALL BUDGET (PRRS(:,:,:)*PRHODJ(:,:,:),NBUDGET_RR,'WETH_BU_RRR')
- IF (LBUDGET_RI) CALL BUDGET (PRIS(:,:,:)*PRHODJ(:,:,:),NBUDGET_RI,'WETH_BU_RRI')
- IF (LBUDGET_RS) CALL BUDGET (PRSS(:,:,:)*PRHODJ(:,:,:),NBUDGET_RS,'WETH_BU_RRS')
- IF (LBUDGET_RG) CALL BUDGET (PRGS(:,:,:)*PRHODJ(:,:,:),NBUDGET_RG,'WETH_BU_RRG')
- IF (LBUDGET_RH) CALL BUDGET (PRHS(:,:,:)*PRHODJ(:,:,:),NBUDGET_RH,'WETH_BU_RRH')
- IF (LBUDGET_TH) CALL BUDGET (PTHS(:,:,:)*PRHODJ(:,:,:),NBUDGET_TH,'HMLT_BU_RTH')
- IF (LBUDGET_RR) CALL BUDGET (PRRS(:,:,:)*PRHODJ(:,:,:),NBUDGET_RR,'HMLT_BU_RRR')
- IF (LBUDGET_RH) CALL BUDGET (PRHS(:,:,:)*PRHODJ(:,:,:),NBUDGET_RH,'HMLT_BU_RRH')
- ENDIF
-
-! rain_ice_fast_ri
- IF (LBUDGET_TH) CALL BUDGET (PTHS(:,:,:)*PRHODJ(:,:,:),NBUDGET_TH,'IMLT_BU_RTH')
- IF (LBUDGET_RC) CALL BUDGET (PRCS(:,:,:)*PRHODJ(:,:,:),NBUDGET_RC,'IMLT_BU_RRC')
- IF (LBUDGET_RI) CALL BUDGET (PRIS(:,:,:)*PRHODJ(:,:,:),NBUDGET_RI,'IMLT_BU_RRI')
- IF (LBUDGET_TH) CALL BUDGET (PTHS(:,:,:)*PRHODJ(:,:,:),NBUDGET_TH,'BERFI_BU_RTH')
- IF (LBUDGET_RC) CALL BUDGET (PRCS(:,:,:)*PRHODJ(:,:,:),NBUDGET_RC,'BERFI_BU_RRC')
- IF (LBUDGET_RI) CALL BUDGET (PRIS(:,:,:)*PRHODJ(:,:,:),NBUDGET_RI,'BERFI_BU_RRI')
-!
- IF (LBUDGET_SV) THEN
-! rain_ice_slow
- CALL BUDGET (PQPIS(:,:,:) * PRHODJ(:,:,:),NBUDGET_SV1-1+NSV_ELECBEG, 'DEPS_BU_RSV')
- CALL BUDGET (PQNIS(:,:,:) * PRHODJ(:,:,:),NBUDGET_SV1-1+NSV_ELECEND, 'DEPS_BU_RSV')
- CALL BUDGET (PQSS(:,:,:) * PRHODJ(:,:,:),NBUDGET_SV1-1+NSV_ELECBEG+4,'DEPS_BU_RSV')
- CALL BUDGET (PQIS(:,:,:) * PRHODJ(:,:,:),NBUDGET_SV1-1+NSV_ELECBEG+3,'AGGS_BU_RSV')
- CALL BUDGET (PQSS(:,:,:) * PRHODJ(:,:,:),NBUDGET_SV1-1+NSV_ELECBEG+4,'AGGS_BU_RSV')
- CALL BUDGET (PQIS(:,:,:) * PRHODJ(:,:,:),NBUDGET_SV1-1+NSV_ELECBEG+3,'AUTS_BU_RSV')
- CALL BUDGET (PQSS(:,:,:) * PRHODJ(:,:,:),NBUDGET_SV1-1+NSV_ELECBEG+4,'AUTS_BU_RSV')
- CALL BUDGET (PQPIS(:,:,:) * PRHODJ(:,:,:),NBUDGET_SV1-1+NSV_ELECBEG, 'DEPG_BU_RSV')
- CALL BUDGET (PQNIS(:,:,:) * PRHODJ(:,:,:),NBUDGET_SV1-1+NSV_ELECEND, 'DEPG_BU_RSV')
- CALL BUDGET (PQGS(:,:,:) * PRHODJ(:,:,:),NBUDGET_SV1-1+NSV_ELECBEG+5,'DEPG_BU_RSV')
-!
-! rain_ice_warm
- IF (OWARM) THEN
- CALL BUDGET (PQCS(:,:,:) * PRHODJ(:,:,:),NBUDGET_SV1-1+NSV_ELECBEG+1,'AUTO_BU_RSV')
- CALL BUDGET (PQRS(:,:,:) * PRHODJ(:,:,:),NBUDGET_SV1-1+NSV_ELECBEG+2,'AUTO_BU_RSV')
- CALL BUDGET (PQCS(:,:,:) * PRHODJ(:,:,:),NBUDGET_SV1-1+NSV_ELECBEG+1,'ACCR_BU_RSV')
- CALL BUDGET (PQRS(:,:,:) * PRHODJ(:,:,:),NBUDGET_SV1-1+NSV_ELECBEG+2,'ACCR_BU_RSV')
- CALL BUDGET (PQPIS(:,:,:) * PRHODJ(:,:,:),NBUDGET_SV1-1+NSV_ELECBEG, 'REVA_BU_RSV')
- CALL BUDGET (PQNIS(:,:,:) * PRHODJ(:,:,:),NBUDGET_SV1-1+NSV_ELECEND, 'REVA_BU_RSV')
- CALL BUDGET (PQRS(:,:,:) * PRHODJ(:,:,:),NBUDGET_SV1-1+NSV_ELECBEG+2,'REVA_BU_RSV')
- END IF
-!
-! rain_ice_fast_rs
- CALL BUDGET (PQCS(:,:,:) * PRHODJ(:,:,:),NBUDGET_SV1-1+NSV_ELECBEG+1,'RIM_BU_RSV')
- CALL BUDGET (PQSS(:,:,:) * PRHODJ(:,:,:),NBUDGET_SV1-1+NSV_ELECBEG+4,'RIM_BU_RSV')
- CALL BUDGET (PQGS(:,:,:) * PRHODJ(:,:,:),NBUDGET_SV1-1+NSV_ELECEND, 'RIM_BU_RSV')
- CALL BUDGET (PQRS(:,:,:) * PRHODJ(:,:,:),NBUDGET_SV1-1+NSV_ELECBEG+2,'ACC_BU_RSV')
- CALL BUDGET (PQSS(:,:,:) * PRHODJ(:,:,:),NBUDGET_SV1-1+NSV_ELECBEG+4,'ACC_BU_RSV')
- CALL BUDGET (PQGS(:,:,:) * PRHODJ(:,:,:),NBUDGET_SV1-1+NSV_ELECEND, 'ACC_BU_RSV')
- CALL BUDGET (PQSS(:,:,:) * PRHODJ(:,:,:),NBUDGET_SV1-1+NSV_ELECBEG+4,'CMEL_BU_RSV')
- CALL BUDGET (PQGS(:,:,:) * PRHODJ(:,:,:),NBUDGET_SV1-1+NSV_ELECEND, 'CMEL_BU_RSV')
-!
-! rain_ice_fast_rg
- CALL BUDGET (PQRS(:,:,:) * PRHODJ(:,:,:),NBUDGET_SV1-1+NSV_ELECBEG+2,'CFRZ_BU_RSV')
- CALL BUDGET (PQIS(:,:,:) * PRHODJ(:,:,:),NBUDGET_SV1-1+NSV_ELECBEG+3,'CFRZ_BU_RSV')
- CALL BUDGET (PQGS(:,:,:) * PRHODJ(:,:,:),NBUDGET_SV1-1+NSV_ELECEND, 'CFRZ_BU_RSV')
- CALL BUDGET (PQCS(:,:,:) * PRHODJ(:,:,:),NBUDGET_SV1-1+NSV_ELECBEG+1,'WETG_BU_RSV')
- CALL BUDGET (PQRS(:,:,:) * PRHODJ(:,:,:),NBUDGET_SV1-1+NSV_ELECBEG+2,'WETG_BU_RSV')
- CALL BUDGET (PQIS(:,:,:) * PRHODJ(:,:,:),NBUDGET_SV1-1+NSV_ELECBEG+3,'WETG_BU_RSV')
- CALL BUDGET (PQSS(:,:,:) * PRHODJ(:,:,:),NBUDGET_SV1-1+NSV_ELECBEG+4,'WETG_BU_RSV')
- CALL BUDGET (PQGS(:,:,:) * PRHODJ(:,:,:),NBUDGET_SV1-1+NSV_ELECEND, 'WETG_BU_RSV')
- CALL BUDGET (PQCS(:,:,:) * PRHODJ(:,:,:),NBUDGET_SV1-1+NSV_ELECBEG+1,'DRYG_BU_RSV')
- CALL BUDGET (PQRS(:,:,:) * PRHODJ(:,:,:),NBUDGET_SV1-1+NSV_ELECBEG+2,'DRYG_BU_RSV')
- CALL BUDGET (PQIS(:,:,:) * PRHODJ(:,:,:),NBUDGET_SV1-1+NSV_ELECBEG+3,'DRYG_BU_RSV')
- CALL BUDGET (PQSS(:,:,:) * PRHODJ(:,:,:),NBUDGET_SV1-1+NSV_ELECBEG+4,'DRYG_BU_RSV')
- CALL BUDGET (PQGS(:,:,:) * PRHODJ(:,:,:),NBUDGET_SV1-1+NSV_ELECEND, 'DRYG_BU_RSV')
- CALL BUDGET (PQRS(:,:,:) * PRHODJ(:,:,:),NBUDGET_SV1-1+NSV_ELECBEG+2,'GMLT_BU_RSV')
- CALL BUDGET (PQGS(:,:,:) * PRHODJ(:,:,:),NBUDGET_SV1-1+NSV_ELECEND, 'GMLT_BU_RSV')
-!
-! rain_ice_fast_ri
- CALL BUDGET (PQCS(:,:,:) * PRHODJ(:,:,:),NBUDGET_SV1-1+NSV_ELECBEG+1,'IMLT_BU_RSV')
- CALL BUDGET (PQIS(:,:,:) * PRHODJ(:,:,:),NBUDGET_SV1-1+NSV_ELECBEG+3,'IMLT_BU_RSV')
- CALL BUDGET (PQCS(:,:,:) * PRHODJ(:,:,:),NBUDGET_SV1-1+NSV_ELECBEG+1,'BERFI_BU_RSV')
- CALL BUDGET (PQIS(:,:,:) * PRHODJ(:,:,:),NBUDGET_SV1-1+NSV_ELECBEG+3,'BERFI_BU_RSV')
-!
- END IF
END IF
!
!-------------------------------------------------------------------------------
@@ -1318,6 +1145,21 @@ REAL :: ZVR, ZVI, ZVS, ZVG, ZETA0, ZK, ZRE0
!
! O. Initialization for sedimentation
!
+ if ( lbudget_rc .and. osedic ) &
+ call Budget_store_init( tbudgets(NBUDGET_RC), 'SEDI', prcs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'SEDI', prrs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'SEDI', pris(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rs ) call Budget_store_init( tbudgets(NBUDGET_RS), 'SEDI', prss(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_init( tbudgets(NBUDGET_RG), 'SEDI', prgs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rh ) call Budget_store_init( tbudgets(NBUDGET_RH), 'SEDI', prhs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_sv ) then
+ if ( osedic ) &
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1 ), 'SEDI', pqcs(:, :, :) * prhodj(:, :, :) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2 ), 'SEDI', pqrs(:, :, :) * prhodj(:, :, :) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'SEDI', pqis(:, :, :) * prhodj(:, :, :) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 4 ), 'SEDI', pqss(:, :, :) * prhodj(:, :, :) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'SEDI', pqgs(:, :, :) * prhodj(:, :, :) )
+ end if
IF (OSEDIC) PINPRC (:,:) = 0.
PINPRR (:,:) = 0.
PINPRR3D (:,:,:) = 0.
@@ -1973,22 +1815,21 @@ REAL :: ZVR, ZVI, ZVS, ZVG, ZETA0, ZK, ZRE0
!
!* 2.3 budget storage
!
- IF (LBUDGET_RC .AND. OSEDIC) &
- CALL BUDGET (PRCS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RC,'SEDI_BU_RRC')
- IF (LBUDGET_RR) CALL BUDGET (PRRS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RR,'SEDI_BU_RRR')
- IF (LBUDGET_RI) CALL BUDGET (PRIS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RI,'SEDI_BU_RRI')
- IF (LBUDGET_RS) CALL BUDGET (PRSS(:,:,:)*PRHODJ(:,:,:),NBUDGET_RS,'SEDI_BU_RRS')
- IF (LBUDGET_RG) CALL BUDGET (PRGS(:,:,:)*PRHODJ(:,:,:),NBUDGET_RG,'SEDI_BU_RRG')
- IF ( KRR == 7 .AND. LBUDGET_RH) &
- CALL BUDGET (PRHS(:,:,:)*PRHODJ(:,:,:),NBUDGET_RH,'SEDI_BU_RRH')
-!
- IF (LBUDGET_SV) THEN
- CALL BUDGET (PQCS(:,:,:)*PRHODJ(:,:,:),NBUDGET_SV1-1+NSV_ELECBEG+1,'SEDI_BU_RSV')
- CALL BUDGET (PQRS(:,:,:)*PRHODJ(:,:,:),NBUDGET_SV1-1+NSV_ELECBEG+2,'SEDI_BU_RSV')
- CALL BUDGET (PQIS(:,:,:)*PRHODJ(:,:,:),NBUDGET_SV1-1+NSV_ELECBEG+3,'SEDI_BU_RSV')
- CALL BUDGET (PQSS(:,:,:)*PRHODJ(:,:,:),NBUDGET_SV1-1+NSV_ELECBEG+4,'SEDI_BU_RSV')
- CALL BUDGET (PQGS(:,:,:)*PRHODJ(:,:,:),NBUDGET_SV1-1+NSV_ELECBEG+5,'SEDI_BU_RSV')
- END IF
+ if ( lbudget_rc .and. osedic ) &
+ call Budget_store_end( tbudgets(NBUDGET_RC), 'SEDI', prcs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'SEDI', prrs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'SEDI', pris(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rs ) call Budget_store_end( tbudgets(NBUDGET_RS), 'SEDI', prss(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG), 'SEDI', prgs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rh ) call Budget_store_end( tbudgets(NBUDGET_RH), 'SEDI', prhs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_sv ) then
+ if ( osedic ) &
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1 ), 'SEDI', pqcs(:, :, :) * prhodj(:, :, :) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2 ), 'SEDI', pqrs(:, :, :) * prhodj(:, :, :) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'SEDI', pqis(:, :, :) * prhodj(:, :, :) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 4 ), 'SEDI', pqss(:, :, :) * prhodj(:, :, :) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'SEDI', pqgs(:, :, :) * prhodj(:, :, :) )
+ end if
!
END SUBROUTINE RAIN_ICE_ELEC_SEDIMENTATION_SPLIT
!
@@ -2011,6 +1852,13 @@ INTEGER :: JI,JJ,JK
REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) :: ZCONC3D ! droplet condensation
!
!-------------------------------------------------------------------------------
+ if ( lbudget_rc .and. osedic ) &
+ call Budget_store_init( tbudgets(NBUDGET_RC), 'SEDI', prcs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'SEDI', prrs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'SEDI', pris(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rs ) call Budget_store_init( tbudgets(NBUDGET_RS), 'SEDI', prss(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_init( tbudgets(NBUDGET_RG), 'SEDI', prgs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rh ) call Budget_store_init( tbudgets(NBUDGET_RH), 'SEDI', prhs(:, :, :) * prhodj(:, :, :) )
!
!* 1. Parameters for cloud sedimentation
!
@@ -2368,15 +2216,13 @@ REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) :: ZCONC3D !
!
!* 2.3 budget storage
!
- IF (LBUDGET_RC .AND. OSEDIC) &
- CALL BUDGET (PRCS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RC,'SEDI_BU_RRC')
- IF (LBUDGET_RR) CALL BUDGET (PRRS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RR,'SEDI_BU_RRR')
- IF (LBUDGET_RI) CALL BUDGET (PRIS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RI,'SEDI_BU_RRI')
- IF (LBUDGET_RS) CALL BUDGET (PRSS(:,:,:)*PRHODJ(:,:,:),NBUDGET_RS,'SEDI_BU_RRS')
- IF (LBUDGET_RG) CALL BUDGET (PRGS(:,:,:)*PRHODJ(:,:,:),NBUDGET_RG,'SEDI_BU_RRG')
- IF (KRR == 7 .AND. LBUDGET_RH) &
- CALL BUDGET (PRHS(:,:,:)*PRHODJ(:,:,:),NBUDGET_RH,'SEDI_BU_RRH')
-
+ if ( lbudget_rc .and. osedic ) &
+ call Budget_store_end( tbudgets(NBUDGET_RC), 'SEDI', prcs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'SEDI', prrs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'SEDI', pris(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rs ) call Budget_store_end( tbudgets(NBUDGET_RS), 'SEDI', prss(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG), 'SEDI', prgs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rh ) call Budget_store_end( tbudgets(NBUDGET_RH), 'SEDI', prhs(:, :, :) * prhodj(:, :, :) )
!
END SUBROUTINE RAIN_ICE_SEDIMENTATION_STAT
!
@@ -2397,7 +2243,6 @@ INTEGER :: JL ! and PACK intrinsics
!
!-------------------------------------------------------------------------------
!
-!
! compute the temperature and the pressure
!
ZT(:,:,:) = PTHT(:,:,:) * (PPABST(:,:,:) / XP00) ** (XRD / XCPD)
@@ -2410,7 +2255,11 @@ GNEGT(IIB:IIE,IJB:IJE,IKB:IKE) = ZT(IIB:IIE,IJB:IJE,IKB:IKE) < XTT
INEGT = COUNTJV( GNEGT(:,:,:),I1(:),I2(:),I3(:))
!
IF( INEGT >= 1 ) THEN
- ALLOCATE(ZRVT(INEGT))
+ if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'HENU', pths(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rv ) call Budget_store_init( tbudgets(NBUDGET_TH), 'HENU', prvs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_TH), 'HENU', pris(:, :, :) * prhodj(:, :, :) )
+
+ ALLOCATE(ZRVT(INEGT))
ALLOCATE(ZCIT(INEGT))
ALLOCATE(ZZT(INEGT))
ALLOCATE(ZPRES(INEGT))
@@ -2481,14 +2330,13 @@ IF( INEGT >= 1 ) THEN
DEALLOCATE(ZZT)
DEALLOCATE(ZCIT)
DEALLOCATE(ZRVT)
+
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'HENU', pths(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rv ) call Budget_store_end( tbudgets(NBUDGET_TH), 'HENU', prvs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_TH), 'HENU', pris(:, :, :) * prhodj(:, :, :) )
+
END IF
-!
-!* 3.1.3 budget storage
-!
-IF (LBUDGET_TH) CALL BUDGET (PTHS(:,:,:)*PRHODJ(:,:,:),NBUDGET_TH,'HENU_BU_RTH')
-IF (LBUDGET_RV) CALL BUDGET (PRVS(:,:,:)*PRHODJ(:,:,:),NBUDGET_RV,'HENU_BU_RRV')
-IF (LBUDGET_RI) CALL BUDGET (PRIS(:,:,:)*PRHODJ(:,:,:),NBUDGET_RI,'HENU_BU_RRI')
-!
+
END SUBROUTINE RAIN_ICE_ELEC_NUCLEATION
!
!-------------------------------------------------------------------------------
@@ -2506,6 +2354,13 @@ IMPLICIT NONE
!
!* 3.5.1 compute the homogeneous nucleation source: RCHONI & QCHONI
!
+ if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1 ), 'HON', &
+ Unpack( zqcs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'HON', &
+ Unpack( zqis(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
+
ZZW(:) = 0.0
ZWQ1(:,1:7) = 0.0
!
@@ -2529,23 +2384,19 @@ IMPLICIT NONE
ZQIS(:) = ZQIS(:) + ZWQ1(:,1)
ZQCS(:) = ZQCS(:) - ZWQ1(:,1)
END WHERE
-!
- IF (LBUDGET_TH) CALL BUDGET ( &
- UNPACK(ZTHS(:),MASK=GMICRO(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:), &
- NBUDGET_TH,'HON_BU_RTH')
- IF (LBUDGET_RC) CALL BUDGET ( &
- UNPACK(ZRCS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
- NBUDGET_RC,'HON_BU_RRC')
- IF (LBUDGET_RI) CALL BUDGET ( &
- UNPACK(ZRIS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
- NBUDGET_RI,'HON_BU_RRI')
-!
- IF (LBUDGET_SV) THEN
- CALL BUDGET (UNPACK(ZQCS(:)*ZRHODJ(:), MASK=GMICRO(:,:,:), FIELD=0.0),&
- NBUDGET_SV1-1+NSV_ELECBEG+1,'HON_BU_RSV')
- CALL BUDGET (UNPACK(ZQIS(:)*ZRHODJ(:), MASK=GMICRO(:,:,:), FIELD=0.0), &
- NBUDGET_SV1-1+NSV_ELECBEG+3,'HON_BU_RSV')
- END IF
+
+ if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'HON', Unpack( zzw(:) * ( zlsfact(:) - zlvfact(:) ) &
+ * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rc ) call Budget_store_add( tbudgets(NBUDGET_RC), 'HON', &
+ Unpack( -zzw(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_ri ) call Budget_store_add( tbudgets(NBUDGET_RI), 'HON', &
+ Unpack( zzw(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1 ), 'HON', &
+ Unpack( zqcs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'HON', &
+ Unpack( zqis(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
!
!* 3.5.2 compute the spontaneous freezing source: RRHONG & QRHONG
!
@@ -2565,24 +2416,19 @@ IMPLICIT NONE
ZQGS(:) = ZQGS(:) + ZWQ1(:,2)
ZQRS(:) = ZQRS(:) - ZWQ1(:,2)
ENDWHERE
-!
- IF (LBUDGET_TH) CALL BUDGET ( &
- UNPACK(ZTHS(:),MASK=GMICRO(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:), &
- NBUDGET_TH,'SFR_BU_RTH')
- IF (LBUDGET_RR) CALL BUDGET ( &
- UNPACK(ZRRS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
- NBUDGET_RR,'SFR_BU_RRR')
- IF (LBUDGET_RG) CALL BUDGET ( &
- UNPACK(ZRGS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
- NBUDGET_RG,'SFR_BU_RRG')
-!
- IF (LBUDGET_SV) THEN
- CALL BUDGET (UNPACK(ZQRS(:)*ZRHODJ(:), MASK=GMICRO(:,:,:), FIELD=0.0),&
- NBUDGET_SV1-1+NSV_ELECBEG+2,'HON_BU_RSV')
- CALL BUDGET (UNPACK(ZQGS(:)*ZRHODJ(:), MASK=GMICRO(:,:,:), FIELD=0.0), &
- NBUDGET_SV1-1+NSV_ELECEND, 'HON_BU_RSV')
- END IF
+ if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'SFR', Unpack( zzw(:) * ( zlsfact(:) - zlvfact(:) ) &
+ * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rr ) call Budget_store_add( tbudgets(NBUDGET_RR), 'SFR', &
+ Unpack( -zzw(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rg ) call Budget_store_add( tbudgets(NBUDGET_RG), 'SFR', &
+ Unpack( zzw(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_sv ) then
+ call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2 ), 'SFR', &
+ Unpack( -zwq1(:, 2) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'SFR', &
+ Unpack( zwq1(:, 2) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
!
!* 3.5.3 compute the deposition, aggregation and autoconversion sources
!
@@ -2599,6 +2445,15 @@ IMPLICIT NONE
!
!* 3.5.3.2 compute the riming-conversion of r_c for r_i production: RCAUTI
!
+ if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg ), 'DEPS', &
+ Unpack( zqpis(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecend ), 'DEPS', &
+ Unpack( zqnis(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 4 ), 'DEPS', &
+ Unpack( zqss(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
+
ZZW(:) = 0.0
!
WHERE ((ZRST(:) > XRTMIN(5)) .AND. (ZRSS(:) > 0.0))
@@ -2620,28 +2475,31 @@ IMPLICIT NONE
ZQPIS(:) = ZQPIS(:) + MAX( 0.0,ZWQ1(:,5)/XECHARGE )
ZQNIS(:) = ZQNIS(:) - MIN( 0.0,ZWQ1(:,5)/XECHARGE )
ENDWHERE
-!
- IF (LBUDGET_TH) CALL BUDGET ( &
- UNPACK(ZTHS(:),MASK=GMICRO(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:), &
- NBUDGET_TH,'DEPS_BU_RTH')
- IF (LBUDGET_RV) CALL BUDGET ( &
- UNPACK(ZRVS(:),MASK=GMICRO(:,:,:),FIELD=PRVS)*PRHODJ(:,:,:), &
- NBUDGET_RV,'DEPS_BU_RRV')
- IF (LBUDGET_RS) CALL BUDGET ( &
- UNPACK(ZRSS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
- NBUDGET_RS,'DEPS_BU_RRS')
-!
- IF (LBUDGET_SV) THEN
- CALL BUDGET (UNPACK(ZQPIS(:), MASK=GMICRO(:,:,:), FIELD=PQPIS) &
- *PRHODJ(:,:,:), NBUDGET_SV1-1+NSV_ELECBEG ,'DEPS_BU_RSV')
- CALL BUDGET (UNPACK(ZQNIS(:), MASK=GMICRO(:,:,:), FIELD=PQNIS) &
- *PRHODJ(:,:,:), NBUDGET_SV1-1+NSV_ELECEND ,'DEPS_BU_RSV')
- CALL BUDGET (UNPACK(ZQSS(:)*ZRHODJ(:), MASK=GMICRO(:,:,:), FIELD=0.0), &
- NBUDGET_SV1-1+NSV_ELECBEG+4,'DEPS_BU_RSV')
- END IF
+
+ if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'DEPS', Unpack( zzw(:) * zlsfact(:) &
+ * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rv ) call Budget_store_add( tbudgets(NBUDGET_RV), 'DEPS', &
+ Unpack( -zzw(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rs ) call Budget_store_add( tbudgets(NBUDGET_RS), 'DEPS', &
+ Unpack( zzw(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg ), 'DEPS', &
+ Unpack( zqpis(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecend ), 'DEPS', &
+ Unpack( zqnis(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 4 ), 'DEPS', &
+ Unpack( zqss(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
!
!* 3.5.3.4 compute the aggregation on r_s: RIAGGS & QIAGGS
!
+ if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'AGGS', &
+ Unpack( zqis(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 4 ), 'AGGS', &
+ Unpack( zqss(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
+
ZZW(:) = 0.0
ZLATHAMIAGGS(:) = 1.0
IF (LIAGGS_LATHAM) THEN
@@ -2666,37 +2524,48 @@ IMPLICIT NONE
ZQSS(:) = ZQSS(:) + ZWQ1(:,3)
ZQIS(:) = ZQIS(:) - ZWQ1(:,3)
END WHERE
-!
- IF (LBUDGET_RI) CALL BUDGET ( &
- UNPACK(ZRIS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
- NBUDGET_RI,'AGGS_BU_RRI')
- IF (LBUDGET_RS) CALL BUDGET ( &
- UNPACK(ZRSS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
- NBUDGET_RS,'AGGS_BU_RRS')
-!
- IF (LBUDGET_SV) THEN
- CALL BUDGET (UNPACK(ZQIS(:)*ZRHODJ(:), MASK=GMICRO(:,:,:), FIELD=0.0), &
- NBUDGET_SV1-1+NSV_ELECBEG+3,'AGGS_BU_RSV')
- CALL BUDGET (UNPACK(ZQSS(:)*ZRHODJ(:), MASK=GMICRO(:,:,:), FIELD=0.0), &
- NBUDGET_SV1-1+NSV_ELECBEG+4,'AGGS_BU_RSV')
- END IF
-!
+
+ if ( lbudget_ri ) call Budget_store_add( tbudgets(NBUDGET_RI), 'AGGS', &
+ Unpack( -zzw(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rs ) call Budget_store_add( tbudgets(NBUDGET_RS), 'AGGS', &
+ Unpack( zzw(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'AGGS', &
+ Unpack( zqis(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 4 ), 'AGGS', &
+ Unpack( zqss(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
+
+ if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'NIIS', &
+ Unpack( zqis(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 4 ), 'NIIS', &
+ Unpack( zqss(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
+
CALL ELEC_IAGGS_B() ! QIAGGS_boun
-!
+
+ if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'NIIS', &
+ Unpack( zqis(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 4 ), 'NIIS', &
+ Unpack( zqss(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
+
! Save the NI charging rate for temporal series
XNI_IAGGS(:,:,:) = UNPACK(ZWQ1(:,7), MASK=GMICRO, FIELD=0.0)
XNI_IAGGS(:,:,:) = XNI_IAGGS(:,:,:) * PRHODREF(:,:,:) ! C/m3/s
-!
- IF (LBUDGET_SV) THEN
- CALL BUDGET (UNPACK(ZQIS(:)*ZRHODJ(:), MASK=GMICRO(:,:,:), FIELD=0.0), &
- NBUDGET_SV1-1+NSV_ELECBEG+3,'NIIS_BU_RSV')
- CALL BUDGET (UNPACK(ZQSS(:)*ZRHODJ(:), MASK=GMICRO(:,:,:), FIELD=0.0), &
- NBUDGET_SV1-1+NSV_ELECBEG+4,'NIIS_BU_RSV')
- END IF
!
!* 3.5.3.5 compute the autoconversion of r_i for r_s production:
! RIAUTS & QIAUTS
!
+ if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'AUTS', &
+ Unpack( zqis(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 4 ), 'AUTS', &
+ Unpack( zqss(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
+
ALLOCATE( ZCRIAUTI(IMICRO ))
ZCRIAUTI(:) = MIN(XCRIAUTI,10**(0.06*(ZZT(:)-XTT)-3.5))
ZZW(:) = 0.0
@@ -2717,22 +2586,29 @@ IMPLICIT NONE
END WHERE
!
DEALLOCATE(ZCRIAUTI)
- IF (LBUDGET_RI) CALL BUDGET ( &
- UNPACK(ZRIS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
- NBUDGET_RI,'AUTS_BU_RRI')
- IF (LBUDGET_RS) CALL BUDGET ( &
- UNPACK(ZRSS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
- NBUDGET_RS,'AUTS_BU_RRS')
-!
- IF (LBU_RSV) THEN
- CALL BUDGET (UNPACK(ZQIS(:)*ZRHODJ(:), MASK=GMICRO(:,:,:), FIELD=0.0), &
- NBUDGET_SV1-1+NSV_ELECBEG+3,'AUTS_BU_RSV')
- CALL BUDGET (UNPACK(ZQSS(:)*ZRHODJ(:), MASK=GMICRO(:,:,:), FIELD=0.0), &
- NBUDGET_SV1-1+NSV_ELECBEG+4,'AUTS_BU_RSV')
- END IF
+
+ if ( lbudget_ri ) call Budget_store_add( tbudgets(NBUDGET_RI), 'AUTS', &
+ Unpack( -zzw(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rs ) call Budget_store_add( tbudgets(NBUDGET_RS), 'AUTS', &
+ Unpack( zzw(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'AUTS', &
+ Unpack( zqis(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 4 ), 'AUTS', &
+ Unpack( zqss(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
!
!* 3.5.3.6 compute the deposition on r_g: RVDEPG & QVDEPG
!
+ if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg ), 'DEPG', &
+ Unpack( zqpis(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecend ), 'DEPG', &
+ Unpack( zqnis(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'DEPG', &
+ Unpack( zqgs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
+
ZZW(:) = 0.0
!
WHERE ((ZRGT(:) > XRTMIN(6)) .AND. (ZRGS(:) > 0.0))
@@ -2754,26 +2630,22 @@ IMPLICIT NONE
ZQPIS(:) = ZQPIS(:) + MAX( 0.0,ZWQ1(:,6)/XECHARGE )
ZQNIS(:) = ZQNIS(:) - MIN( 0.0,ZWQ1(:,6)/XECHARGE )
END WHERE
-!
- IF (LBUDGET_TH) CALL BUDGET ( &
- UNPACK(ZTHS(:),MASK=GMICRO(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:), &
- NBUDGET_TH,'DEPG_BU_RTH')
- IF (LBUDGET_RV) CALL BUDGET ( &
- UNPACK(ZRVS(:),MASK=GMICRO(:,:,:),FIELD=PRVS)*PRHODJ(:,:,:), &
- NBUDGET_RV,'DEPG_BU_RRV')
- IF (LBUDGET_RG) CALL BUDGET ( &
- UNPACK(ZRGS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
- NBUDGET_RG,'DEPG_BU_RRG')
-!
- IF (LBU_RSV) THEN
- CALL BUDGET (UNPACK(ZQPIS(:), MASK=GMICRO(:,:,:), FIELD=PQPIS) &
- *PRHODJ(:,:,:), NBUDGET_SV1-1+NSV_ELECBEG ,'DEPG_BU_RSV')
- CALL BUDGET (UNPACK(ZQNIS(:), MASK=GMICRO(:,:,:), FIELD=PQNIS) &
- *PRHODJ(:,:,:), NBUDGET_SV1-1+NSV_ELECEND ,'DEPG_BU_RSV')
- CALL BUDGET (UNPACK(ZQGS(:)*ZRHODJ(:), MASK=GMICRO(:,:,:), FIELD=0.0), &
- NBUDGET_SV1-1+NSV_ELECEND,'DEPG_BU_RSV')
- END IF
-!
+
+ if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'DEPG', Unpack( zzw(:) * zlsfact(:) &
+ * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rv ) call Budget_store_add( tbudgets(NBUDGET_RV), 'DEPG', &
+ Unpack( -zzw(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rg ) call Budget_store_add( tbudgets(NBUDGET_RG), 'DEPG', &
+ Unpack( zzw(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg ), 'DEPG', &
+ Unpack( zqpis(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecend ), 'DEPG', &
+ Unpack( zqnis(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'DEPG', &
+ Unpack( zqgs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
+
END SUBROUTINE RAIN_ICE_ELEC_SLOW
!
!-------------------------------------------------------------------------------
@@ -2793,6 +2665,13 @@ REAL :: ZCRIAUTC ! Critical cloud mixing ratio
!* 4.1 compute the autoconversion of r_c for r_r production:
! RCAUTR & QCAUTR
!
+ if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1 ), 'AUTO', &
+ Unpack( zqcs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2 ), 'AUTO', &
+ Unpack( zqrs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
+
ZZW(:) = 0.0
ZWQ1(:,1:3) = 0.0
!
@@ -2837,24 +2716,27 @@ REAL :: ZCRIAUTC ! Critical cloud mixing ratio
ZQCS(:) = ZQCS(:) - ZWQ1(:,1)
ZQRS(:) = ZQRS(:) + ZWQ1(:,1)
END WHERE
-!
- IF (LBUDGET_RC) CALL BUDGET ( &
- UNPACK(ZRCS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
- NBUDGET_RC,'AUTO_BU_RRC')
- IF (LBUDGET_RR) CALL BUDGET ( &
- UNPACK(ZRRS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
- NBUDGET_RR,'AUTO_BU_RRR')
-!
- IF (LBUDGET_SV) THEN
- CALL BUDGET (UNPACK(ZQCS(:)*ZRHODJ(:), MASK=GMICRO(:,:,:), FIELD=0.0), &
- NBUDGET_SV1-1+NSV_ELECBEG+1,'AUTO_BU_RSV')
- CALL BUDGET (UNPACK(ZQRS(:)*ZRHODJ(:), MASK=GMICRO(:,:,:), FIELD=0.0), &
- NBUDGET_SV1-1+NSV_ELECBEG+2,'AUTO_BU_RSV')
- END IF
-!
+
+ if ( lbudget_rc ) call Budget_store_add( tbudgets(NBUDGET_RC), 'AUTO', &
+ Unpack( -zzw(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rr ) call Budget_store_add( tbudgets(NBUDGET_RR), 'AUTO', &
+ Unpack( zzw(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1 ), 'AUTO', &
+ Unpack( zqcs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2 ), 'AUTO', &
+ Unpack( zqrs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
!
!* 4.2 compute the accretion of r_c for r_r production: RCACCR & QCACCR
!
+ if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1 ), 'ACCR', &
+ Unpack( zqcs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2 ), 'ACCR', &
+ Unpack( zqrs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
+
ZZW(:) = 0.0
WHERE ((ZRCT(:) > XRTMIN(2)) .AND. (ZRRT(:) > XRTMIN(3)) .AND. (ZRCS(:) > 0.0))
ZZW(:) = MIN( ZRCS(:),XFCACCR * ZRCT(:) &
@@ -2871,24 +2753,30 @@ REAL :: ZCRIAUTC ! Critical cloud mixing ratio
ZQCS(:) = ZQCS(:) - ZWQ1(:,2)
ZQRS(:) = ZQRS(:) + ZWQ1(:,2)
ENDWHERE
-!
- IF (LBUDGET_RC) CALL BUDGET ( &
- UNPACK(ZRCS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
- NBUDGET_RC,'ACCR_BU_RRC')
- IF (LBUDGET_RR) CALL BUDGET ( &
- UNPACK(ZRRS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
- NBUDGET_RR,'ACCR_BU_RRR')
-!
- IF (LBU_RSV) THEN
- CALL BUDGET (UNPACK(ZQCS(:)*ZRHODJ(:), MASK=GMICRO(:,:,:), FIELD=0.0), &
- NBUDGET_SV1-1+NSV_ELECBEG+1,'ACCR_BU_RSV')
- CALL BUDGET (UNPACK(ZQRS(:)*ZRHODJ(:), MASK=GMICRO(:,:,:), FIELD=0.0), &
- NBUDGET_SV1-1+NSV_ELECBEG+2,'ACCR_BU_RSV')
- END IF
+
+ if ( lbudget_rc ) call Budget_store_add( tbudgets(NBUDGET_RC), 'ACCR', &
+ Unpack( -zzw(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rr ) call Budget_store_add( tbudgets(NBUDGET_RR), 'ACCR', &
+ Unpack( zzw(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1 ), 'ACCR', &
+ Unpack( zqcs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2 ), 'ACCR', &
+ Unpack( zqrs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
!
!
!* 4.3 compute the evaporation of r_r: RREVAV & QREVAV
!
+ if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg ), 'REVA', &
+ Unpack( zqpis(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecend ), 'REVA', &
+ Unpack( zqnis(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2 ), 'REVA', &
+ Unpack( zqrs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
+
ZZW(:) = 0.0
WHERE ((ZRRT(:) > XRTMIN(3)) .AND. (ZRCT(:) <= XRTMIN(2)))
ZZW(:) = EXP( XALPW - XBETAW/ZZT(:) - XGAMW*ALOG(ZZT(:) ) ) ! es_w
@@ -2914,27 +2802,23 @@ REAL :: ZCRIAUTC ! Critical cloud mixing ratio
ZQNIS(:) = ZQNIS(:) - MIN( 0.0,ZWQ1(:,3)/XECHARGE )
ENDWHERE
!
- IF (LBUDGET_TH) CALL BUDGET ( &
- UNPACK(ZTHS(:),MASK=GMICRO(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:), &
- NBUDGET_TH,'REVA_BU_RTH')
- IF (LBUDGET_RV) CALL BUDGET ( &
- UNPACK(ZRVS(:),MASK=GMICRO(:,:,:),FIELD=PRVS)*PRHODJ(:,:,:), &
- NBUDGET_RV,'REVA_BU_RRV')
- IF (LBUDGET_RR) CALL BUDGET ( &
- UNPACK(ZRRS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
- NBUDGET_RR,'REVA_BU_RRR')
- ZW(:,:,:)=PEVAP3D(:,:,:)
- PEVAP3D(:,:,:)=UNPACK(ZZW(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:))
-!
- IF (LBUDGET_SV) THEN
- CALL BUDGET (UNPACK(ZQPIS(:), MASK=GMICRO(:,:,:), FIELD=PQPIS) &
- *PRHODJ(:,:,:), NBUDGET_SV1-1+NSV_ELECBEG ,'REVA_BU_RSV')
- CALL BUDGET (UNPACK(ZQNIS(:), MASK=GMICRO(:,:,:), FIELD=PQNIS) &
- *PRHODJ(:,:,:), NBUDGET_SV1-1+NSV_ELECEND ,'REVA_BU_RSV')
- CALL BUDGET (UNPACK(ZQRS(:)*ZRHODJ(:), MASK=GMICRO(:,:,:), FIELD=0.0), &
- NBUDGET_SV1-1+NSV_ELECBEG+2,'REVA_BU_RSV')
- END IF
-!
+ PEVAP3D(:,:,:)=UNPACK(ZZW(:),MASK=GMICRO(:,:,:),FIELD=PEVAP3D(:,:,:))
+
+ if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'REVA', &
+ Unpack( -zzw(:) * zlvfact(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rv ) call Budget_store_add( tbudgets(NBUDGET_RV), 'REVA', &
+ Unpack( zzw(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rr ) call Budget_store_add( tbudgets(NBUDGET_RR), 'REVA', &
+ Unpack( -zzw(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg ), 'REVA', &
+ Unpack( zqpis(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecend ), 'REVA', &
+ Unpack( zqnis(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2 ), 'REVA', &
+ Unpack( zqrs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
+
END SUBROUTINE RAIN_ICE_ELEC_WARM
!
!-------------------------------------------------------------------------------
@@ -2950,7 +2834,6 @@ IMPLICIT NONE
!
!* 5.1 cloud droplet riming of the aggregates
!
- ZZW1(:,:) = 0.0
ZZW1(:,:) = 0.0
ZWQ1(:,1:7) = 0.0
!
@@ -2960,6 +2843,14 @@ IMPLICIT NONE
IGRIM = COUNT( GRIM(:) )
!
IF (IGRIM > 0) THEN
+ if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1 ), 'RIM', &
+ Unpack( zqcs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 4 ), 'RIM', &
+ Unpack( zqss(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'RIM', &
+ Unpack( zqgs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
!
! 5.1.0 allocations
!
@@ -3065,29 +2956,23 @@ IMPLICIT NONE
DEALLOCATE(IVEC1)
DEALLOCATE(ZVEC2)
DEALLOCATE(ZVEC1)
- END IF
-!
- IF (LBUDGET_TH) CALL BUDGET ( &
- UNPACK(ZTHS(:),MASK=GMICRO(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:), &
- NBUDGET_TH,'RIM_BU_RTH')
- IF (LBUDGET_RC) CALL BUDGET ( &
- UNPACK(ZRCS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
- NBUDGET_RC,'RIM_BU_RRC')
- IF (LBUDGET_RS) CALL BUDGET ( &
- UNPACK(ZRSS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
- NBUDGET_RS,'RIM_BU_RRS')
- IF (LBUDGET_RG) CALL BUDGET ( &
- UNPACK(ZRGS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
- NBUDGET_RG,'RIM_BU_RRG')
-!
-!
- IF (LBUDGET_SV) THEN
- CALL BUDGET (UNPACK(ZQCS(:)*ZRHODJ(:), MASK=GMICRO(:,:,:), FIELD=0.0), &
- NBUDGET_SV1-1+NSV_ELECBEG+1,'RIM_BU_RSV')
- CALL BUDGET (UNPACK(ZQSS(:)*ZRHODJ(:), MASK=GMICRO(:,:,:), FIELD=0.0), &
- NBUDGET_SV1-1+NSV_ELECBEG+4,'RIM_BU_RSV')
- CALL BUDGET (UNPACK(ZQGS(:)*ZRHODJ(:), MASK=GMICRO(:,:,:), FIELD=0.0), &
- NBUDGET_SV1-1+NSV_ELECEND,'RIM_BU_RSV')
+
+ if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'RIM', Unpack( ( zzw1(:,1) + zzw1(:,2) ) &
+ * ( zlsfact(:) - zlvfact(:) ) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rc ) call Budget_store_add( tbudgets(NBUDGET_RC), 'RIM', &
+ Unpack( ( -zzw1(:,1) - zzw1(:,2) ) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rs ) call Budget_store_add( tbudgets(NBUDGET_RS), 'RIM', &
+ Unpack( ( zzw1(:,1) - zzw1(:,3) ) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rg ) call Budget_store_add( tbudgets(NBUDGET_RG), 'RIM', &
+ Unpack( ( zzw1(:,2) + zzw1(:,3) ) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1 ), 'RIM', &
+ Unpack( zqcs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 4 ), 'RIM', &
+ Unpack( zqss(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'RIM', &
+ Unpack( zqgs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
END IF
!
DEALLOCATE(GRIM)
@@ -3104,6 +2989,22 @@ IMPLICIT NONE
IGACC = COUNT( GACC(:) )
!
IF( IGACC>0 ) THEN
+ if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'ACC', &
+ Unpack( zths(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'ACC', &
+ Unpack( zrrs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rs ) call Budget_store_init( tbudgets(NBUDGET_RS), 'ACC', &
+ Unpack( zrss(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rg ) call Budget_store_init( tbudgets(NBUDGET_RG), 'ACC', &
+ Unpack( zrgs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1 ), 'ACC', &
+ Unpack( zqcs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 4 ), 'ACC', &
+ Unpack( zqss(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'ACC', &
+ Unpack( zqgs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
!
! 5.2.0 allocations
!
@@ -3243,32 +3144,36 @@ IMPLICIT NONE
DEALLOCATE( ZVECQ4 )
DEALLOCATE( ZVECQ5 )
DEALLOCATE( ZVECQ6 )
+
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'ACC', &
+ Unpack( zths(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'ACC', &
+ Unpack( zrrs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rs ) call Budget_store_end( tbudgets(NBUDGET_RS), 'ACC', &
+ Unpack( zrss(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG), 'ACC', &
+ Unpack( zrgs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1 ), 'ACC', &
+ Unpack( zqcs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 4 ), 'ACC', &
+ Unpack( zqss(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'ACC', &
+ Unpack( zqgs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
END IF
+
DEALLOCATE(GACC)
- IF (LBUDGET_TH) CALL BUDGET ( &
- UNPACK(ZTHS(:),MASK=GMICRO(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:), &
- NBUDGET_TH,'ACC_BU_RTH')
- IF (LBUDGET_RR) CALL BUDGET ( &
- UNPACK(ZRRS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
- NBUDGET_RR,'ACC_BU_RRR')
- IF (LBUDGET_RS) CALL BUDGET ( &
- UNPACK(ZRSS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
- NBUDGET_RS,'ACC_BU_RRS')
- IF (LBUDGET_RG) CALL BUDGET ( &
- UNPACK(ZRGS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
- NBUDGET_RG,'ACC_BU_RRG')
-!
- IF (LBUDGET_SV) THEN
- CALL BUDGET (UNPACK(ZQRS(:)*ZRHODJ(:), MASK=GMICRO(:,:,:), FIELD=0.0), &
- NBUDGET_SV1-1+NSV_ELECBEG+2,'ACC_BU_RSV')
- CALL BUDGET (UNPACK(ZQSS(:)*ZRHODJ(:), MASK=GMICRO(:,:,:), FIELD=0.0), &
- NBUDGET_SV1-1+NSV_ELECBEG+4,'ACC_BU_RSV')
- CALL BUDGET (UNPACK(ZQGS(:)*ZRHODJ(:), MASK=GMICRO(:,:,:), FIELD=0.0), &
- NBUDGET_SV1-1+NSV_ELECEND,'ACC_BU_RSV')
- END IF
!
!* 5.3 Conversion-Melting of the aggregates: RSMLT & QSMLT
!
+ if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 4 ), 'CMEL', &
+ Unpack( zqss(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'CMEL', &
+ Unpack( zqgs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
+
ZZW(:) = 0.0
WHERE ((ZRST(:) > XRTMIN(5)) .AND. (ZRSS(:) > 0.0) .AND. (ZZT(:) > XTT))
ZZW(:) = ZRVT(:) * ZPRES(:) / ((XMV / XMD) + ZRVT(:)) ! Vapor pressure
@@ -3300,21 +3205,18 @@ IMPLICIT NONE
ZQGS(:) = ZQGS(:) + ZWQ1(:,7)
ZQSS(:) = ZQSS(:) - ZWQ1(:,7)
ENDWHERE
-!
- IF (LBUDGET_RS) CALL BUDGET ( &
- UNPACK(ZRSS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
- NBUDGET_RS,'CMEL_BU_RRS')
- IF (LBUDGET_RG) CALL BUDGET ( &
- UNPACK(ZRGS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
- NBUDGET_RG,'CMEL_BU_RRG')
-!
- IF (LBUDGET_SV) THEN
- CALL BUDGET (UNPACK(ZQSS(:)*ZRHODJ(:), MASK=GMICRO(:,:,:), FIELD=0.0), &
- NBUDGET_SV1-1+NSV_ELECBEG+4,'CMEL_BU_RSV')
- CALL BUDGET (UNPACK(ZQGS(:)*ZRHODJ(:), MASK=GMICRO(:,:,:), FIELD=0.0), &
- NBUDGET_SV1-1+NSV_ELECEND,'CMEL_BU_RSV')
- END IF
-!
+
+ if ( lbudget_rs ) call Budget_store_add( tbudgets(NBUDGET_RS), 'CMEL', &
+ Unpack( -zzw(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG), 'CMEL', &
+ Unpack( zzw(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 4 ), 'CMEL', &
+ Unpack( zqss(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'CMEL', &
+ Unpack( zqgs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
+
END SUBROUTINE RAIN_ICE_ELEC_FAST_RS
!
!-------------------------------------------------------------------------------
@@ -3331,6 +3233,15 @@ IMPLICIT NONE
!
!* 6.1 rain contact freezing: RICFRRG & QICFRRG and RRCFRIG & QRCFRIG
!
+ if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2 ), 'CFRZ', &
+ Unpack( zqrs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'CFRZ', &
+ Unpack( zqis(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'CFRZ', &
+ Unpack( zqgs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
+
ZZW1(:,3:4) = 0.0
ZWQ1(:,3:4) = 0.0
WHERE ((ZRIT(:) > XRTMIN(4)) .AND. (ZRRT(:) > XRTMIN(3)) .AND. &
@@ -3365,32 +3276,56 @@ IMPLICIT NONE
ZQGS(:) = ZQGS(:) + ZWQ1(:,3)
ZQIS(:) = ZQIS(:) - ZWQ1(:,3)
ENDWHERE
-!
- IF (LBUDGET_TH) CALL BUDGET ( &
- UNPACK(ZTHS(:),MASK=GMICRO(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:), &
- NBUDGET_TH,'CFRZ_BU_RTH')
- IF (LBUDGET_RR) CALL BUDGET ( &
- UNPACK(ZRRS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
- NBUDGET_RR,'CFRZ_BU_RRR')
- IF (LBUDGET_RI) CALL BUDGET ( &
- UNPACK(ZRIS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
- NBUDGET_RI,'CFRZ_BU_RRI')
- IF (LBUDGET_RG) CALL BUDGET ( &
- UNPACK(ZRGS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
- NBUDGET_RG,'CFRZ_BU_RRG')
-!
- IF (LBU_RSV) THEN
- CALL BUDGET (UNPACK(ZQRS(:)*ZRHODJ(:), MASK=GMICRO(:,:,:), FIELD=0.0), &
- NBUDGET_SV1-1+NSV_ELECBEG+2,'CFRZ_BU_RSV')
- CALL BUDGET (UNPACK(ZQIS(:)*ZRHODJ(:), MASK=GMICRO(:,:,:), FIELD=0.0), &
- NBUDGET_SV1-1+NSV_ELECBEG+3,'CFRZ_BU_RSV')
- CALL BUDGET (UNPACK(ZQGS(:)*ZRHODJ(:), MASK=GMICRO(:,:,:), FIELD=0.0), &
- NBUDGET_SV1-1+NSV_ELECEND,'CFRZ_BU_RSV')
- END IF
-!
+
+ if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'CFRZ', Unpack( zzw1(:,4) * ( zlsfact(:) - zlvfact(:) ) &
+ * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rr ) call Budget_store_add( tbudgets(NBUDGET_RR), 'CFRZ', &
+ Unpack( -zzw1(:, 4) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_ri ) call Budget_store_add( tbudgets(NBUDGET_RI), 'CFRZ', &
+ Unpack( -zzw1(:, 3) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rg ) call Budget_store_add( tbudgets(NBUDGET_RG), 'CFRZ', &
+ Unpack( ( zzw1(:, 3) + zzw1(:, 4) ) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2 ), 'CFRZ', &
+ Unpack( zqrs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'CFRZ', &
+ Unpack( zqis(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'CFRZ', &
+ Unpack( zqgs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
!
!* 6.2 compute the Dry growth case
!
+ if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'WETG', &
+ Unpack( zths(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'WETG', &
+ Unpack( zrcs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'WETG', &
+ Unpack( zrrs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'WETG', &
+ Unpack( zris(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rs ) call Budget_store_init( tbudgets(NBUDGET_RS), 'WETG', &
+ Unpack( zrss(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rg ) call Budget_store_init( tbudgets(NBUDGET_RG), 'WETG', &
+ Unpack( zrgs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rh ) call Budget_store_init( tbudgets(NBUDGET_RH), 'WETG', &
+ Unpack( zrhs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1 ), 'WETG', &
+ Unpack( zqcs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2 ), 'WETG', &
+ Unpack( zqrs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'WETG', &
+ Unpack( zqis(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 4 ), 'WETG', &
+ Unpack( zqss(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'WETG', &
+ Unpack( zqgs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( krr == 7 ) &
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'WETG', &
+ Unpack( zqhs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
+
ZZW1(:,:) = 0.0
ZWQ1(:,1:10) = 0.0
ZWQ3(:) = 0.0
@@ -3748,44 +3683,62 @@ IMPLICIT NONE
ZQGS(:) = ZQGS(:) + ZWQ1(:,1) + ZWQ1(:,9) + ZWQ1(:,7) + ZWQ1(:,8)
END WHERE
END IF
-!
- IF (LBUDGET_TH) CALL BUDGET ( &
- UNPACK(ZTHS(:),MASK=GMICRO(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:), &
- NBUDGET_TH,'WETG_BU_RTH')
- IF (LBUDGET_RC) CALL BUDGET ( &
- UNPACK(ZRCS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
- NBUDGET_RC,'WETG_BU_RRC')
- IF (LBUDGET_RR) CALL BUDGET ( &
- UNPACK(ZRRS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
- NBUDGET_RR,'WETG_BU_RRR')
- IF (LBUDGET_RI) CALL BUDGET ( &
- UNPACK(ZRIS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
- NBUDGET_RI,'WETG_BU_RRI')
- IF (LBUDGET_RS) CALL BUDGET ( &
- UNPACK(ZRSS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
- NBUDGET_RS,'WETG_BU_RRS')
- IF (LBUDGET_RG) CALL BUDGET ( &
- UNPACK(ZRGS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
- NBUDGET_RG,'WETG_BU_RRG')
- IF ( KRR == 7 ) THEN
- IF (LBUDGET_RH) CALL BUDGET ( &
- UNPACK(ZRHS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
- NBUDGET_RH,'WETG_BU_RRH')
- END IF
-!
- IF (LBU_RSV) THEN
- CALL BUDGET (UNPACK(ZQCS(:)*ZRHODJ(:), MASK=GMICRO(:,:,:), FIELD=0.0), &
- NBUDGET_SV1-1+NSV_ELECBEG+1,'WETG_BU_RSV')
- CALL BUDGET (UNPACK(ZQRS(:)*ZRHODJ(:), MASK=GMICRO(:,:,:), FIELD=0.0), &
- NBUDGET_SV1-1+NSV_ELECBEG+2,'WETG_BU_RSV')
- CALL BUDGET (UNPACK(ZQIS(:)*ZRHODJ(:), MASK=GMICRO(:,:,:), FIELD=0.0), &
- NBUDGET_SV1-1+NSV_ELECBEG+3,'WETG_BU_RSV')
- CALL BUDGET (UNPACK(ZQSS(:)*ZRHODJ(:), MASK=GMICRO(:,:,:), FIELD=0.0), &
- NBUDGET_SV1-1+NSV_ELECBEG+4,'WETG_BU_RSV')
- CALL BUDGET (UNPACK(ZQGS(:)*ZRHODJ(:), MASK=GMICRO(:,:,:), FIELD=0.0), &
- NBUDGET_SV1-1+NSV_ELECEND,'WETG_BU_RSV')
- END IF
-!
+
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'WETG', &
+ Unpack( zths(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'WETG', &
+ Unpack( zrcs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'WETG', &
+ Unpack( zrrs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'WETG', &
+ Unpack( zris(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rs ) call Budget_store_end( tbudgets(NBUDGET_RS), 'WETG', &
+ Unpack( zrss(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG), 'WETG', &
+ Unpack( zrgs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rh ) call Budget_store_end( tbudgets(NBUDGET_RH), 'WETG', &
+ Unpack( zrhs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1 ), 'WETG', &
+ Unpack( zqcs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2 ), 'WETG', &
+ Unpack( zqrs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'WETG', &
+ Unpack( zqis(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 4 ), 'WETG', &
+ Unpack( zqss(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'WETG', &
+ Unpack( zqgs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( krr == 7 ) &
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 6 ), 'WETG', &
+ Unpack( zqhs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
+
+ if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'DRYG', &
+ Unpack( zths(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'DRYG', &
+ Unpack( zrcs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'DRYG', &
+ Unpack( zrrs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'DRYG', &
+ Unpack( zris(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rs ) call Budget_store_init( tbudgets(NBUDGET_RS), 'DRYG', &
+ Unpack( zrss(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rg ) call Budget_store_init( tbudgets(NBUDGET_RG), 'DRYG', &
+ Unpack( zrgs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1 ), 'DRYG', &
+ Unpack( zqcs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2 ), 'DRYG', &
+ Unpack( zqrs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'DRYG', &
+ Unpack( zqis(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 4 ), 'DRYG', &
+ Unpack( zqss(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'DRYG', &
+ Unpack( zqgs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
+
WHERE (ZRGT(:) > XRTMIN(6) .AND. ZZT(:) < XTT .AND. & ! Dry
ZRDRYG(:) < ZRWETG(:) .AND. ZRDRYG(:) > 0.0) ! case
ZRCS(:) = ZRCS(:) - ZZW1(:,1)
@@ -3803,43 +3756,42 @@ IMPLICIT NONE
ZQGS(:) = ZQGS(:) + ZWQ1(:,1) + ZWQ1(:,2) + ZWQ1(:,3) + ZWQ1(:,4) &
+ ZWQ1(:,5) + ZWQ1(:,6)
END WHERE
-!
- IF (LBUDGET_TH) CALL BUDGET ( &
- UNPACK(ZTHS(:),MASK=GMICRO(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:), &
- NBUDGET_TH,'DRYG_BU_RTH')
- IF (LBUDGET_RC) CALL BUDGET ( &
- UNPACK(ZRCS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
- NBUDGET_RC,'DRYG_BU_RRC')
- IF (LBUDGET_RR) CALL BUDGET ( &
- UNPACK(ZRRS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
- NBUDGET_RR,'DRYG_BU_RRR')
- IF (LBUDGET_RI) CALL BUDGET ( &
- UNPACK(ZRIS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
- NBUDGET_RI,'DRYG_BU_RRI')
- IF (LBUDGET_RS) CALL BUDGET ( &
- UNPACK(ZRSS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
- NBUDGET_RS,'DRYG_BU_RRS')
- IF (LBUDGET_RG) CALL BUDGET ( &
- UNPACK(ZRGS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
- NBUDGET_RG,'DRYG_BU_RRG')
-!
- IF (LBUDGET_SV) THEN
- CALL BUDGET (UNPACK(ZQCS(:)*ZRHODJ(:), MASK=GMICRO(:,:,:), FIELD=0.0), &
- NBUDGET_SV1-1+NSV_ELECBEG+1,'DRYG_BU_RSV')
- CALL BUDGET (UNPACK(ZQRS(:)*ZRHODJ(:), MASK=GMICRO(:,:,:), FIELD=0.0), &
- NBUDGET_SV1-1+NSV_ELECBEG+2,'DRYG_BU_RSV')
- CALL BUDGET (UNPACK(ZQIS(:)*ZRHODJ(:), MASK=GMICRO(:,:,:), FIELD=0.0), &
- NBUDGET_SV1-1+NSV_ELECBEG+3,'DRYG_BU_RSV')
- CALL BUDGET (UNPACK(ZQSS(:)*ZRHODJ(:), MASK=GMICRO(:,:,:), FIELD=0.0), &
- NBUDGET_SV1-1+NSV_ELECBEG+4,'DRYG_BU_RSV')
- CALL BUDGET (UNPACK(ZQGS(:)*ZRHODJ(:), MASK=GMICRO(:,:,:), FIELD=0.0), &
- NBUDGET_SV1-1+NSV_ELECEND,'DRYG_BU_RSV')
- END IF
-!
+
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'DRYG', &
+ Unpack( zths(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'DRYG', &
+ Unpack( zrcs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'DRYG', &
+ Unpack( zrrs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'DRYG', &
+ Unpack( zris(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rs ) call Budget_store_end( tbudgets(NBUDGET_RS), 'DRYG', &
+ Unpack( zrss(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG), 'DRYG', &
+ Unpack( zrgs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1 ), 'DRYG', &
+ Unpack( zqcs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2 ), 'DRYG', &
+ Unpack( zqrs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'DRYG', &
+ Unpack( zqis(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 4 ), 'DRYG', &
+ Unpack( zqss(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'DRYG', &
+ Unpack( zqgs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
!
! Inductive mecanism
!
IF (LINDUCTIVE) THEN
+ if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1), 'INCG', &
+ Unpack( zqcs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'INCG', &
+ Unpack( zqgs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
+
ZRATE_IND(:) = 0.
GIND(:) = ZRDRYG(:) > 0. .AND. ZRDRYG(:) < ZRWETG(:) .AND. ZZT(:) < XTT
IIND = COUNT(GIND(:))
@@ -3849,18 +3801,24 @@ IMPLICIT NONE
XIND_RATE(:,:,:) = 0.
XIND_RATE(:,:,:) = UNPACK(ZRATE_IND(:), MASK=GMICRO, FIELD=0.0)
XIND_RATE(:,:,:) = XIND_RATE(:,:,:) * PRHODREF(:,:,:) ! C/m3/s
+
+ if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1), 'INCG', &
+ Unpack( zqcs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'INCG', &
+ Unpack( zqgs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
END IF
-!
- IF (LBUDGET_SV) THEN
- CALL BUDGET (UNPACK(ZQCS(:)*ZRHODJ(:), MASK=GMICRO(:,:,:), FIELD=0.0), &
- NBUDGET_SV1-1+NSV_ELECBEG+1,'INCG_BU_RSV')
- CALL BUDGET (UNPACK(ZQGS(:)*ZRHODJ(:), MASK=GMICRO(:,:,:), FIELD=0.0), &
- NBUDGET_SV1-1+NSV_ELECEND,'INCG_BU_RSV')
- END IF
-!
!
!* 6.5 Melting of the graupeln
!
+ if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2), 'GMLT', &
+ Unpack( zqrs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'GMLT', &
+ Unpack( zqgs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
+
ZZW(:) = 0.0
ZWQ1(:,7) = 0.0
WHERE ((ZRGT(:) > XRTMIN(6)) .AND. (ZRGS(:) > 0.0) .AND. (ZZT(:) > XTT))
@@ -3889,24 +3847,20 @@ IMPLICIT NONE
ZQRS(:) = ZQRS(:) + ZWQ1(:,7)
ZQGS(:) = ZQGS(:) - ZWQ1(:,7)
ENDWHERE
-!
- IF (LBUDGET_TH) CALL BUDGET ( &
- UNPACK(ZTHS(:),MASK=GMICRO(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:),&
- NBUDGET_TH,'GMLT_BU_RTH')
- IF (LBUDGET_RR) CALL BUDGET ( &
- UNPACK(ZRRS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
- NBUDGET_RR,'GMLT_BU_RRR')
- IF (LBUDGET_RG) CALL BUDGET ( &
- UNPACK(ZRGS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
- NBUDGET_RG,'GMLT_BU_RRG')
-!
- IF (LBUDGET_SV) THEN
- CALL BUDGET (UNPACK(ZQRS(:)*ZRHODJ(:), MASK=GMICRO(:,:,:), FIELD=0.0), &
- NBUDGET_SV1-1+NSV_ELECBEG+2,'GMLT_BU_RSV')
- CALL BUDGET (UNPACK(ZQGS(:)*ZRHODJ(:), MASK=GMICRO(:,:,:), FIELD=0.0), &
- NBUDGET_SV1-1+NSV_ELECEND,'GMLT_BU_RSV')
- END IF
-!
+
+ if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'GMLT', Unpack( -zzw(:) * ( zlsfact(:) - zlvfact(:) ) &
+ * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rr ) call Budget_store_add( tbudgets(NBUDGET_RR), 'GMLT', &
+ Unpack( zzw(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rg ) call Budget_store_add( tbudgets(NBUDGET_RG), 'GMLT', &
+ Unpack( -zzw(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2), 'GMLT', &
+ Unpack( zqrs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'GMLT', &
+ Unpack( zqgs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
+
END SUBROUTINE RAIN_ICE_ELEC_FAST_RG
!
!-------------------------------------------------------------------------------
@@ -3926,6 +3880,20 @@ IMPLICIT NONE
IHAIL = COUNT(GHAIL(:))
!
IF( IHAIL>0 ) THEN
+ if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'WETH', &
+ Unpack( zths(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'WETH', &
+ Unpack( zrcs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'WETH', &
+ Unpack( zrrs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'WETH', &
+ Unpack( zris(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rs ) call Budget_store_init( tbudgets(NBUDGET_RS), 'WETH', &
+ Unpack( zrss(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rg ) call Budget_store_init( tbudgets(NBUDGET_RG), 'WETH', &
+ Unpack( zrgs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rh ) call Budget_store_init( tbudgets(NBUDGET_RH), 'WETH', &
+ Unpack( zrhs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
!
!* 7.2 compute the Wet growth of hail
!
@@ -4129,29 +4097,22 @@ IMPLICIT NONE
ZQGS(:) = ZQGS(:) - ZWQ1(:,5)
ZQRS(:) = ZQRS(:) - ZWQ1(:,4)
ZQHS(:) = ZQHS(:) + ZWQ1(:,1) + ZWQ1(:,2) + ZWQ1(:,3) + ZWQ1(:,4) + ZWQ1(:,5)
- END IF
- IF (LBUDGET_TH) CALL BUDGET ( &
- UNPACK(ZTHS(:),MASK=GMICRO(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:),&
- NBUDGET_TH,'WETH_BU_RTH')
- IF (LBUDGET_RC) CALL BUDGET ( &
- UNPACK(ZRCS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
- NBUDGET_RC,'WETH_BU_RRC')
- IF (LBUDGET_RR) CALL BUDGET ( &
- UNPACK(ZRRS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
- NBUDGET_RR,'WETH_BU_RRR')
- IF (LBUDGET_RI) CALL BUDGET ( &
- UNPACK(ZRIS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
- NBUDGET_RI,'WETH_BU_RRI')
- IF (LBUDGET_RS) CALL BUDGET ( &
- UNPACK(ZRSS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
- NBUDGET_RS,'WETH_BU_RRS')
- IF (LBUDGET_RG) CALL BUDGET ( &
- UNPACK(ZRGS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
- NBUDGET_RG,'WETH_BU_RRG')
- IF (LBUDGET_RH) CALL BUDGET ( &
- UNPACK(ZRHS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
- NBUDGET_RH,'WETH_BU_RRH')
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'WETH', &
+ Unpack( zths(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'WETH', &
+ Unpack( zrcs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'WETH', &
+ Unpack( zrrs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'WETH', &
+ Unpack( zris(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rs ) call Budget_store_end( tbudgets(NBUDGET_RS), 'WETH', &
+ Unpack( zrss(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG), 'WETH', &
+ Unpack( zrgs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rh ) call Budget_store_end( tbudgets(NBUDGET_RH), 'WETH', &
+ Unpack( zrhs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ END IF
!
IF (IHAIL > 0) THEN
!
@@ -4186,19 +4147,16 @@ IMPLICIT NONE
ZQRS(:) = ZQRS(:) + ZWQ1(:,7)
ZQHS(:) = ZQHS(:) - ZWQ1(:,7)
END WHERE
+
+ if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'HMLT', &
+ Unpack( -zzw(:) * ( zlsfact(:) - zlvfact(:) ) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rr ) call Budget_store_add( tbudgets(NBUDGET_RR), 'HMLT', &
+ Unpack( zzw(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rh ) call Budget_store_add( tbudgets(NBUDGET_RH), 'HMLT', &
+ Unpack( -zzw(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
END IF
!
DEALLOCATE(GHAIL)
-!
- IF (LBUDGET_TH) CALL BUDGET ( &
- UNPACK(ZTHS(:),MASK=GMICRO(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:),&
- NBUDGET_TH,'HMLT_BU_RTH')
- IF (LBUDGET_RR) CALL BUDGET ( &
- UNPACK(ZRRS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
- NBUDGET_RR,'HMLT_BU_RRR')
- IF (LBUDGET_RH) CALL BUDGET ( &
- UNPACK(ZRHS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
- NBUDGET_RH,'HMLT_BU_RRH')
!
END SUBROUTINE RAIN_ICE_ELEC_FAST_RH
!
@@ -4216,6 +4174,19 @@ IMPLICIT NONE
!
!* 7.1 cloud ice melting
!
+ if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'IMLT', &
+ Unpack( zths(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'IMLT', &
+ Unpack( zrcs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'IMLT', &
+ Unpack( zris(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1 ), 'IMLT', &
+ Unpack( zqcs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'IMLT', &
+ Unpack( zqis(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
+
ZZW(:) = 0.0
ZWQ1(:,1) = 0.0
WHERE ((ZRIS(:) > 0.0) .AND. (ZZT(:) > XTT))
@@ -4227,26 +4198,29 @@ IMPLICIT NONE
ZQCS(:) = ZQCS(:) + ZQIS(:)
ZQIS(:) = 0.
END WHERE
-!
- IF (LBUDGET_TH) CALL BUDGET ( &
- UNPACK(ZTHS(:),MASK=GMICRO(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:), &
- NBUDGET_TH,'IMLT_BU_RTH')
- IF (LBUDGET_RC) CALL BUDGET ( &
- UNPACK(ZRCS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
- NBUDGET_RC,'IMLT_BU_RRC')
- IF (LBUDGET_RI) CALL BUDGET ( &
- UNPACK(ZRIS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
- NBUDGET_RI,'IMLT_BU_RRI')
-!
- IF (LBUDGET_SV) THEN
- CALL BUDGET (UNPACK(ZQCS(:)*ZRHODJ(:), MASK=GMICRO(:,:,:), FIELD=0.0), &
- NBUDGET_SV1-1+NSV_ELECBEG+1,'IMLT_BU_RSV')
- CALL BUDGET (UNPACK(ZQIS(:)*ZRHODJ(:), MASK=GMICRO(:,:,:), FIELD=0.0), &
- NBUDGET_SV1-1+NSV_ELECBEG+3,'IMLT_BU_RSV')
- END IF
+
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'IMLT', &
+ Unpack( zths(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'IMLT', &
+ Unpack( zrcs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'IMLT', &
+ Unpack( zris(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1 ), 'IMLT', &
+ Unpack( zqcs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'IMLT', &
+ Unpack( zqis(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
!
!* 7.2 Bergeron-Findeisen effect: RCBERI
!
+ if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1 ), 'BERFI', &
+ Unpack( zqcs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'BERFI', &
+ Unpack( zqis(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
+
ZZW(:) = 0.0
ZWQ1(:,1) = 0.0
WHERE ((ZRCS(:) > 0.0) .AND. (ZSSI(:) > 0.0) .AND. &
@@ -4269,24 +4243,20 @@ IMPLICIT NONE
ZQIS(:) = ZQIS(:) + ZWQ1(:,1)
ZQCS(:) = ZQCS(:) - ZWQ1(:,1)
ENDWHERE
-!
- IF (LBUDGET_TH) CALL BUDGET ( &
- UNPACK(ZTHS(:),MASK=GMICRO(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:), &
- NBUDGET_TH,'BERFI_BU_RTH')
- IF (LBUDGET_RC) CALL BUDGET ( &
- UNPACK(ZRCS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
- NBUDGET_RC,'BERFI_BU_RRC')
- IF (LBUDGET_RI) CALL BUDGET ( &
- UNPACK(ZRIS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
- NBUDGET_RI,'BERFI_BU_RRI')
-!
- IF (LBUDGET_SV) THEN
- CALL BUDGET (UNPACK(ZQCS(:)*ZRHODJ(:), MASK=GMICRO(:,:,:), FIELD=0.0), &
- NBUDGET_SV1-1+NSV_ELECBEG+1,'BERFI_BU_RSV')
- CALL BUDGET (UNPACK(ZQIS(:)*ZRHODJ(:), MASK=GMICRO(:,:,:), FIELD=0.0), &
- NBUDGET_SV1-1+NSV_ELECBEG+3,'BERFI_BU_RSV')
- END IF
-!
+
+ if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'BERFI', &
+ Unpack( zzw(:) * ( zlsfact(:) - zlvfact(:) ) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rc ) call Budget_store_add( tbudgets(NBUDGET_RC), 'BERFI', &
+ Unpack( -zzw(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_ri ) call Budget_store_add( tbudgets(NBUDGET_RI), 'BERFI', &
+ Unpack( zzw(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1 ), 'BERFI', &
+ Unpack( zqcs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'BERFI', &
+ Unpack( zqis(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
+
END SUBROUTINE RAIN_ICE_ELEC_FAST_RI
!
!-------------------------------------------------------------------------------
diff --git a/src/MNH/rain_ice_fast_rg.f90 b/src/MNH/rain_ice_fast_rg.f90
index 33a65180b9bed5b508857cd14a7ddf961b3e3fa2..8f2bec61c49b1e1015b200982fa8fb2914294ee6 100644
--- a/src/MNH/rain_ice_fast_rg.f90
+++ b/src/MNH/rain_ice_fast_rg.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1995-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1995-2020 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.
@@ -8,6 +8,7 @@
! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
! P. Wautelet 03/06/2019: remove PACK/UNPACK intrinsics (to get more performance and better OpenACC support)
! P. Wautelet 05/06/2019: optimisations
+! P. Wautelet 02/2020: use the new data structures and subroutines for budgets
!-----------------------------------------------------------------
MODULE MODE_RAIN_ICE_FAST_RG
@@ -28,17 +29,18 @@ SUBROUTINE RAIN_ICE_FAST_RG(KRR, OMICRO, PRHODREF, PRVT, PRCT, PRRT, PRIT, PRST,
!* 0. DECLARATIONS
! ------------
!
-use MODD_BUDGET, only: LBUDGET_TH, LBUDGET_RC, LBUDGET_RR, LBUDGET_RI, LBUDGET_RS, LBUDGET_RG, LBUDGET_RH, &
- NBUDGET_TH, NBUDGET_RC, NBUDGET_RR, NBUDGET_RI, NBUDGET_RS, NBUDGET_RG, NBUDGET_RH
+use modd_budget, only: lbudget_th, lbudget_rc, lbudget_rr, lbudget_ri, lbudget_rs, lbudget_rg, lbudget_rh, &
+ NBUDGET_TH, NBUDGET_RC, NBUDGET_RR, NBUDGET_RI, NBUDGET_RS, NBUDGET_RG, NBUDGET_RH, &
+ tbudgets
use MODD_CST, only: XCI, XCL, XCPV, XESTT, XLMTT, XLVTT, XMD, XMV, XRV, XTT
use MODD_RAIN_ICE_DESCR, only: XBS, XCEXVT, XCXG, XCXS, XDG, XRTMIN
use MODD_RAIN_ICE_PARAM, only: NDRYLBDAG, NDRYLBDAR, NDRYLBDAS, X0DEPG, X1DEPG, XCOLEXIG, XCOLEXSG, XCOLIG, XCOLSG, XDRYINTP1G, &
XDRYINTP1R, XDRYINTP1S, XDRYINTP2G, XDRYINTP2R, XDRYINTP2S, XEX0DEPG, XEX1DEPG, XEXICFRR, &
XEXRCFRI, XFCDRYG, XFIDRYG, XFRDRYG, XFSDRYG, XICFRR, XKER_RDRYG, XKER_SDRYG, XLBRDRYG1, &
XLBRDRYG2, XLBRDRYG3, XLBSDRYG1, XLBSDRYG2, XLBSDRYG3, XRCFRI
-!
-use MODI_BUDGET
-!
+
+use mode_budget, only: Budget_store_add, Budget_store_end, Budget_store_init
+
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
@@ -92,6 +94,7 @@ REAL, DIMENSION(size(PRHODREF),7) :: ZZW1 ! Work arrays
!
!* 6.1 rain contact freezing
!
+ ZZW1(:,:) = 0.0
WHERE( (PRIT(:)>XRTMIN(4)) .AND. (PRRT(:)>XRTMIN(3)) .AND. &
(PRIS(:)>0.0) .AND. (PRRS(:)>0.0) )
ZZW1(:,3) = MIN( PRIS(:),XICFRR * PRIT(:) & ! RICFRRG
@@ -105,18 +108,32 @@ REAL, DIMENSION(size(PRHODREF),7) :: ZZW1 ! Work arrays
PRGS(:) = PRGS(:) + ZZW1(:,3)+ZZW1(:,4)
PTHS(:) = PTHS(:) + ZZW1(:,4)*(PLSFACT(:)-PLVFACT(:)) ! f(L_f*RRCFRIG)
END WHERE
- IF (LBUDGET_TH) CALL BUDGET ( &
- UNPACK(PTHS(:),MASK=OMICRO(:,:,:),FIELD=PTHS3D)*PRHODJ3D(:,:,:), &
- NBUDGET_TH,'CFRZ_BU_RTH')
- IF (LBUDGET_RR) CALL BUDGET ( &
- UNPACK(PRRS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
- NBUDGET_RR,'CFRZ_BU_RRR')
- IF (LBUDGET_RI) CALL BUDGET ( &
- UNPACK(PRIS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
- NBUDGET_RI,'CFRZ_BU_RRI')
- IF (LBUDGET_RG) CALL BUDGET ( &
- UNPACK(PRGS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
- NBUDGET_RG,'CFRZ_BU_RRG')
+
+ if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'CFRZ', Unpack ( zzw1(:, 4) * ( plsfact(:) - plvfact(:) ) &
+ * prhodj(:), mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rr ) call Budget_store_add( tbudgets(NBUDGET_RR), 'CFRZ', Unpack ( -zzw1(:, 4) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_ri ) call Budget_store_add( tbudgets(NBUDGET_RI), 'CFRZ', Unpack ( -zzw1(:, 3) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rg ) call Budget_store_add( tbudgets(NBUDGET_RG), 'CFRZ', Unpack ( ( zzw1(:,3) + zzw1(:,4) ) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+
+!PW:used init/end instead of add because zzw1 is produced with a where(...) and is used with other where(...)
+! => can not use directly zzw1 in Budget_store_add
+ if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'WETG', Unpack ( pths(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'WETG', Unpack ( prcs(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'WETG', Unpack ( prrs(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'WETG', Unpack ( pris(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rs ) call Budget_store_init( tbudgets(NBUDGET_RS), 'WETG', Unpack ( prss(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rg ) call Budget_store_init( tbudgets(NBUDGET_RG), 'WETG', Unpack ( prgs(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rh ) call Budget_store_init( tbudgets(NBUDGET_RH), 'WETG', Unpack ( prhs(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
!
!* 6.2 compute the Dry growth case
!
@@ -331,8 +348,8 @@ REAL, DIMENSION(size(PRHODREF),7) :: ZZW1 ! Work arrays
PTHS(:) = PTHS(:) + ZZW1(:,7)*(PLSFACT(:)-PLVFACT(:))
! f(L_f*(RCWETG+RRWETG))
END WHERE
- ELSE IF( KRR == 6 ) THEN
- WHERE( PRGT(:)>XRTMIN(6) .AND. PZT(:)<XTT &
+ ELSE IF( KRR == 6 ) THEN
+ WHERE( PRGT(:)>XRTMIN(6) .AND. PZT(:)<XTT &
.AND. & ! Wet
PRDRYG(:)>=PRWETG(:) .AND. PRWETG(:)>0.0 ) ! case
PRCS(:) = PRCS(:) - ZZW1(:,1)
@@ -344,32 +361,38 @@ REAL, DIMENSION(size(PRHODREF),7) :: ZZW1 ! Work arrays
PTHS(:) = PTHS(:) + (PRWETG(:)-ZZW1(:,5)-ZZW1(:,6))*(PLSFACT(:)-PLVFACT(:))
! f(L_f*(RCWETG+RRWETG))
END WHERE
- END IF
- IF (LBUDGET_TH) CALL BUDGET ( &
- UNPACK(PTHS(:),MASK=OMICRO(:,:,:),FIELD=PTHS3D)*PRHODJ3D(:,:,:), &
- NBUDGET_TH,'WETG_BU_RTH')
- IF (LBUDGET_RC) CALL BUDGET ( &
- UNPACK(PRCS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
- NBUDGET_RC,'WETG_BU_RRC')
- IF (LBUDGET_RR) CALL BUDGET ( &
- UNPACK(PRRS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
- NBUDGET_RR,'WETG_BU_RRR')
- IF (LBUDGET_RI) CALL BUDGET ( &
- UNPACK(PRIS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
- NBUDGET_RI,'WETG_BU_RRI')
- IF (LBUDGET_RS) CALL BUDGET ( &
- UNPACK(PRSS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
- NBUDGET_RS,'WETG_BU_RRS')
- IF (LBUDGET_RG) CALL BUDGET ( &
- UNPACK(PRGS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
- NBUDGET_RG,'WETG_BU_RRG')
- IF ( KRR == 7 ) THEN
- IF (LBUDGET_RH) CALL BUDGET ( &
- UNPACK(PRHS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
- NBUDGET_RH,'WETG_BU_RRH')
END IF
-!
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'WETG', Unpack ( pths(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'WETG', Unpack ( prcs(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'WETG', Unpack ( prrs(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'WETG', Unpack ( pris(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rs ) call Budget_store_end( tbudgets(NBUDGET_RS), 'WETG', Unpack ( prss(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG), 'WETG', Unpack ( prgs(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rh ) call Budget_store_end( tbudgets(NBUDGET_RH), 'WETG', Unpack ( prhs(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+
+!PW:used init/end instead of add because zzw1 is produced with a where(...) and is used with other where(...)
+! => can not use directly zzw1 in Budget_store_add
+ if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'DRYG', Unpack ( pths(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'DRYG', Unpack ( prcs(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'DRYG', Unpack ( prrs(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'DRYG', Unpack ( pris(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rs ) call Budget_store_init( tbudgets(NBUDGET_RS), 'DRYG', Unpack ( prss(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rg ) call Budget_store_init( tbudgets(NBUDGET_RG), 'DRYG', Unpack ( prgs(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+
WHERE( PRGT(:)>XRTMIN(6) .AND. PZT(:)<XTT &
.AND. &
PRDRYG(:)<PRWETG(:) .AND. PRDRYG(:)>0.0 ) ! Dry
@@ -381,24 +404,19 @@ REAL, DIMENSION(size(PRHODREF),7) :: ZZW1 ! Work arrays
PTHS(:) = PTHS(:) + (ZZW1(:,1)+ZZW1(:,4))*(PLSFACT(:)-PLVFACT(:)) !
! f(L_f*(RCDRYG+RRDRYG))
END WHERE
- IF (LBUDGET_TH) CALL BUDGET ( &
- UNPACK(PTHS(:),MASK=OMICRO(:,:,:),FIELD=PTHS3D)*PRHODJ3D(:,:,:), &
- NBUDGET_TH,'DRYG_BU_RTH')
- IF (LBUDGET_RC) CALL BUDGET ( &
- UNPACK(PRCS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
- NBUDGET_RC,'DRYG_BU_RRC')
- IF (LBUDGET_RR) CALL BUDGET ( &
- UNPACK(PRRS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
- NBUDGET_RR,'DRYG_BU_RRR')
- IF (LBUDGET_RI) CALL BUDGET ( &
- UNPACK(PRIS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
- NBUDGET_RI,'DRYG_BU_RRI')
- IF (LBUDGET_RS) CALL BUDGET ( &
- UNPACK(PRSS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
- NBUDGET_RS,'DRYG_BU_RRS')
- IF (LBUDGET_RG) CALL BUDGET ( &
- UNPACK(PRGS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
- NBUDGET_RG,'DRYG_BU_RRG')
+
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'DRYG', Unpack ( pths(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'DRYG', Unpack ( prcs(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'DRYG', Unpack ( prrs(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'DRYG', Unpack ( pris(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rs ) call Budget_store_end( tbudgets(NBUDGET_RS), 'DRYG', Unpack ( prss(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG), 'DRYG', Unpack ( prgs(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
!
! WHERE ( PZT(:) > XTT ) ! RSWETG case only
! PRSS(:) = PRSS(:) - ZZW1(:,6)
@@ -407,7 +425,7 @@ REAL, DIMENSION(size(PRHODREF),7) :: ZZW1 ! Work arrays
!
!* 6.5 Melting of the graupeln
!
- WHERE( PRGT(:)>XRTMIN(6) .AND. PRGS(:)>0.0 .AND. PZT(:)>XTT )
+ WHERE( PRGT(:)>XRTMIN(6) .AND. PRGS(:)>0.0 .AND. PZT(:)>XTT )
ZZW(:) = PRVT(:)*PPRES(:)/((XMV/XMD)+PRVT(:)) ! Vapor pressure
ZZW(:) = PKA(:)*(XTT-PZT(:)) + &
( PDV(:)*(XLVTT + ( XCPV - XCL ) * ( PZT(:) - XTT )) &
@@ -425,16 +443,13 @@ REAL, DIMENSION(size(PRHODREF),7) :: ZZW1 ! Work arrays
PRGS(:) = PRGS(:) - ZZW(:)
PTHS(:) = PTHS(:) - ZZW(:)*(PLSFACT(:)-PLVFACT(:)) ! f(L_f*(-RGMLTR))
END WHERE
- IF (LBUDGET_TH) CALL BUDGET ( &
- UNPACK(PTHS(:),MASK=OMICRO(:,:,:),FIELD=PTHS3D)*PRHODJ3D(:,:,:), &
- NBUDGET_TH,'GMLT_BU_RTH')
- IF (LBUDGET_RR) CALL BUDGET ( &
- UNPACK(PRRS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
- NBUDGET_RR,'GMLT_BU_RRR')
- IF (LBUDGET_RG) CALL BUDGET ( &
- UNPACK(PRGS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
- NBUDGET_RG,'GMLT_BU_RRG')
-!
+
+ if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'GMLT', Unpack ( -zzw(:) * ( plsfact(:) - plvfact(:) ) &
+ * prhodj(:), mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rr ) call Budget_store_add( tbudgets(NBUDGET_RR), 'GMLT', Unpack ( zzw(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rg ) call Budget_store_add( tbudgets(NBUDGET_RG), 'GMLT', Unpack ( -zzw(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
END SUBROUTINE RAIN_ICE_FAST_RG
END MODULE MODE_RAIN_ICE_FAST_RG
diff --git a/src/MNH/rain_ice_fast_rh.f90 b/src/MNH/rain_ice_fast_rh.f90
index 5b83463e8c0f44180a8d9d0272ff717e6ae81647..3917217e5f169a368526fc37896e903bb3079d16 100644
--- a/src/MNH/rain_ice_fast_rh.f90
+++ b/src/MNH/rain_ice_fast_rh.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1995-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1995-2020 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.
@@ -8,6 +8,7 @@
! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
! P. Wautelet 03/06/2019: remove PACK/UNPACK intrinsics (to get more performance and better OpenACC support)
! P. Wautelet 05/06/2019: optimisations
+! P. Wautelet 02/2020: use the new data structures and subroutines for budgets
!-----------------------------------------------------------------
MODULE MODE_RAIN_ICE_FAST_RH
@@ -26,17 +27,18 @@ SUBROUTINE RAIN_ICE_FAST_RH(OMICRO, PRHODREF, PRVT, PRCT, PRIT, PRST, PRGT, PRHT
!* 0. DECLARATIONS
! ------------
!
-use MODD_BUDGET, only: LBUDGET_TH, LBUDGET_RC, LBUDGET_RR, LBUDGET_RI, LBUDGET_RS, LBUDGET_RG, LBUDGET_RH, &
- NBUDGET_TH, NBUDGET_RC, NBUDGET_RR, NBUDGET_RI, NBUDGET_RS, NBUDGET_RG, NBUDGET_RH
+use modd_budget, only: lbudget_th, lbudget_rc, lbudget_rr, lbudget_ri, lbudget_rs, lbudget_rg, lbudget_rh, &
+ NBUDGET_TH, NBUDGET_RC, NBUDGET_RR, NBUDGET_RI, NBUDGET_RS, NBUDGET_RG, NBUDGET_RH, &
+ tbudgets
use MODD_CST, only: XCI, XCL, XCPV, XESTT, XLMTT, XLVTT, XMD, XMV, XRV, XTT
use MODD_RAIN_ICE_DESCR, only: XBG, XBS, XCEXVT, XCXG, XCXH, XCXS, XDH, XLBEXH, XLBH, XRTMIN
use MODD_RAIN_ICE_PARAM, only: NWETLBDAG, NWETLBDAH, NWETLBDAS, X0DEPH, X1DEPH, &
XEX0DEPH, XEX1DEPH, XFGWETH, XFSWETH, XFWETH, XKER_GWETH, XKER_SWETH, &
XLBGWETH1, XLBGWETH2, XLBGWETH3, XLBSWETH1, XLBSWETH2, XLBSWETH3, &
XWETINTP1G, XWETINTP1H, XWETINTP1S, XWETINTP2G, XWETINTP2H, XWETINTP2S
-!
-use MODI_BUDGET
-!
+
+use mode_budget, only: Budget_store_add, Budget_store_end, Budget_store_init
+
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
@@ -93,6 +95,22 @@ REAL, DIMENSION(size(PRHODREF),6) :: ZZW1 ! Work arrays
END DO
!
IF( IHAIL>0 ) THEN
+!PW:used init/end instead of add because zzw1 is produced and used with different conditions
+! => can not use directly zzw1 in Budget_store_add
+ if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'WETH', Unpack ( pths(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'WETH', Unpack ( prcs(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'WETH', Unpack ( prrs(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'WETH', Unpack ( pris(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rs ) call Budget_store_init( tbudgets(NBUDGET_RS), 'WETH', Unpack ( prss(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rg ) call Budget_store_init( tbudgets(NBUDGET_RG), 'WETH', Unpack ( prgs(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rh ) call Budget_store_init( tbudgets(NBUDGET_RH), 'WETH', Unpack ( prhs(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
!
!* 7.2 compute the Wet growth of hail
!
@@ -300,28 +318,21 @@ REAL, DIMENSION(size(PRHODREF),6) :: ZZW1 ! Work arrays
END IF
END IF
END DO
- END IF
- IF (LBUDGET_TH) CALL BUDGET ( &
- UNPACK(PTHS(:),MASK=OMICRO(:,:,:),FIELD=PTHS3D)*PRHODJ3D(:,:,:),&
- NBUDGET_TH,'WETH_BU_RTH')
- IF (LBUDGET_RC) CALL BUDGET ( &
- UNPACK(PRCS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
- NBUDGET_RC,'WETH_BU_RRC')
- IF (LBUDGET_RR) CALL BUDGET ( &
- UNPACK(PRRS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
- NBUDGET_RR,'WETH_BU_RRR')
- IF (LBUDGET_RI) CALL BUDGET ( &
- UNPACK(PRIS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
- NBUDGET_RI,'WETH_BU_RRI')
- IF (LBUDGET_RS) CALL BUDGET ( &
- UNPACK(PRSS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
- NBUDGET_RS,'WETH_BU_RRS')
- IF (LBUDGET_RG) CALL BUDGET ( &
- UNPACK(PRGS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
- NBUDGET_RG,'WETH_BU_RRG')
- IF (LBUDGET_RH) CALL BUDGET ( &
- UNPACK(PRHS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
- NBUDGET_RH,'WETH_BU_RRH')
+
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'WETH', Unpack ( pths(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'WETH', Unpack ( prcs(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'WETH', Unpack ( prrs(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'WETH', Unpack ( pris(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rs ) call Budget_store_end( tbudgets(NBUDGET_RS), 'WETH', Unpack ( prss(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG), 'WETH', Unpack ( prgs(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rh ) call Budget_store_end( tbudgets(NBUDGET_RH), 'WETH', Unpack ( prhs(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
!
!
! ici LRECONVH et un flag pour autoriser une reconversion partielle de
@@ -351,10 +362,16 @@ REAL, DIMENSION(size(PRHODREF),6) :: ZZW1 ! Work arrays
- IF( IHAIL>0 ) THEN
!
!* 7.5 Melting of the hailstones
!
+ if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'HMLT', Unpack ( pths(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'HMLT', Unpack ( prrs(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rh ) call Budget_store_init( tbudgets(NBUDGET_RH), 'HMLT', Unpack ( prhs(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+
DO JJ = 1, IHAIL
JL = I1H(JJ)
IF( PRHS(JL)>0.0 .AND. PZT(JL)>XTT ) THEN
@@ -374,17 +391,14 @@ REAL, DIMENSION(size(PRHODREF),6) :: ZZW1 ! Work arrays
PTHS(JL) = PTHS(JL) - ZZW(JL)*(PLSFACT(JL)-PLVFACT(JL)) ! f(L_f*(-RHMLTR))
END IF
END DO
- END IF
- IF (LBUDGET_TH) CALL BUDGET ( &
- UNPACK(PTHS(:),MASK=OMICRO(:,:,:),FIELD=PTHS3D)*PRHODJ3D(:,:,:),&
- NBUDGET_TH,'HMLT_BU_RTH')
- IF (LBUDGET_RR) CALL BUDGET ( &
- UNPACK(PRRS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
- NBUDGET_RR,'HMLT_BU_RRR')
- IF (LBUDGET_RH) CALL BUDGET ( &
- UNPACK(PRHS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
- NBUDGET_RH,'HMLT_BU_RRH')
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'HMLT', Unpack ( pths(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'HMLT', Unpack ( prrs(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rh ) call Budget_store_end( tbudgets(NBUDGET_RH), 'HMLT', Unpack ( prhs(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ END IF
!
END SUBROUTINE RAIN_ICE_FAST_RH
diff --git a/src/MNH/rain_ice_fast_ri.f90 b/src/MNH/rain_ice_fast_ri.f90
index 67b9c233147989511a5042aa1bdd7f918016d80c..568c39de3beec373eef77db9f46b4ca53d2bc030 100644
--- a/src/MNH/rain_ice_fast_ri.f90
+++ b/src/MNH/rain_ice_fast_ri.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1995-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1995-2020 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.
@@ -6,6 +6,7 @@
! Modifications:
! P. Wautelet 25/02/2019: split rain_ice (cleaner and easier to maintain/debug)
! P. Wautelet 05/06/2019: optimisations
+! P. Wautelet 02/2020: use the new data structures and subroutines for budgets
!-----------------------------------------------------------------
MODULE MODE_RAIN_ICE_FAST_RI
@@ -23,14 +24,15 @@ SUBROUTINE RAIN_ICE_FAST_RI(OMICRO, PRHODREF, PRIT, PRHODJ, PZT, PSSI, PLSFACT,
!* 0. DECLARATIONS
! ------------
!
-use MODD_BUDGET, only: LBUDGET_TH, LBUDGET_RC, LBUDGET_RI, &
- NBUDGET_TH, NBUDGET_RC, NBUDGET_RI
+use modd_budget, only: lbudget_th, lbudget_rc, lbudget_ri, &
+ NBUDGET_TH, NBUDGET_RC, NBUDGET_RI, &
+ tbudgets
use MODD_CST, only: XTT
use MODD_RAIN_ICE_DESCR, only: XDI, XLBEXI, XLBI, XRTMIN
use MODD_RAIN_ICE_PARAM, only: X0DEPI, X2DEPI
-!
-use MODI_BUDGET
-!
+
+use mode_budget, only: Budget_store_add, Budget_store_end, Budget_store_init
+
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
@@ -59,24 +61,30 @@ REAL, DIMENSION(size(PRHODREF)) :: ZZW ! Work array
!
!* 7.1 cloud ice melting
!
+ if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'IMLT', Unpack ( pths(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'IMLT', Unpack ( prcs(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'IMLT', Unpack ( pris(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+
WHERE( PRIS(:)>0.0 .AND. PZT(:)>XTT )
PRCS(:) = PRCS(:) + PRIS(:)
PTHS(:) = PTHS(:) - PRIS(:)*(PLSFACT(:)-PLVFACT(:)) ! f(L_f*(-RIMLTC))
PRIS(:) = 0.0
PCIT(:) = 0.0
END WHERE
- IF (LBUDGET_TH) CALL BUDGET ( &
- UNPACK(PTHS(:),MASK=OMICRO(:,:,:),FIELD=PTHS3D)*PRHODJ3D(:,:,:), &
- NBUDGET_TH,'IMLT_BU_RTH')
- IF (LBUDGET_RC) CALL BUDGET ( &
- UNPACK(PRCS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
- NBUDGET_RC,'IMLT_BU_RRC')
- IF (LBUDGET_RI) CALL BUDGET ( &
- UNPACK(PRIS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
- NBUDGET_RI,'IMLT_BU_RRI')
+
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'IMLT', Unpack ( pths(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'IMLT', Unpack ( prcs(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'IMLT', Unpack ( pris(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
!
!* 7.2 Bergeron-Findeisen effect: RCBERI
!
+ zzw(:) = 0.
WHERE( PRCS(:)>0.0 .AND. PSSI(:)>0.0 .AND. PRIT(:)>XRTMIN(4) .AND. PCIT(:)>0.0 )
ZZW(:) = MIN(1.E8,XLBI*( PRHODREF(:)*PRIT(:)/PCIT(:) )**XLBEXI) ! Lbda_i
ZZW(:) = MIN( PRCS(:),( PSSI(:) / (PRHODREF(:)*PAI(:)) ) * PCIT(:) * &
@@ -85,16 +93,13 @@ REAL, DIMENSION(size(PRHODREF)) :: ZZW ! Work array
PRIS(:) = PRIS(:) + ZZW(:)
PTHS(:) = PTHS(:) + ZZW(:)*(PLSFACT(:)-PLVFACT(:)) ! f(L_f*(RCBERI))
END WHERE
- IF (LBUDGET_TH) CALL BUDGET ( &
- UNPACK(PTHS(:),MASK=OMICRO(:,:,:),FIELD=PTHS3D)*PRHODJ3D(:,:,:), &
- NBUDGET_TH,'BERFI_BU_RTH')
- IF (LBUDGET_RC) CALL BUDGET ( &
- UNPACK(PRCS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
- NBUDGET_RC,'BERFI_BU_RRC')
- IF (LBUDGET_RI) CALL BUDGET ( &
- UNPACK(PRIS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
- NBUDGET_RI,'BERFI_BU_RRI')
-!
+
+ if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'BERFI', Unpack ( zzw(:) * ( plsfact(:) - plvfact(:) ) &
+ * prhodj(:), mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rc ) call Budget_store_add( tbudgets(NBUDGET_RC), 'BERFI', Unpack ( -zzw(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_ri ) call Budget_store_add( tbudgets(NBUDGET_RI), 'BERFI', Unpack ( zzw(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
END SUBROUTINE RAIN_ICE_FAST_RI
END MODULE MODE_RAIN_ICE_FAST_RI
diff --git a/src/MNH/rain_ice_fast_rs.f90 b/src/MNH/rain_ice_fast_rs.f90
index 49d7cec95fa059d58a00b62f6161b822c9f941a5..d5e2a8e865db312e8cd3b4ec247b76c3e6eb8d88 100644
--- a/src/MNH/rain_ice_fast_rs.f90
+++ b/src/MNH/rain_ice_fast_rs.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1995-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1995-2020 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.
@@ -8,6 +8,7 @@
! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
! P. Wautelet 03/06/2019: remove PACK/UNPACK intrinsics (to get more performance and better OpenACC support)
! P. Wautelet 05/06/2019: optimisations
+! P. Wautelet 02/2020: use the new data structures and subroutines for budgets
!-----------------------------------------------------------------
MODULE MODE_RAIN_ICE_FAST_RS
@@ -26,8 +27,9 @@ SUBROUTINE RAIN_ICE_FAST_RS(PTSTEP, OMICRO, PRHODREF, PRVT, PRCT, PRRT, PRST, PR
!* 0. DECLARATIONS
! ------------
!
-use MODD_BUDGET, only: LBUDGET_TH, LBUDGET_RC, LBUDGET_RR, LBUDGET_RS, LBUDGET_RG, &
- NBUDGET_TH, NBUDGET_RC, NBUDGET_RR, NBUDGET_RS, NBUDGET_RG
+use modd_budget, only: lbudget_th, lbudget_rc, lbudget_rr, lbudget_rs, lbudget_rg, &
+ NBUDGET_TH, NBUDGET_RC, NBUDGET_RR, NBUDGET_RS, NBUDGET_RG, &
+ tbudgets
use MODD_CST, only: XCL, XCPV, XESTT, XLMTT, XLVTT, XMD, XMV, XRV, XTT
use MODD_RAIN_ICE_DESCR, only: XBS, XCEXVT, XCXS, XRTMIN
use MODD_RAIN_ICE_PARAM, only: NACCLBDAR, NACCLBDAS, NGAMINC, X0DEPS, X1DEPS, XACCINTP1R, XACCINTP1S, XACCINTP2R, XACCINTP2S, &
@@ -35,9 +37,9 @@ use MODD_RAIN_ICE_PARAM, only: NACCLBDAR, NACCLBDAS, NGAMINC, X0DEPS, X1DEPS, XA
XFSACCRG, XFSCVMG, XGAMINC_RIM1, XGAMINC_RIM1, XGAMINC_RIM2, XKER_RACCS, &
XKER_RACCSS, XKER_SACCRG, XLBRACCS1, XLBRACCS2, XLBRACCS3, XLBSACCR1, XLBSACCR2, XLBSACCR3, &
XRIMINTP1, XRIMINTP2, XSRIMCG
-!
-use MODI_BUDGET
-!
+
+use mode_budget, only: Budget_store_add
+
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
@@ -160,6 +162,16 @@ REAL, DIMENSION(:), ALLOCATABLE :: ZZW1, ZZW2, ZZW3, ZZW4 ! Work arrays
PTHS(JL) = PTHS(JL) + ZZW2(JJ)*(PLSFACT(JL)-PLVFACT(JL)) ! f(L_f*(RCRIMSG))
END IF
END DO
+
+ if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'RIM', Unpack ( ( zzw1(:) + zzw2(:) ) &
+ * ( plsfact(:) - plvfact(:) ) * prhodj(:), mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rc ) call Budget_store_add( tbudgets(NBUDGET_RC), 'RIM', Unpack ( ( -zzw1(:) - zzw2(:) ) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rs ) call Budget_store_add( tbudgets(NBUDGET_RS), 'RIM', Unpack ( ( zzw1(:) - zzw3(:) ) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rg ) call Budget_store_add( tbudgets(NBUDGET_RG), 'RIM', Unpack ( ( zzw2(:) + zzw3(:) ) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+
DEALLOCATE(ZZW3)
DEALLOCATE(ZZW2)
DEALLOCATE(ZZW1)
@@ -168,18 +180,6 @@ REAL, DIMENSION(:), ALLOCATABLE :: ZZW1, ZZW2, ZZW3, ZZW4 ! Work arrays
DEALLOCATE(ZVEC1)
DEALLOCATE(ZVECLBDAS)
END IF
- IF (LBUDGET_TH) CALL BUDGET ( &
- UNPACK(PTHS(:),MASK=OMICRO(:,:,:),FIELD=PTHS3D)*PRHODJ3D(:,:,:), &
- NBUDGET_TH,'RIM_BU_RTH')
- IF (LBUDGET_RC) CALL BUDGET ( &
- UNPACK(PRCS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
- NBUDGET_RC,'RIM_BU_RRC')
- IF (LBUDGET_RS) CALL BUDGET ( &
- UNPACK(PRSS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
- NBUDGET_RS,'RIM_BU_RRS')
- IF (LBUDGET_RG) CALL BUDGET ( &
- UNPACK(PRGS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
- NBUDGET_RG,'RIM_BU_RRG')
!
!* 5.2 rain accretion onto the aggregates
!
@@ -300,6 +300,16 @@ REAL, DIMENSION(:), ALLOCATABLE :: ZZW1, ZZW2, ZZW3, ZZW4 ! Work arrays
END IF
END IF
END DO
+
+ if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'ACC', Unpack ( ( zzw4(:) + zzw2(:) ) &
+ * ( plsfact(:) - plvfact(:) ) * prhodj(:), mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rr ) call Budget_store_add( tbudgets(NBUDGET_RR), 'ACC', Unpack ( ( -zzw4(:) - zzw2(:) ) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rs ) call Budget_store_add( tbudgets(NBUDGET_RS), 'ACC', Unpack ( ( zzw4(:) - zzw3(:) ) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rg ) call Budget_store_add( tbudgets(NBUDGET_RG), 'ACC', Unpack ( ( zzw2(:) + zzw3(:) ) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+
DEALLOCATE(ZZW4)
DEALLOCATE(ZZW3)
DEALLOCATE(ZZW2)
@@ -311,21 +321,10 @@ REAL, DIMENSION(:), ALLOCATABLE :: ZZW1, ZZW2, ZZW3, ZZW4 ! Work arrays
DEALLOCATE(ZVECLBDAS)
DEALLOCATE(ZVECLBDAR)
END IF
- IF (LBUDGET_TH) CALL BUDGET ( &
- UNPACK(PTHS(:),MASK=OMICRO(:,:,:),FIELD=PTHS3D)*PRHODJ3D(:,:,:), &
- NBUDGET_TH,'ACC_BU_RTH')
- IF (LBUDGET_RR) CALL BUDGET ( &
- UNPACK(PRRS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
- NBUDGET_RR,'ACC_BU_RRR')
- IF (LBUDGET_RS) CALL BUDGET ( &
- UNPACK(PRSS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
- NBUDGET_RS,'ACC_BU_RRS')
- IF (LBUDGET_RG) CALL BUDGET ( &
- UNPACK(PRGS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
- NBUDGET_RG,'ACC_BU_RRG')
!
!* 5.3 Conversion-Melting of the aggregates
!
+ zzw(:) = 0.
WHERE( PRST(:)>XRTMIN(5) .AND. PRSS(:)>0.0 .AND. PZT(:)>XTT )
ZZW(:) = PRVT(:)*PPRES(:)/((XMV/XMD)+PRVT(:)) ! Vapor pressure
ZZW(:) = PKA(:)*(XTT-PZT(:)) + &
@@ -345,13 +344,12 @@ REAL, DIMENSION(:), ALLOCATABLE :: ZZW1, ZZW2, ZZW3, ZZW4 ! Work arrays
PRSS(:) = PRSS(:) - ZZW(:)
PRGS(:) = PRGS(:) + ZZW(:)
END WHERE
- IF (LBUDGET_RS) CALL BUDGET ( &
- UNPACK(PRSS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
- NBUDGET_RS,'CMEL_BU_RRS')
- IF (LBUDGET_RG) CALL BUDGET ( &
- UNPACK(PRGS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
- NBUDGET_RG,'CMEL_BU_RRG')
-!
+
+ if ( lbudget_rs ) call Budget_store_add( tbudgets(NBUDGET_RS), 'CMEL', &
+ Unpack ( -zzw(:) * prhodj(:), mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rg ) call Budget_store_add( tbudgets(NBUDGET_RG), 'CMEL', &
+ Unpack ( zzw(:) * prhodj(:), mask = omicro(:,:,:), field = 0. ) )
+
END SUBROUTINE RAIN_ICE_FAST_RS
END MODULE MODE_RAIN_ICE_FAST_RS
diff --git a/src/MNH/rain_ice_nucleation.f90 b/src/MNH/rain_ice_nucleation.f90
index bcc4e79fded2e35f938f375001cffe45f89485b1..97bfaf1f87e16eed809b73b085d2c3886f514225 100644
--- a/src/MNH/rain_ice_nucleation.f90
+++ b/src/MNH/rain_ice_nucleation.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1995-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1995-2020 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.
@@ -7,6 +7,7 @@
! P. Wautelet 25/02/2019: split rain_ice (cleaner and easier to maintain/debug)
! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90
! P. Wautelet 29/05/2019: remove PACK/UNPACK intrinsics (to get more performance and better OpenACC support)
+! P. Wautelet 02/2020: use the new data structures and subroutines for budgets
!-----------------------------------------------------------------
MODULE MODE_RAIN_ICE_NUCLEATION
@@ -25,16 +26,16 @@ SUBROUTINE RAIN_ICE_NUCLEATION(KIB, KIE, KJB, KJE, KKTB, KKTE,KRR,PTSTEP,&
!* 0. DECLARATIONS
! ------------
!
-use MODD_BUDGET, only: LBUDGET_RI, LBUDGET_RV, LBUDGET_TH, &
- NBUDGET_TH, NBUDGET_RV, NBUDGET_RI
+use modd_budget, only: lbudget_th, lbudget_rv, lbudget_ri, &
+ NBUDGET_TH, NBUDGET_RV, NBUDGET_RI, &
+ tbudgets
use MODD_CST, only: XALPI, XALPW, XBETAI, XBETAW, XCI, XCL, XCPD, XCPV, XGAMI, XGAMW, &
XLSTT, XMD, XMV, XP00, XRD, XTT
use MODD_RAIN_ICE_PARAM, only: XALPHA1, XALPHA2, XBETA1, XBETA2, XMNU0, XNU10, XNU20
+use mode_budget, only: Budget_store_init, Budget_store_end
use mode_tools, only: Countjv
-use MODI_BUDGET
-
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
@@ -79,7 +80,10 @@ REAL, DIMENSION(SIZE(PEXNREF,1),SIZE(PEXNREF,2),SIZE(PEXNREF,3)) &
:: ZW ! work array
!
!-------------------------------------------------------------------------------
-!
+
+if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'HENU', pths(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rv ) call Budget_store_init( tbudgets(NBUDGET_RV), 'HENU', prvs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'HENU', pris(:, :, :) * prhodj(:, :, :) )
!
! compute the temperature and the pressure
!
@@ -167,10 +171,10 @@ END IF
!
!* 3.1.3 budget storage
!
-IF (LBUDGET_TH) CALL BUDGET (PTHS(:,:,:)*PRHODJ(:,:,:),NBUDGET_TH,'HENU_BU_RTH')
-IF (LBUDGET_RV) CALL BUDGET (PRVS(:,:,:)*PRHODJ(:,:,:),NBUDGET_RV,'HENU_BU_RRV')
-IF (LBUDGET_RI) CALL BUDGET (PRIS(:,:,:)*PRHODJ(:,:,:),NBUDGET_RI,'HENU_BU_RRI')
-!
+if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'HENU', pths(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rv ) call Budget_store_end( tbudgets(NBUDGET_RV), 'HENU', prvs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'HENU', pris(:, :, :) * prhodj(:, :, :) )
+
END SUBROUTINE RAIN_ICE_NUCLEATION
END MODULE MODE_RAIN_ICE_NUCLEATION
diff --git a/src/MNH/rain_ice_red.f90 b/src/MNH/rain_ice_red.f90
index b8b44886de05833a3cc02946657aeb705daaf218..ca6b946c352f411101ca0b85de184fd52c618f41 100644
--- a/src/MNH/rain_ice_red.f90
+++ b/src/MNH/rain_ice_red.f90
@@ -243,13 +243,16 @@ END MODULE MODI_RAIN_ICE_RED
! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90
! P. Wautelet 29/05/2019: remove PACK/UNPACK intrinsics (to get more performance and better OpenACC support)
! P. Wautelet 17/01/2020: move Quicksort to tools.f90
+! P. Wautelet 02/2020: use the new data structures and subroutines for budgets
+!-----------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_BUDGET, ONLY: LBU_ENABLE, &
- LBUDGET_TH, LBUDGET_RV, LBUDGET_RC, LBUDGET_RR, LBUDGET_RI, LBUDGET_RS, LBUDGET_RG, LBUDGET_RH, &
- NBUDGET_TH, NBUDGET_RV, NBUDGET_RC, NBUDGET_RR, NBUDGET_RI, NBUDGET_RS, NBUDGET_RG, NBUDGET_RH
+use modd_budget, only: lbu_enable, &
+ lbudget_th, lbudget_rv, lbudget_rc, lbudget_rr, lbudget_ri, lbudget_rs, lbudget_rg, lbudget_rh, &
+ NBUDGET_TH, NBUDGET_RV, NBUDGET_RC, NBUDGET_RR, NBUDGET_RI, NBUDGET_RS, NBUDGET_RG, NBUDGET_RH, &
+ tbudgets
USE MODD_CST, ONLY: XCI,XCL,XCPD,XCPV,XLSTT,XLVTT,XTT
USE MODD_PARAMETERS, ONLY: JPVEXT,XUNDEF
USE MODD_PARAM_ICE, ONLY: CSUBG_PR_PDF,CSUBG_RC_RR_ACCR,CSUBG_RR_EVAP,LDEPOSC,LFEEDBACKT,LSEDIM_AFTER, &
@@ -257,11 +260,11 @@ USE MODD_PARAM_ICE, ONLY: CSUBG_PR_PDF,CSUBG_RC_RR_ACCR,CSUBG_RR_EVAP,LDEPO
USE MODD_RAIN_ICE_DESCR, ONLY: XRTMIN
USE MODD_VAR_ll, ONLY: IP
+use mode_budget, only: Budget_store_add, Budget_store_init, Budget_store_end
USE MODE_ll
USE MODE_MSG
use mode_tools, only: Countjv
-USE MODI_BUDGET
USE MODI_ICE4_NUCLEATION_WRAPPER
USE MODI_ICE4_RAINFR_VERT
USE MODI_ICE4_SEDIMENTATION_STAT
@@ -346,11 +349,13 @@ INTEGER :: JL ! and PACK intrinsics
!
!Arrays for nucleation call outisde of ODMICRO points
REAL, DIMENSION(SIZE(PEXNREF,1),SIZE(PEXNREF,2),SIZE(PEXNREF,3)) :: ZW ! work array
+real, dimension(:,:,:), allocatable :: zw1, zw2, zw3, zw4, zw5, zw6 !Work arrays
REAL, DIMENSION(SIZE(PEXNREF,1),SIZE(PEXNREF,2),SIZE(PEXNREF,3)) :: ZT ! Temperature
REAL, DIMENSION(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)) :: &
& ZZ_RVHENI_MR, & ! heterogeneous nucleation mixing ratio change
& ZZ_RVHENI ! heterogeneous nucleation
REAL, DIMENSION(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)) :: ZZ_LVFACT, ZZ_LSFACT
+real, dimension(:,:,:), allocatable :: zz_diff
!
!Diagnostics
REAL, DIMENSION(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)) :: &
@@ -483,7 +488,10 @@ REAL, DIMENSION(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)) :: &
&ZW_RVS, ZW_RCS, ZW_RRS, ZW_RIS, ZW_RSS, ZW_RGS, ZW_RHS, ZW_THS
!
!-------------------------------------------------------------------------------
-!
+if ( lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'HENU', pths(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rv ) call Budget_store_init( tbudgets(NBUDGET_RV), 'HENU', prvs(:, :, :) * prhodj(:, :, :) )
+end if
!-------------------------------------------------------------------------------
!
!* 1. COMPUTE THE LOOP BOUNDS
@@ -528,6 +536,19 @@ IF(.NOT. LSEDIM_AFTER) THEN
!
!* 2.1 sedimentation
!
+ if ( lbudget_rc .and. osedic ) call Budget_store_init( tbudgets(NBUDGET_RC), 'SEDI', prcs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'SEDI', prrs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'SEDI', pris(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rs ) call Budget_store_init( tbudgets(NBUDGET_RS), 'SEDI', prss(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_init( tbudgets(NBUDGET_RG), 'SEDI', prgs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rh ) call Budget_store_init( tbudgets(NBUDGET_RH), 'SEDI', prhs(:, :, :) * prhodj(:, :, :) )
+
+ !Init only of not osedic (to prevent crash with double init)
+ !Remark: the 2 source terms SEDI and DEPO could be mixed and stored in the same source term (SEDI)
+ ! if osedic=T and ldeposc=T (a warning is printed in ini_budget in that case)
+ if ( lbudget_rc .and. ldeposc .and. .not.osedic ) &
+ call Budget_store_init( tbudgets(NBUDGET_RC), 'DEPO', prcs(:, :, :) * prhodj(:, :, :) )
+
IF(HSEDIM=='STAT') THEN
!SR: It *seems* that we must have two separate calls for ifort
IF(KRR==7) THEN
@@ -590,16 +611,17 @@ IF(.NOT. LSEDIM_AFTER) THEN
!
!* 2.2 budget storage
!
- IF (LBUDGET_RC .AND. OSEDIC) &
- CALL BUDGET (PRCS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RC, 'SEDI_BU_RRC')
- IF (LBUDGET_RR) CALL BUDGET (PRRS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RR, 'SEDI_BU_RRR')
- IF (LBUDGET_RI) CALL BUDGET (PRIS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RI, 'SEDI_BU_RRI')
- IF (LBUDGET_RS) CALL BUDGET (PRSS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RS, 'SEDI_BU_RRS')
- IF (LBUDGET_RG) CALL BUDGET (PRGS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RG, 'SEDI_BU_RRG')
- IF ( KRR == 7 .AND. LBUDGET_RH) &
- CALL BUDGET (PRHS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RH, 'SEDI_BU_RRH')
- IF ( LBUDGET_RC .AND. LDEPOSC ) &
- CALL BUDGET (PRCS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RC,'DEPO_BU_RRC')
+ if ( lbudget_rc .and. osedic ) call Budget_store_end( tbudgets(NBUDGET_RC), 'SEDI', prcs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'SEDI', prrs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'SEDI', pris(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rs ) call Budget_store_end( tbudgets(NBUDGET_RS), 'SEDI', prss(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG), 'SEDI', prgs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rh ) call Budget_store_end( tbudgets(NBUDGET_RH), 'SEDI', prhs(:, :, :) * prhodj(:, :, :) )
+
+ !If osedic=T and ldeposc=T, DEPO is in fact mixed and stored with the SEDI source term
+ !(a warning is printed in ini_budget in that case)
+ if ( lbudget_rc .and. ldeposc .and. .not.osedic) &
+ call Budget_store_end( tbudgets(NBUDGET_RC), 'DEPO', prcs(:, :, :) * prhodj(:, :, :) )
ENDIF
!
!-------------------------------------------------------------------------------
@@ -1049,6 +1071,8 @@ ENDIF
!* 6. COMPUTES THE SLOW COLD PROCESS SOURCES OUTSIDE OF ODMICRO POINTS
! ----------------------------------------------------------------
!
+if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'HENU', pris(:, :, :) * prhodj(:, :, :) )
+
CALL ICE4_NUCLEATION_WRAPPER(IIT, IJT, IKT, .NOT. ODMICRO, &
PTHT, PPABST, PRHODREF, PEXN, ZZ_LSFACT/PEXN, ZT, &
PRVT, &
@@ -1120,6 +1144,20 @@ CALL CORRECT_NEGATIVITIES(KRR, ZW_RVS, ZW_RCS, ZW_RRS, &
!*** 7.2 LBU_ENABLE case
!
IF(LBU_ENABLE) THEN
+ allocate( zw1( size( pexnref, 1 ), size( pexnref, 2 ), size( pexnref, 3 ) ) )
+ allocate( zw2( size( pexnref, 1 ), size( pexnref, 2 ), size( pexnref, 3 ) ) )
+ allocate( zw3( size( pexnref, 1 ), size( pexnref, 2 ), size( pexnref, 3 ) ) )
+ allocate( zw4( size( pexnref, 1 ), size( pexnref, 2 ), size( pexnref, 3 ) ) )
+ if ( krr == 7 ) then
+ allocate( zw5( size( pexnref, 1 ), size( pexnref, 2 ), size( pexnref, 3 ) ) )
+ allocate( zw6( size( pexnref, 1 ), size( pexnref, 2 ), size( pexnref, 3 ) ) )
+ end if
+
+ if ( lbudget_th ) then
+ allocate( zz_diff( size( zz_lsfact, 1 ), size( zz_lsfact, 2 ), size( zz_lsfact, 3 ) ) )
+ zz_diff(:, :, :) = zz_lsfact(:, :, :) - zz_lvfact(:, :, :)
+ end if
+
ZW(:,:,:) = 0.
DO JL=1,IMICRO
ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RVHENI(JL) * ZINV_TSTEP
@@ -1127,414 +1165,332 @@ IF(LBU_ENABLE) THEN
PRIS(:,:,:) = PRIS(:,:,:) + ZW(:,:,:)
PRVS(:,:,:) = PRVS(:,:,:) - ZW(:,:,:)
PTHS(:,:,:) = PTHS(:,:,:) + ZW(:,:,:)*ZZ_LSFACT(:,:,:)
- IF (LBUDGET_TH) CALL BUDGET(PTHS(:,:,:)*PRHODJ(:,:,:), NBUDGET_TH, 'HENU_BU_RTH')
- IF (LBUDGET_RV) CALL BUDGET(PRVS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RV, 'HENU_BU_RRV')
- IF (LBUDGET_RI) CALL BUDGET(PRIS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RI, 'HENU_BU_RRI')
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'HENU', pths(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rv ) call Budget_store_end( tbudgets(NBUDGET_RV), 'HENU', prvs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'HENU', pris(:, :, :) * prhodj(:, :, :) )
ZW(:,:,:) = 0.
DO JL=1,IMICRO
ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RCHONI(JL) * ZINV_TSTEP
END DO
- PRIS(:,:,:) = PRIS(:,:,:) + ZW(:,:,:)
- PRCS(:,:,:) = PRCS(:,:,:) - ZW(:,:,:)
- PTHS(:,:,:) = PTHS(:,:,:) + ZW(:,:,:)*(ZZ_LSFACT(:,:,:)-ZZ_LVFACT(:,:,:))
- IF (LBUDGET_TH) CALL BUDGET(PTHS(:,:,:)*PRHODJ(:,:,:), NBUDGET_TH, 'HON_BU_RTH')
- IF (LBUDGET_RC) CALL BUDGET(PRCS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RC, 'HON_BU_RRC')
- IF (LBUDGET_RI) CALL BUDGET(PRIS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RI, 'HON_BU_RRI')
+ if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'HON', zw(:, :, :) * zz_diff(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rc ) call Budget_store_add( tbudgets(NBUDGET_RC), 'HON', -zw(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_add( tbudgets(NBUDGET_RI), 'HON', zw(:, :, :) * prhodj(:, :, :) )
ZW(:,:,:) = 0.
DO JL=1,IMICRO
ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RRHONG(JL) * ZINV_TSTEP
END DO
- PRGS(:,:,:) = PRGS(:,:,:) + ZW(:,:,:)
- PRRS(:,:,:) = PRRS(:,:,:) - ZW(:,:,:)
- PTHS(:,:,:) = PTHS(:,:,:) + ZW(:,:,:)*(ZZ_LSFACT(:,:,:)-ZZ_LVFACT(:,:,:))
- IF (LBUDGET_TH) CALL BUDGET(PTHS(:,:,:)*PRHODJ(:,:,:), NBUDGET_TH, 'SFR_BU_RTH')
- IF (LBUDGET_RR) CALL BUDGET(PRRS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RR, 'SFR_BU_RRR')
- IF (LBUDGET_RG) CALL BUDGET(PRGS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RG,'SFR_BU_RRG')
+ if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'SFR', zw(:, :, :) * zz_diff(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_add( tbudgets(NBUDGET_RR), 'SFR', -zw(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_add( tbudgets(NBUDGET_RG), 'SFR', zw(:, :, :) * prhodj(:, :, :) )
ZW(:,:,:) = 0.
DO JL=1,IMICRO
ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RVDEPS(JL) * ZINV_TSTEP
END DO
- PRSS(:,:,:) = PRSS(:,:,:) + ZW(:,:,:)
- PRVS(:,:,:) = PRVS(:,:,:) - ZW(:,:,:)
- PTHS(:,:,:) = PTHS(:,:,:) + ZW(:,:,:)*ZZ_LSFACT(:,:,:)
- IF (LBUDGET_TH) CALL BUDGET(PTHS(:,:,:)*PRHODJ(:,:,:), NBUDGET_TH, 'DEPS_BU_RTH')
- IF (LBUDGET_RV) CALL BUDGET(PRVS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RV, 'DEPS_BU_RRV')
- IF (LBUDGET_RS) CALL BUDGET(PRSS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RS,'DEPS_BU_RRS')
+ if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'DEPS', zw(:, :, :) * zz_lsfact(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rv ) call Budget_store_add( tbudgets(NBUDGET_RV), 'DEPS', -zw(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rs ) call Budget_store_add( tbudgets(NBUDGET_RS), 'DEPS', zw(:, :, :) * prhodj(:, :, :) )
ZW(:,:,:) = 0.
DO JL=1,IMICRO
ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RIAGGS(JL) * ZINV_TSTEP
END DO
- PRSS(:,:,:) = PRSS(:,:,:) + ZW(:,:,:)
- PRIS(:,:,:) = PRIS(:,:,:) - ZW(:,:,:)
- IF (LBUDGET_RI) CALL BUDGET(PRIS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RI, 'AGGS_BU_RRI')
- IF (LBUDGET_RS) CALL BUDGET(PRSS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RS,'AGGS_BU_RRS')
+ if ( lbudget_ri ) call Budget_store_add( tbudgets(NBUDGET_RI), 'AGGS', -zw(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rs ) call Budget_store_add( tbudgets(NBUDGET_RS), 'AGGS', zw(:, :, :) * prhodj(:, :, :) )
ZW(:,:,:) = 0.
DO JL=1,IMICRO
ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RIAUTS(JL) * ZINV_TSTEP
END DO
- PRSS(:,:,:) = PRSS(:,:,:) + ZW(:,:,:)
- PRIS(:,:,:) = PRIS(:,:,:) - ZW(:,:,:)
- IF (LBUDGET_RI) CALL BUDGET(PRIS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RI, 'AUTS_BU_RRI')
- IF (LBUDGET_RS) CALL BUDGET(PRSS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RS,'AUTS_BU_RRS')
+ if ( lbudget_ri ) call Budget_store_add( tbudgets(NBUDGET_RI), 'AUTS', -zw(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rs ) call Budget_store_add( tbudgets(NBUDGET_RS), 'AUTS', zw(:, :, :) * prhodj(:, :, :) )
ZW(:,:,:) = 0.
DO JL=1,IMICRO
ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RVDEPG(JL) * ZINV_TSTEP
END DO
- PRGS(:,:,:) = PRGS(:,:,:) + ZW(:,:,:)
- PRVS(:,:,:) = PRVS(:,:,:) - ZW(:,:,:)
- PTHS(:,:,:) = PTHS(:,:,:) + ZW(:,:,:)*ZZ_LSFACT(:,:,:)
- IF (LBUDGET_TH) CALL BUDGET(PTHS(:,:,:)*PRHODJ(:,:,:), NBUDGET_TH, 'DEPG_BU_RTH')
- IF (LBUDGET_RV) CALL BUDGET(PRVS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RV, 'DEPG_BU_RRV')
- IF (LBUDGET_RG) CALL BUDGET(PRGS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RG,'DEPG_BU_RRG')
+ if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'DEPG', zw(:, :, :) * zz_lsfact(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rv ) call Budget_store_add( tbudgets(NBUDGET_RV), 'DEPG', -zw(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_add( tbudgets(NBUDGET_RG), 'DEPG', zw(:, :, :) * prhodj(:, :, :) )
IF(OWARM) THEN
ZW(:,:,:) = 0.
DO JL=1,IMICRO
ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RCAUTR(JL) * ZINV_TSTEP
END DO
- PRCS(:,:,:) = PRCS(:,:,:) - ZW(:,:,:)
- PRRS(:,:,:) = PRRS(:,:,:) + ZW(:,:,:)
- IF (LBUDGET_RC) CALL BUDGET(PRCS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RC, 'AUTO_BU_RRC')
- IF (LBUDGET_RR) CALL BUDGET(PRRS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RR, 'AUTO_BU_RRR')
+ if ( lbudget_rc ) call Budget_store_add( tbudgets(NBUDGET_RC), 'AUTO', -zw(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_add( tbudgets(NBUDGET_RR), 'AUTO', zw(:, :, :) * prhodj(:, :, :) )
ZW(:,:,:) = 0.
DO JL=1,IMICRO
ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RCACCR(JL) * ZINV_TSTEP
END DO
- PRCS(:,:,:) = PRCS(:,:,:) - ZW(:,:,:)
- PRRS(:,:,:) = PRRS(:,:,:) + ZW(:,:,:)
- IF (LBUDGET_RC) CALL BUDGET(PRCS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RC, 'ACCR_BU_RRC')
- IF (LBUDGET_RR) CALL BUDGET(PRRS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RR, 'ACCR_BU_RRR')
+ if ( lbudget_rc ) call Budget_store_add( tbudgets(NBUDGET_RC), 'ACCR', -zw(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_add( tbudgets(NBUDGET_RR), 'ACCR', zw(:, :, :) * prhodj(:, :, :) )
ZW(:,:,:) = 0.
DO JL=1,IMICRO
ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RREVAV(JL) * ZINV_TSTEP
END DO
- PRRS(:,:,:) = PRRS(:,:,:) - ZW(:,:,:)
- PRVS(:,:,:) = PRVS(:,:,:) + ZW(:,:,:)
- PTHS(:,:,:) = PTHS(:,:,:) - ZW(:,:,:)*ZZ_LVFACT(:,:,:)
- IF (LBUDGET_TH) CALL BUDGET(PTHS(:,:,:)*PRHODJ(:,:,:), NBUDGET_TH, 'REVA_BU_RTH')
- IF (LBUDGET_RV) CALL BUDGET(PRVS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RV, 'REVA_BU_RRV')
- IF (LBUDGET_RR) CALL BUDGET(PRRS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RR, 'REVA_BU_RRR')
+ if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'REVA', -zw(:, :, :) * zz_lvfact(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rv ) call Budget_store_add( tbudgets(NBUDGET_RV), 'REVA', zw(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_add( tbudgets(NBUDGET_RR), 'REVA', -zw(:, :, :) * prhodj(:, :, :) )
ENDIF
- ZW(:,:,:) = 0.
+ ZW1(:,:,:) = 0.
DO JL=1,IMICRO
- ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RCRIMSS(JL) * ZINV_TSTEP
+ ZW1(I1(JL), I2(JL), I3(JL)) = ZTOT_RCRIMSS(JL) * ZINV_TSTEP
END DO
- PRCS(:,:,:) = PRCS(:,:,:) - ZW(:,:,:)
- PRSS(:,:,:) = PRSS(:,:,:) + ZW(:,:,:)
- PTHS(:,:,:) = PTHS(:,:,:) + ZW(:,:,:)*(ZZ_LSFACT(:,:,:)-ZZ_LVFACT(:,:,:))
- ZW(:,:,:) = 0.
+ ZW2(:,:,:) = 0.
DO JL=1,IMICRO
- ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RCRIMSG(JL) * ZINV_TSTEP
+ ZW2(I1(JL), I2(JL), I3(JL)) = ZTOT_RCRIMSG(JL) * ZINV_TSTEP
END DO
- PRCS(:,:,:) = PRCS(:,:,:) - ZW(:,:,:)
- PRGS(:,:,:) = PRGS(:,:,:) + ZW(:,:,:)
- PTHS(:,:,:) = PTHS(:,:,:) + ZW(:,:,:)*(ZZ_LSFACT(:,:,:)-ZZ_LVFACT(:,:,:))
- ZW(:,:,:) = 0.
+ ZW3(:,:,:) = 0.
DO JL=1,IMICRO
- ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RSRIMCG(JL) * ZINV_TSTEP
+ ZW3(I1(JL), I2(JL), I3(JL)) = ZTOT_RSRIMCG(JL) * ZINV_TSTEP
END DO
- PRGS(:,:,:) = PRGS(:,:,:) + ZW(:,:,:)
- PRSS(:,:,:) = PRSS(:,:,:) - ZW(:,:,:)
- IF (LBUDGET_TH) CALL BUDGET(PTHS(:,:,:)*PRHODJ(:,:,:), NBUDGET_TH, 'RIM_BU_RTH')
- IF (LBUDGET_RC) CALL BUDGET(PRCS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RC, 'RIM_BU_RRC')
- IF (LBUDGET_RS) CALL BUDGET(PRSS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RS,'RIM_BU_RRS')
- IF (LBUDGET_RG) CALL BUDGET(PRGS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RG,'RIM_BU_RRG')
+ if ( lbudget_th ) &
+ call Budget_store_add( tbudgets(NBUDGET_TH), 'RIM', ( zw1(:, :, :) + zw2(:, :, :) ) * zz_diff(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rc ) call Budget_store_add( tbudgets(NBUDGET_RC), 'RIM', ( -zw1(:, :, :) - zw2(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rs ) call Budget_store_add( tbudgets(NBUDGET_RS), 'RIM', ( zw1(:, :, :) - zw3(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_add( tbudgets(NBUDGET_RG), 'RIM', ( zw2(:, :, :) + zw3(:, :, :) ) * prhodj(:, :, :) )
- ZW(:,:,:) = 0.
+ ZW1(:,:,:) = 0.
DO JL=1,IMICRO
- ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RRACCSS(JL) * ZINV_TSTEP
+ ZW1(I1(JL), I2(JL), I3(JL)) = ZTOT_RRACCSS(JL) * ZINV_TSTEP
END DO
- PRRS(:,:,:) = PRRS(:,:,:) - ZW(:,:,:)
- PRSS(:,:,:) = PRSS(:,:,:) + ZW(:,:,:)
- PTHS(:,:,:) = PTHS(:,:,:) + ZW(:,:,:)*(ZZ_LSFACT(:,:,:)-ZZ_LVFACT(:,:,:))
- ZW(:,:,:) = 0.
+ ZW2(:,:,:) = 0.
DO JL=1,IMICRO
- ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RRACCSG(JL) * ZINV_TSTEP
+ ZW2(I1(JL), I2(JL), I3(JL)) = ZTOT_RRACCSG(JL) * ZINV_TSTEP
END DO
- PRRS(:,:,:) = PRRS(:,:,:) - ZW(:,:,:)
- PRGS(:,:,:) = PRGS(:,:,:) + ZW(:,:,:)
- PTHS(:,:,:) = PTHS(:,:,:) + ZW(:,:,:)*(ZZ_LSFACT(:,:,:)-ZZ_LVFACT(:,:,:))
- ZW(:,:,:) = 0.
+ ZW3(:,:,:) = 0.
DO JL=1,IMICRO
- ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RSACCRG(JL) * ZINV_TSTEP
+ ZW3(I1(JL), I2(JL), I3(JL)) = ZTOT_RSACCRG(JL) * ZINV_TSTEP
END DO
- PRSS(:,:,:) = PRSS(:,:,:) - ZW(:,:,:)
- PRGS(:,:,:) = PRGS(:,:,:) + ZW(:,:,:)
- IF (LBUDGET_TH) CALL BUDGET(PTHS(:,:,:)*PRHODJ(:,:,:), NBUDGET_TH, 'ACC_BU_RTH')
- IF (LBUDGET_RR) CALL BUDGET(PRRS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RR, 'ACC_BU_RRR')
- IF (LBUDGET_RS) CALL BUDGET(PRSS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RS,'ACC_BU_RRS')
- IF (LBUDGET_RG) CALL BUDGET(PRGS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RG,'ACC_BU_RRG')
+ if ( lbudget_th ) &
+ call Budget_store_add( tbudgets(NBUDGET_TH), 'ACC', ( zw1(:, :, :) + zw2(:, :, :) ) * zz_diff(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_add( tbudgets(NBUDGET_RR), 'ACC', ( -zw1(:, :, :) - zw2(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rs ) call Budget_store_add( tbudgets(NBUDGET_RS), 'ACC', ( zw1(:, :, :) - zw3(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_add( tbudgets(NBUDGET_RG), 'ACC', ( zw2(:, :, :) + zw3(:, :, :) ) * prhodj(:, :, :) )
ZW(:,:,:) = 0.
DO JL=1,IMICRO
ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RSMLTG(JL) * ZINV_TSTEP
END DO
- PRSS(:,:,:) = PRSS(:,:,:) - ZW(:,:,:)
- PRGS(:,:,:) = PRGS(:,:,:) + ZW(:,:,:)
+ if ( lbudget_rs ) call Budget_store_add( tbudgets(NBUDGET_RS), 'CMEL', -zw(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_add( tbudgets(NBUDGET_RG), 'CMEL', zw(:, :, :) * prhodj(:, :, :) )
ZW(:,:,:) = 0.
DO JL=1,IMICRO
ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RCMLTSR(JL) * ZINV_TSTEP
END DO
- PRCS(:,:,:) = PRCS(:,:,:) - ZW(:,:,:)
- PRRS(:,:,:) = PRRS(:,:,:) + ZW(:,:,:)
- IF (LBUDGET_RS) CALL BUDGET(PRSS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RS,'CMEL_BU_RRS')
- IF (LBUDGET_RG) CALL BUDGET(PRGS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RG,'CMEL_BU_RRG')
- IF (LBUDGET_RC) CALL BUDGET(PRCS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RC, 'CMEL_BU_RRC')
- IF (LBUDGET_RR) CALL BUDGET(PRRS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RR, 'CMEL_BU_RRR')
+ if ( lbudget_rc ) call Budget_store_add( tbudgets(NBUDGET_RC), 'CMEL', -zw(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_add( tbudgets(NBUDGET_RR), 'CMEL', zw(:, :, :) * prhodj(:, :, :) )
- ZW(:,:,:) = 0.
+ ZW1(:,:,:) = 0.
DO JL=1,IMICRO
- ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RICFRRG(JL) * ZINV_TSTEP
+ ZW1(I1(JL), I2(JL), I3(JL)) = ZTOT_RICFRRG(JL) * ZINV_TSTEP
END DO
- PRIS(:,:,:) = PRIS(:,:,:) - ZW(:,:,:)
- PRGS(:,:,:) = PRGS(:,:,:) + ZW(:,:,:)
- ZW(:,:,:) = 0.
+ ZW2(:,:,:) = 0.
DO JL=1,IMICRO
- ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RRCFRIG(JL) * ZINV_TSTEP
+ ZW2(I1(JL), I2(JL), I3(JL)) = ZTOT_RRCFRIG(JL) * ZINV_TSTEP
END DO
- PRRS(:,:,:) = PRRS(:,:,:) - ZW(:,:,:)
- PRGS(:,:,:) = PRGS(:,:,:) + ZW(:,:,:)
- PTHS(:,:,:) = PTHS(:,:,:) + ZW(:,:,:)*(ZZ_LSFACT(:,:,:)-ZZ_LVFACT(:,:,:))
- ZW(:,:,:) = 0.
+ ZW3(:,:,:) = 0.
DO JL=1,IMICRO
- ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RICFRR(JL) * ZINV_TSTEP
+ ZW3(I1(JL), I2(JL), I3(JL)) = ZTOT_RICFRR(JL) * ZINV_TSTEP
END DO
- PRIS(:,:,:) = PRIS(:,:,:) - ZW(:,:,:)
- PRRS(:,:,:) = PRRS(:,:,:) + ZW(:,:,:)
- IF (LBUDGET_TH) CALL BUDGET(PTHS(:,:,:)*PRHODJ(:,:,:), NBUDGET_TH, 'CFRZ_BU_RTH')
- IF (LBUDGET_RR) CALL BUDGET(PRRS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RR, 'CFRZ_BU_RRR')
- IF (LBUDGET_RI) CALL BUDGET(PRIS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RI, 'CFRZ_BU_RRI')
- IF (LBUDGET_RG) CALL BUDGET(PRGS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RG,'CFRZ_BU_RRG')
+ if ( lbudget_th ) &
+ call Budget_store_add( tbudgets(NBUDGET_TH), 'CFRZ', zw2(:, :, :) * zz_diff(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_add( tbudgets(NBUDGET_RR), 'CFRZ', ( -zw2(:, :, :) + zw3(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_add( tbudgets(NBUDGET_RI), 'CFRZ', ( -zw1(:, :, :) - zw3(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_add( tbudgets(NBUDGET_RG), 'CFRZ', ( zw1(:, :, :) + zw2(:, :, :) ) * prhodj(:, :, :) )
- ZW(:,:,:) = 0.
+ ZW1(:,:,:) = 0.
DO JL=1,IMICRO
- ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RCWETG(JL) * ZINV_TSTEP
+ ZW1(I1(JL), I2(JL), I3(JL)) = ZTOT_RCWETG(JL) * ZINV_TSTEP
END DO
- PRCS(:,:,:) = PRCS(:,:,:) - ZW(:,:,:)
- PRGS(:,:,:) = PRGS(:,:,:) + ZW(:,:,:)
- PTHS(:,:,:) = PTHS(:,:,:) + ZW(:,:,:)*(ZZ_LSFACT(:,:,:)-ZZ_LVFACT(:,:,:))
- ZW(:,:,:) = 0.
+ ZW2(:,:,:) = 0.
DO JL=1,IMICRO
- ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RRWETG(JL) * ZINV_TSTEP
+ ZW2(I1(JL), I2(JL), I3(JL)) = ZTOT_RRWETG(JL) * ZINV_TSTEP
END DO
- PRRS(:,:,:) = PRRS(:,:,:) - ZW(:,:,:)
- PRGS(:,:,:) = PRGS(:,:,:) + ZW(:,:,:)
- PTHS(:,:,:) = PTHS(:,:,:) + ZW(:,:,:)*(ZZ_LSFACT(:,:,:)-ZZ_LVFACT(:,:,:))
- ZW(:,:,:) = 0.
+ ZW3(:,:,:) = 0.
DO JL=1,IMICRO
- ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RIWETG(JL) * ZINV_TSTEP
+ ZW3(I1(JL), I2(JL), I3(JL)) = ZTOT_RIWETG(JL) * ZINV_TSTEP
END DO
- PRIS(:,:,:) = PRIS(:,:,:) - ZW(:,:,:)
- PRGS(:,:,:) = PRGS(:,:,:) + ZW(:,:,:)
- ZW(:,:,:) = 0.
+ ZW4(:,:,:) = 0.
DO JL=1,IMICRO
- ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RSWETG(JL) * ZINV_TSTEP
+ ZW4(I1(JL), I2(JL), I3(JL)) = ZTOT_RSWETG(JL) * ZINV_TSTEP
END DO
- PRSS(:,:,:) = PRSS(:,:,:) - ZW(:,:,:)
- PRGS(:,:,:) = PRGS(:,:,:) + ZW(:,:,:)
- IF (LBUDGET_TH) CALL BUDGET(PTHS(:,:,:)*PRHODJ(:,:,:), NBUDGET_TH, 'WETG_BU_RTH')
- IF (LBUDGET_RC) CALL BUDGET(PRCS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RC, 'WETG_BU_RRC')
- IF (LBUDGET_RR) CALL BUDGET(PRRS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RR, 'WETG_BU_RRR')
- IF (LBUDGET_RI) CALL BUDGET(PRIS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RI, 'WETG_BU_RRI')
- IF (LBUDGET_RS) CALL BUDGET(PRSS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RS,'WETG_BU_RRS')
- IF (LBUDGET_RG) CALL BUDGET(PRGS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RG,'WETG_BU_RRG')
+ if ( lbudget_th ) &
+ call Budget_store_add( tbudgets(NBUDGET_TH), 'WETG', ( zw1(:, :, :) + zw2(:, :, :) ) * zz_diff(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rc ) call Budget_store_add( tbudgets(NBUDGET_RC), 'WETG', -zw1(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_add( tbudgets(NBUDGET_RR), 'WETG', -zw2(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_add( tbudgets(NBUDGET_RI), 'WETG', -zw3(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rs ) call Budget_store_add( tbudgets(NBUDGET_RS), 'WETG', -zw4(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_add( tbudgets(NBUDGET_RG), 'WETG', ( zw1(:, :, :) + zw2(:, :, :) &
+ + zw3(:, :, :) + zw4(:, :, :) ) &
+ * prhodj(:, :, :) )
IF(KRR==7) THEN
ZW(:,:,:) = 0.
DO JL=1,IMICRO
ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RWETGH(JL) * ZINV_TSTEP
END DO
- PRGS(:,:,:) = PRGS(:,:,:) - ZW(:,:,:)
- PRHS(:,:,:) = PRHS(:,:,:) + ZW(:,:,:)
- IF (LBUDGET_RG) CALL BUDGET(PRGS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RG,'GHCV_BU_RRG')
- IF (LBUDGET_RH) CALL BUDGET(PRHS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RH,'GHCV_BU_RRH')
+ if ( lbudget_rg ) call Budget_store_add( tbudgets(NBUDGET_RG), 'GHCV', -zw(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rh ) call Budget_store_add( tbudgets(NBUDGET_RH), 'GHCV', zw(:, :, :) * prhodj(:, :, :) )
END IF
- ZW(:,:,:) = 0.
+ ZW1(:,:,:) = 0.
DO JL=1,IMICRO
- ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RCDRYG(JL) * ZINV_TSTEP
+ ZW1(I1(JL), I2(JL), I3(JL)) = ZTOT_RCDRYG(JL) * ZINV_TSTEP
END DO
- PRCS(:,:,:) = PRCS(:,:,:) - ZW(:,:,:)
- PRGS(:,:,:) = PRGS(:,:,:) + ZW(:,:,:)
- PTHS(:,:,:) = PTHS(:,:,:) + ZW(:,:,:)*(ZZ_LSFACT(:,:,:)-ZZ_LVFACT(:,:,:))
- ZW(:,:,:) = 0.
+ ZW2(:,:,:) = 0.
DO JL=1,IMICRO
- ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RRDRYG(JL) * ZINV_TSTEP
+ ZW2(I1(JL), I2(JL), I3(JL)) = ZTOT_RRDRYG(JL) * ZINV_TSTEP
END DO
- PRRS(:,:,:) = PRRS(:,:,:) - ZW(:,:,:)
- PRGS(:,:,:) = PRGS(:,:,:) + ZW(:,:,:)
- PTHS(:,:,:) = PTHS(:,:,:) + ZW(:,:,:)*(ZZ_LSFACT(:,:,:)-ZZ_LVFACT(:,:,:))
- ZW(:,:,:) = 0.
+ ZW3(:,:,:) = 0.
DO JL=1,IMICRO
- ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RIDRYG(JL) * ZINV_TSTEP
+ ZW3(I1(JL), I2(JL), I3(JL)) = ZTOT_RIDRYG(JL) * ZINV_TSTEP
END DO
- PRIS(:,:,:) = PRIS(:,:,:) - ZW(:,:,:)
- PRGS(:,:,:) = PRGS(:,:,:) + ZW(:,:,:)
- ZW(:,:,:) = 0.
+ ZW4(:,:,:) = 0.
DO JL=1,IMICRO
- ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RSDRYG(JL) * ZINV_TSTEP
+ ZW4(I1(JL), I2(JL), I3(JL)) = ZTOT_RSDRYG(JL) * ZINV_TSTEP
END DO
- PRSS(:,:,:) = PRSS(:,:,:) - ZW(:,:,:)
- PRGS(:,:,:) = PRGS(:,:,:) + ZW(:,:,:)
- IF (LBUDGET_TH) CALL BUDGET(PTHS(:,:,:)*PRHODJ(:,:,:), NBUDGET_TH, 'DRYG_BU_RTH')
- IF (LBUDGET_RC) CALL BUDGET(PRCS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RC, 'DRYG_BU_RRC')
- IF (LBUDGET_RR) CALL BUDGET(PRRS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RR, 'DRYG_BU_RRR')
- IF (LBUDGET_RI) CALL BUDGET(PRIS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RI, 'DRYG_BU_RRI')
- IF (LBUDGET_RS) CALL BUDGET(PRSS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RS,'DRYG_BU_RRS')
- IF (LBUDGET_RG) CALL BUDGET(PRGS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RG,'DRYG_BU_RRG')
+ if ( lbudget_th ) &
+ call Budget_store_add( tbudgets(NBUDGET_TH), 'DRYG', ( zw1(:, :, :) + zw2(:, :, :) ) * zz_diff(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rc ) call Budget_store_add( tbudgets(NBUDGET_RC), 'DRYG', -zw1(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_add( tbudgets(NBUDGET_RR), 'DRYG', -zw2(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_add( tbudgets(NBUDGET_RI), 'DRYG', -zw3(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rs ) call Budget_store_add( tbudgets(NBUDGET_RS), 'DRYG', -zw4(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_add( tbudgets(NBUDGET_RG), 'DRYG', ( zw1(:, :, :) + zw2(:, :, :) &
+ + zw3(:, :, :) + zw4(:, :, :) ) &
+ * prhodj(:, :, :) )
ZW(:,:,:) = 0.
DO JL=1,IMICRO
ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RGMLTR(JL) * ZINV_TSTEP
END DO
- PRRS(:,:,:) = PRRS(:,:,:) + ZW(:,:,:)
- PRGS(:,:,:) = PRGS(:,:,:) - ZW(:,:,:)
- PTHS(:,:,:) = PTHS(:,:,:) - ZW(:,:,:)*(ZZ_LSFACT(:,:,:)-ZZ_LVFACT(:,:,:))
- IF (LBUDGET_TH) CALL BUDGET(PTHS(:,:,:)*PRHODJ(:,:,:), NBUDGET_TH, 'GMLT_BU_RTH')
- IF (LBUDGET_RR) CALL BUDGET(PRRS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RR, 'GMLT_BU_RRR')
- IF (LBUDGET_RG) CALL BUDGET(PRGS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RG,'GMLT_BU_RRG')
+ if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'GMLT', -zw(:, :, :) * zz_diff(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_add( tbudgets(NBUDGET_RR), 'GMLT', zw(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_add( tbudgets(NBUDGET_RG), 'GMLT', -zw(:, :, :) * prhodj(:, :, :) )
IF(KRR==7) THEN
- ZW(:,:,:) = 0.
+ ZW1(:,:,:) = 0.
DO JL=1,IMICRO
- ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RCWETH(JL) * ZINV_TSTEP
+ ZW1(I1(JL), I2(JL), I3(JL)) = ZTOT_RCWETH(JL) * ZINV_TSTEP
END DO
- PRCS(:,:,:) = PRCS(:,:,:) - ZW(:,:,:)
- PRHS(:,:,:) = PRHS(:,:,:) + ZW(:,:,:)
- PTHS(:,:,:) = PTHS(:,:,:) + ZW(:,:,:)*(ZZ_LSFACT(:,:,:)-ZZ_LVFACT(:,:,:))
- ZW(:,:,:) = 0.
+ ZW2(:,:,:) = 0.
DO JL=1,IMICRO
- ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RRWETH(JL) * ZINV_TSTEP
+ ZW2(I1(JL), I2(JL), I3(JL)) = ZTOT_RRWETH(JL) * ZINV_TSTEP
END DO
- PRRS(:,:,:) = PRRS(:,:,:) - ZW(:,:,:)
- PRHS(:,:,:) = PRHS(:,:,:) + ZW(:,:,:)
- PTHS(:,:,:) = PTHS(:,:,:) + ZW(:,:,:)*(ZZ_LSFACT(:,:,:)-ZZ_LVFACT(:,:,:))
- ZW(:,:,:) = 0.
+ ZW3(:,:,:) = 0.
DO JL=1,IMICRO
- ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RIWETH(JL) * ZINV_TSTEP
+ ZW3(I1(JL), I2(JL), I3(JL)) = ZTOT_RIWETH(JL) * ZINV_TSTEP
END DO
- PRIS(:,:,:) = PRIS(:,:,:) - ZW(:,:,:)
- PRHS(:,:,:) = PRHS(:,:,:) + ZW(:,:,:)
- ZW(:,:,:) = 0.
+ ZW4(:,:,:) = 0.
DO JL=1,IMICRO
- ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RSWETH(JL) * ZINV_TSTEP
+ ZW4(I1(JL), I2(JL), I3(JL)) = ZTOT_RSWETH(JL) * ZINV_TSTEP
END DO
- PRSS(:,:,:) = PRSS(:,:,:) - ZW(:,:,:)
- PRHS(:,:,:) = PRHS(:,:,:) + ZW(:,:,:)
- ZW(:,:,:) = 0.
+ ZW5(:,:,:) = 0.
DO JL=1,IMICRO
- ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RGWETH(JL) * ZINV_TSTEP
+ ZW5(I1(JL), I2(JL), I3(JL)) = ZTOT_RGWETH(JL) * ZINV_TSTEP
END DO
- PRGS(:,:,:) = PRGS(:,:,:) - ZW(:,:,:)
- PRHS(:,:,:) = PRHS(:,:,:) + ZW(:,:,:)
- IF (LBUDGET_TH) CALL BUDGET(PTHS(:,:,:)*PRHODJ(:,:,:), NBUDGET_TH, 'WETH_BU_RTH')
- IF (LBUDGET_RC) CALL BUDGET(PRCS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RC, 'WETH_BU_RRC')
- IF (LBUDGET_RR) CALL BUDGET(PRRS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RR, 'WETH_BU_RRR')
- IF (LBUDGET_RI) CALL BUDGET(PRIS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RI, 'WETH_BU_RRI')
- IF (LBUDGET_RS) CALL BUDGET(PRSS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RS,'WETH_BU_RRS')
- IF (LBUDGET_RH) CALL BUDGET(PRHS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RH,'WETH_BU_RRH')
+ if ( lbudget_th ) &
+ call Budget_store_add( tbudgets(NBUDGET_TH), 'WETH', ( zw1(:, :, :) + zw2(:, :, :) ) * zz_diff(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rc ) call Budget_store_add( tbudgets(NBUDGET_RC), 'WETH', -zw1(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_add( tbudgets(NBUDGET_RR), 'WETH', -zw2(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_add( tbudgets(NBUDGET_RI), 'WETH', -zw3(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rs ) call Budget_store_add( tbudgets(NBUDGET_RS), 'WETH', -zw4(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_add( tbudgets(NBUDGET_RG), 'WETH', -zw5(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rh ) call Budget_store_add( tbudgets(NBUDGET_RH), 'WETH', ( zw1(:, :, :) + zw2(:, :, :) + zw3(:, :, :) &
+ + zw4(:, :, :) + zw5(:, :, : ) ) &
+ * prhodj(:, :, :) )
ZW(:,:,:) = 0.
DO JL=1,IMICRO
ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RGWETH(JL) * ZINV_TSTEP
END DO
- PRGS(:,:,:) = PRGS(:,:,:) - ZW(:,:,:)
- PRHS(:,:,:) = PRHS(:,:,:) + ZW(:,:,:)
- IF (LBUDGET_RG) CALL BUDGET(PRGS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RG,'HGCV_BU_RRG')
- IF (LBUDGET_RH) CALL BUDGET(PRHS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RH,'HGCV_BU_RRH')
+ if ( lbudget_rg ) call Budget_store_add( tbudgets(NBUDGET_RG), 'HGCV', -zw(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rh ) call Budget_store_add( tbudgets(NBUDGET_RH), 'HGCV', zw(:, :, :) * prhodj(:, :, :) )
- ZW(:,:,:) = 0.
+ ZW1(:,:,:) = 0.
DO JL=1,IMICRO
- ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RCDRYH(JL) * ZINV_TSTEP
+ ZW1(I1(JL), I2(JL), I3(JL)) = ZTOT_RCDRYH(JL) * ZINV_TSTEP
END DO
- PRCS(:,:,:) = PRCS(:,:,:) - ZW(:,:,:)
- PRHS(:,:,:) = PRHS(:,:,:) + ZW(:,:,:)
- PTHS(:,:,:) = PTHS(:,:,:) + ZW(:,:,:)*(ZZ_LSFACT(:,:,:)-ZZ_LVFACT(:,:,:))
- ZW(:,:,:) = 0.
+ ZW2(:,:,:) = 0.
DO JL=1,IMICRO
- ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RRDRYH(JL) * ZINV_TSTEP
+ ZW2(I1(JL), I2(JL), I3(JL)) = ZTOT_RRDRYH(JL) * ZINV_TSTEP
END DO
- PRRS(:,:,:) = PRRS(:,:,:) - ZW(:,:,:)
- PRHS(:,:,:) = PRHS(:,:,:) + ZW(:,:,:)
- PTHS(:,:,:) = PTHS(:,:,:) + ZW(:,:,:)*(ZZ_LSFACT(:,:,:)-ZZ_LVFACT(:,:,:))
- ZW(:,:,:) = 0.
+ ZW3(:,:,:) = 0.
DO JL=1,IMICRO
- ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RIDRYH(JL) * ZINV_TSTEP
+ ZW3(I1(JL), I2(JL), I3(JL)) = ZTOT_RIDRYH(JL) * ZINV_TSTEP
END DO
- PRIS(:,:,:) = PRIS(:,:,:) - ZW(:,:,:)
- PRHS(:,:,:) = PRHS(:,:,:) + ZW(:,:,:)
- ZW(:,:,:) = 0.
+ ZW4(:,:,:) = 0.
DO JL=1,IMICRO
- ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RSDRYH(JL) * ZINV_TSTEP
+ ZW4(I1(JL), I2(JL), I3(JL)) = ZTOT_RSDRYH(JL) * ZINV_TSTEP
END DO
- PRSS(:,:,:) = PRSS(:,:,:) - ZW(:,:,:)
- PRHS(:,:,:) = PRHS(:,:,:) + ZW(:,:,:)
- ZW(:,:,:) = 0.
+ ZW5(:,:,:) = 0.
DO JL=1,IMICRO
- ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RGDRYH(JL) * ZINV_TSTEP
+ ZW5(I1(JL), I2(JL), I3(JL)) = ZTOT_RGDRYH(JL) * ZINV_TSTEP
END DO
- PRGS(:,:,:) = PRGS(:,:,:) - ZW(:,:,:)
- PRHS(:,:,:) = PRHS(:,:,:) + ZW(:,:,:)
- ZW(:,:,:) = 0.
+ ZW6(:,:,:) = 0.
DO JL=1,IMICRO
- ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RDRYHG(JL) * ZINV_TSTEP
+ ZW6(I1(JL), I2(JL), I3(JL)) = ZTOT_RDRYHG(JL) * ZINV_TSTEP
END DO
- PRHS(:,:,:) = PRHS(:,:,:) - ZW(:,:,:)
- PRGS(:,:,:) = PRGS(:,:,:) + ZW(:,:,:)
- IF (LBUDGET_TH) CALL BUDGET(PTHS(:,:,:)*PRHODJ(:,:,:), NBUDGET_TH, 'DRYH_BU_RTH')
- IF (LBUDGET_RC) CALL BUDGET(PRCS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RC, 'DRYH_BU_RRC')
- IF (LBUDGET_RR) CALL BUDGET(PRRS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RR, 'DRYH_BU_RRR')
- IF (LBUDGET_RI) CALL BUDGET(PRIS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RI, 'DRYH_BU_RRI')
- IF (LBUDGET_RS) CALL BUDGET(PRSS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RS,'DRYH_BU_RRS')
- IF (LBUDGET_RG) CALL BUDGET(PRGS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RG,'DRYH_BU_RRG')
- IF (LBUDGET_RH) CALL BUDGET(PRHS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RH,'DRYH_BU_RRH')
+ if ( lbudget_th ) &
+ call Budget_store_add( tbudgets(NBUDGET_TH), 'DRYH', ( zw1(:, :, :) + zw2(:, :, :) ) * zz_diff(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rc ) call Budget_store_add( tbudgets(NBUDGET_RC), 'DRYH', -zw1(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_add( tbudgets(NBUDGET_RR), 'DRYH', -zw2(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_add( tbudgets(NBUDGET_RI), 'DRYH', -zw3(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rs ) call Budget_store_add( tbudgets(NBUDGET_RS), 'DRYH', -zw4(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_add( tbudgets(NBUDGET_RG), 'DRYH', ( -zw5(:, :, :) + zw6(:, :, : ) ) * prhodj(:, :, :) )
+ if ( lbudget_rh ) call Budget_store_add( tbudgets(NBUDGET_RH), 'DRYH', ( zw1(:, :, :) + zw2(:, :, :) + zw3(:, :, :) &
+ + zw4(:, :, :) + zw5(:, :, : )- zw6(:, :, :) ) &
+ * prhodj(:, :, :) )
ZW(:,:,:) = 0.
DO JL=1,IMICRO
ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RHMLTR(JL) * ZINV_TSTEP
END DO
- PRRS(:,:,:) = PRRS(:,:,:) + ZW(:,:,:)
- PRHS(:,:,:) = PRHS(:,:,:) - ZW(:,:,:)
- PTHS(:,:,:) = PTHS(:,:,:) - ZW(:,:,:)*(ZZ_LSFACT(:,:,:)-ZZ_LVFACT(:,:,:))
- IF (LBUDGET_TH) CALL BUDGET(PTHS(:,:,:)*PRHODJ(:,:,:), NBUDGET_TH, 'HMLT_BU_RTH')
- IF (LBUDGET_RR) CALL BUDGET(PRRS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RR, 'HMLT_BU_RRR')
- IF (LBUDGET_RH) CALL BUDGET(PRHS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RH,'HMLT_BU_RRH')
+ if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'HMLT', -zw(:, :, :) * zz_diff(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_add( tbudgets(NBUDGET_RR), 'HMLT', zw(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rh ) call Budget_store_add( tbudgets(NBUDGET_RH), 'HMLT', -zw(:, :, :) * prhodj(:, :, :) )
ENDIF
ZW(:,:,:) = 0.
DO JL=1,IMICRO
ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RIMLTC(JL) * ZINV_TSTEP
END DO
- PRIS(:,:,:) = PRIS(:,:,:) - ZW(:,:,:)
- PRCS(:,:,:) = PRCS(:,:,:) + ZW(:,:,:)
- PTHS(:,:,:) = PTHS(:,:,:) - ZW(:,:,:)*(ZZ_LSFACT(:,:,:)-ZZ_LVFACT(:,:,:))
- IF (LBUDGET_TH) CALL BUDGET(PTHS(:,:,:)*PRHODJ(:,:,:), NBUDGET_TH, 'IMLT_BU_RTH')
- IF (LBUDGET_RC) CALL BUDGET(PRCS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RC, 'IMLT_BU_RRC')
- IF (LBUDGET_RI) CALL BUDGET(PRIS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RI, 'IMLT_BU_RRI')
+ if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'IMLT', -zw(:, :, :) * zz_diff(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rc ) call Budget_store_add( tbudgets(NBUDGET_RC), 'IMLT', zw(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_add( tbudgets(NBUDGET_RI), 'IMLT', -zw(:, :, :) * prhodj(:, :, :) )
ZW(:,:,:) = 0.
DO JL=1,IMICRO
ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RCBERI(JL) * ZINV_TSTEP
END DO
- PRCS(:,:,:) = PRCS(:,:,:) - ZW(:,:,:)
- PRIS(:,:,:) = PRIS(:,:,:) + ZW(:,:,:)
- PTHS(:,:,:) = PTHS(:,:,:) + ZW(:,:,:)*(ZZ_LSFACT(:,:,:)-ZZ_LVFACT(:,:,:))
- IF (LBUDGET_TH) CALL BUDGET(PTHS(:,:,:)*PRHODJ(:,:,:), NBUDGET_TH, 'BERFI_BU_RTH')
- IF (LBUDGET_RC) CALL BUDGET(PRCS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RC, 'BERFI_BU_RRC')
- IF (LBUDGET_RI) CALL BUDGET(PRIS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RI, 'BERFI_BU_RRI')
+ if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'BERFI', zw(:, :, :) * zz_diff(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rc ) call Budget_store_add( tbudgets(NBUDGET_RC), 'BERFI', -zw(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_add( tbudgets(NBUDGET_RI), 'BERFI', zw(:, :, :) * prhodj(:, :, :) )
+
+ deallocate( zw1, zw2, zw3, zw4 )
+ if ( krr == 7 ) deallocate( zw5, zw6 )
+ if ( lbudget_th ) deallocate( zz_diff )
ENDIF
!
!*** 7.3 Final tendencies
!
+if ( lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'CORR', pths(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rv ) call Budget_store_init( tbudgets(NBUDGET_RV), 'CORR', prvs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'CORR', prcs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'CORR', prrs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'CORR', pris(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rs ) call Budget_store_init( tbudgets(NBUDGET_RS), 'CORR', prss(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_init( tbudgets(NBUDGET_RG), 'CORR', prgs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rh ) call Budget_store_init( tbudgets(NBUDGET_RH), 'CORR', prhs(:, :, :) * prhodj(:, :, :) )
+end if
PRVS(:,:,:) = ZW_RVS(:,:,:)
PRCS(:,:,:) = ZW_RCS(:,:,:)
PRRS(:,:,:) = ZW_RRS(:,:,:)
@@ -1545,18 +1501,16 @@ IF (KRR==7) THEN
PRHS(:,:,:) = ZW_RHS(:,:,:)
ENDIF
PTHS(:,:,:) = ZW_THS(:,:,:)
-IF(LBU_ENABLE) THEN
- IF (LBUDGET_TH) CALL BUDGET(PTHS(:,:,:)*PRHODJ(:,:,:), NBUDGET_TH, 'CORR_BU_RTH')
- IF (LBUDGET_RV) CALL BUDGET(PRVS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RV, 'CORR_BU_RRV')
- IF (LBUDGET_RC) CALL BUDGET(PRCS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RC, 'CORR_BU_RRC')
- IF (LBUDGET_RR) CALL BUDGET(PRRS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RR, 'CORR_BU_RRR')
- IF (LBUDGET_RI) CALL BUDGET(PRIS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RI, 'CORR_BU_RRI')
- IF (LBUDGET_RS) CALL BUDGET(PRSS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RS,'CORR_BU_RRS')
- IF (LBUDGET_RG) CALL BUDGET(PRGS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RG,'CORR_BU_RRG')
- IF (KRR==7) THEN
- IF (LBUDGET_RH) CALL BUDGET(PRHS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RH,'CORR_BU_RRH')
- ENDIF
-ENDIF
+if ( lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'CORR', pths(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rv ) call Budget_store_end( tbudgets(NBUDGET_RV), 'CORR', prvs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'CORR', prcs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'CORR', prrs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'CORR', pris(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rs ) call Budget_store_end( tbudgets(NBUDGET_RS), 'CORR', prss(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG), 'CORR', prgs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rh ) call Budget_store_end( tbudgets(NBUDGET_RH), 'CORR', prhs(:, :, :) * prhodj(:, :, :) )
+end if
!
!-------------------------------------------------------------------------------
!
@@ -1567,6 +1521,19 @@ IF(LSEDIM_AFTER) THEN
!
!* 8.1 sedimentation
!
+ if ( lbudget_rc .and. osedic ) call Budget_store_init( tbudgets(NBUDGET_RC), 'SEDI', prcs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'SEDI', prrs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'SEDI', pris(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rs ) call Budget_store_init( tbudgets(NBUDGET_RS), 'SEDI', prss(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_init( tbudgets(NBUDGET_RG), 'SEDI', prgs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rh ) call Budget_store_init( tbudgets(NBUDGET_RH), 'SEDI', prhs(:, :, :) * prhodj(:, :, :) )
+
+ !Init only of not osedic (to prevent crash with double init)
+ !Remark: the 2 source terms SEDI and DEPO could be mixed and stored in the same source term (SEDI)
+ ! if osedic=T and ldeposc=T (a warning is printed in ini_budget in that case)
+ if ( lbudget_rc .and. ldeposc .and. .not.osedic ) &
+ call Budget_store_init( tbudgets(NBUDGET_RC), 'DEPO', prcs(:, :, :) * prhodj(:, :, :) )
+
IF(HSEDIM=='STAT') THEN
!SR: It *seems* that we must have two separate calls for ifort
IF(KRR==7) THEN
@@ -1629,15 +1596,18 @@ IF(LSEDIM_AFTER) THEN
!
!* 8.2 budget storage
!
- IF (LBUDGET_RC .AND. OSEDIC) &
- CALL BUDGET (PRCS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RC, 'SEDI_BU_RRC')
- IF (LBUDGET_RR) CALL BUDGET (PRRS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RR, 'SEDI_BU_RRR')
- IF (LBUDGET_RI) CALL BUDGET (PRIS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RI, 'SEDI_BU_RRI')
- IF (LBUDGET_RS) CALL BUDGET (PRSS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RS, 'SEDI_BU_RRS')
- IF (LBUDGET_RG) CALL BUDGET (PRGS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RG, 'SEDI_BU_RRG')
- IF ( KRR == 7 .AND. LBUDGET_RH) &
- CALL BUDGET (PRHS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RH, 'SEDI_BU_RRH')
- !
+ if ( lbudget_rc .and. osedic ) call Budget_store_end( tbudgets(NBUDGET_RC), 'SEDI', prcs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'SEDI', prrs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'SEDI', pris(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rs ) call Budget_store_end( tbudgets(NBUDGET_RS), 'SEDI', prss(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG), 'SEDI', prgs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rh ) call Budget_store_end( tbudgets(NBUDGET_RH), 'SEDI', prhs(:, :, :) * prhodj(:, :, :) )
+
+ !If osedic=T and ldeposc=T, DEPO is in fact mixed and stored with the SEDI source term
+ !(a warning is printed in ini_budget in that case)
+ if ( lbudget_rc .and. ldeposc .and. .not.osedic) &
+ call Budget_store_end( tbudgets(NBUDGET_RC), 'DEPO', prcs(:, :, :) * prhodj(:, :, :) )
+
!sedimentation of rain fraction
CALL ICE4_RAINFR_VERT(IIB, IIE, IIT, IJB, IJE, IJT, IKB, IKE, IKT, KKL, PRAINFR, PRRS(:,:,:)*PTSTEP)
ENDIF
diff --git a/src/MNH/rain_ice_sedimentation_split.f90 b/src/MNH/rain_ice_sedimentation_split.f90
index 349004ee8bcbd504b6bb0d1410061d49f5352278..370cc07ef9bea548c8fe2aef7dfd5aab70afffd2 100644
--- a/src/MNH/rain_ice_sedimentation_split.f90
+++ b/src/MNH/rain_ice_sedimentation_split.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1995-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1995-2020 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.
@@ -7,6 +7,7 @@
! P. Wautelet 25/02/2019: split rain_ice (cleaner and easier to maintain/debug)
! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90
+! P. Wautelet 02/2020: use the new data structures and subroutines for budgets
!-----------------------------------------------------------------
MODULE MODE_RAIN_ICE_SEDIMENTATION_SPLIT
@@ -26,8 +27,9 @@ SUBROUTINE RAIN_ICE_SEDIMENTATION_SPLIT(KIB, KIE, KJB, KJE, KKB, KKE, KKTB, KKTE
!* 0. DECLARATIONS
! ------------
!
-use MODD_BUDGET, only: LBUDGET_RC, LBUDGET_RR, LBUDGET_RI, LBUDGET_RS, LBUDGET_RG, LBUDGET_RH, &
- NBUDGET_RC, NBUDGET_RR, NBUDGET_RI, NBUDGET_RS, NBUDGET_RG, NBUDGET_RH
+use modd_budget, only: lbudget_rc, lbudget_rr, lbudget_ri, lbudget_rs, lbudget_rg, lbudget_rh, &
+ NBUDGET_RC, NBUDGET_RR, NBUDGET_RI, NBUDGET_RS, NBUDGET_RG, NBUDGET_RH, &
+ tbudgets
use MODD_CST, only: XCPD, XP00, XRD, XRHOLW
use MODD_PARAM_ICE, only: XVDEPOSC
use MODD_RAIN_ICE_DESCR, only: XCC, XCONC_LAND, xconc_sea, xconc_urban, XDC, XCEXVT, &
@@ -35,9 +37,8 @@ use MODD_RAIN_ICE_DESCR, only: XCC, XCONC_LAND, xconc_sea, xconc_urban, XDC, XCE
use MODD_RAIN_ICE_PARAM, only: XEXSEDG, XEXSEDH, XEXCSEDI, XEXSEDR, XEXSEDS, &
XFSEDG, XFSEDH, XFSEDI, XFSEDR, XFSEDS, XFSEDC
-use mode_tools, only: Countjv
-
-use MODI_BUDGET
+use mode_budget, only: Budget_store_init, Budget_store_end
+use mode_tools, only: Countjv
IMPLICIT NONE
!
@@ -146,7 +147,13 @@ REAL, DIMENSION(SIZE(PRCS,1),SIZE(PRCS,2),SIZE(PRCS,3)) &
REAL, DIMENSION(SIZE(PRCS,1),SIZE(PRCS,2),0:SIZE(PRCS,3)+1) &
:: ZWSED ! sedimentation fluxes
!-------------------------------------------------------------------------------
-!
+
+if ( lbudget_rc .and. osedic ) call Budget_store_init( tbudgets(NBUDGET_RC), 'SEDI', prcs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'SEDI', prrs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'SEDI', pris(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rs ) call Budget_store_init( tbudgets(NBUDGET_RS), 'SEDI', prss(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rg ) call Budget_store_init( tbudgets(NBUDGET_RG), 'SEDI', prgs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rh ) call Budget_store_init( tbudgets(NBUDGET_RH), 'SEDI', prhs(:, :, :) * prhodj(:, :, :) )
!
! O. Initialization of for sedimentation
!
@@ -582,20 +589,18 @@ IF (KRR == 7 .AND. (ILENALLOCH .GT. 0 )) DEALLOCATE(ZRHODREFH,ZRHS,ILISTH)
!
!* 2.3 budget storage
!
-IF (LBUDGET_RC .AND. OSEDIC) &
- CALL BUDGET (PRCS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RC, 'SEDI_BU_RRC')
-IF (LBUDGET_RR) CALL BUDGET (PRRS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RR, 'SEDI_BU_RRR')
-IF (LBUDGET_RI) CALL BUDGET (PRIS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RI, 'SEDI_BU_RRI')
-IF (LBUDGET_RS) CALL BUDGET (PRSS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RS, 'SEDI_BU_RRS')
-IF (LBUDGET_RG) CALL BUDGET (PRGS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RG, 'SEDI_BU_RRG')
-IF ( KRR == 7 .AND. LBUDGET_RH) &
- CALL BUDGET (PRHS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RH, 'SEDI_BU_RRH')
-!
-!
+if ( lbudget_rc .and. osedic ) call Budget_store_end( tbudgets(NBUDGET_RC), 'SEDI', prcs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'SEDI', prrs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'SEDI', pris(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rs ) call Budget_store_end( tbudgets(NBUDGET_RS), 'SEDI', prss(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG), 'SEDI', prgs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rh ) call Budget_store_end( tbudgets(NBUDGET_RH), 'SEDI', prhs(:, :, :) * prhodj(:, :, :) )
!
!* 2.4 DROPLET DEPOSITION AT THE 1ST LEVEL ABOVE GROUND
!
IF (ODEPOSC) THEN
+ if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'DEPO', prcs(:, :, :) * prhodj(:, :, :) )
+
GDEP(:,:) = .FALSE.
GDEP(KIB:KIE,KJB:KJE) = PRCS(KIB:KIE,KJB:KJE,KKB) >0
WHERE (GDEP)
@@ -603,14 +608,10 @@ IF (ODEPOSC) THEN
PINPRC(:,:) = PINPRC(:,:) + XVDEPOSC * PRCT(:,:,KKB) * PRHODREF(:,:,KKB) /XRHOLW
PINDEP(:,:) = XVDEPOSC * PRCT(:,:,KKB) * PRHODREF(:,:,KKB) /XRHOLW
END WHERE
+
+ if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'DEPO', prcs(:, :, :) * prhodj(:, :, :) )
END IF
-!
-!* 2.5 budget storage
-!
-IF ( LBUDGET_RC .AND. ODEPOSC ) &
- CALL BUDGET (PRCS(:,:,:)*PRHODJ(:,:,:), NBUDGET_RC,'DEPO_BU_RRC')
-!
- END SUBROUTINE RAIN_ICE_SEDIMENTATION_SPLIT
+END SUBROUTINE RAIN_ICE_SEDIMENTATION_SPLIT
END MODULE MODE_RAIN_ICE_SEDIMENTATION_SPLIT
diff --git a/src/MNH/rain_ice_sedimentation_stat.f90 b/src/MNH/rain_ice_sedimentation_stat.f90
index 895e2365687feb5eb637796d017c0f2b82d33729..68eff90a2773e9ab61b3280428467a96662383ff 100644
--- a/src/MNH/rain_ice_sedimentation_stat.f90
+++ b/src/MNH/rain_ice_sedimentation_stat.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1995-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1995-2020 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.
@@ -6,6 +6,7 @@
! Modifications:
! P. Wautelet 25/02/2019: split rain_ice (cleaner and easier to maintain/debug)
! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90
+! P. Wautelet 02/2020: use the new data structures and subroutines for budgets
!-----------------------------------------------------------------
MODULE MODE_RAIN_ICE_SEDIMENTATION_STAT
@@ -26,8 +27,9 @@ SUBROUTINE RAIN_ICE_SEDIMENTATION_STAT( KIB, KIE, KJB, KJE, KKB, KKE, KKTB, KKTE
!* 0. DECLARATIONS
! ------------
!
-use MODD_BUDGET, only: LBUDGET_RC, LBUDGET_RR, LBUDGET_RI, LBUDGET_RS, LBUDGET_RG, LBUDGET_RH, &
- NBUDGET_RC, NBUDGET_RR, NBUDGET_RI, NBUDGET_RS, NBUDGET_RG, NBUDGET_RH
+use modd_budget, only: lbudget_rc, lbudget_rr, lbudget_ri, lbudget_rs, lbudget_rg, lbudget_rh, &
+ NBUDGET_RC, NBUDGET_RR, NBUDGET_RI, NBUDGET_RS, NBUDGET_RG, NBUDGET_RH, &
+ tbudgets
use MODD_CST, only: XRHOLW
use MODD_PARAM_ICE, only: LDEPOSC, XVDEPOSC
use MODD_RAIN_ICE_PARAM, only: XEXSEDG, XEXSEDH, XEXCSEDI, XEXSEDR, XEXSEDS, &
@@ -35,10 +37,9 @@ use MODD_RAIN_ICE_PARAM, only: XEXSEDG, XEXSEDH, XEXCSEDI, XEXSEDR, XEXSEDS, &
use MODD_RAIN_ICE_DESCR, only: XALPHAC, XALPHAC2, XCC, XCEXVT, XCONC_LAND, XCONC_SEA, XCONC_URBAN, &
XDC, XLBC, XLBEXC, XNUC, XNUC2, XRTMIN
+use mode_budget, only: Budget_store_init, Budget_store_end
use mode_tools, only: Countjv
-use MODI_BUDGET
-
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
@@ -106,8 +107,14 @@ REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),0:SIZE(PRHODREF,3)+1) &
REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),0:SIZE(PRHODREF,3)+1) &
:: ZWSEDW2 ! sedimentation speed
!-------------------------------------------------------------------------------
-!
-!
+
+if ( lbudget_rc .and. osedic ) call Budget_store_init( tbudgets(NBUDGET_RC), 'SEDI', prcs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'SEDI', prrs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'SEDI', pris(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rs ) call Budget_store_init( tbudgets(NBUDGET_RS), 'SEDI', prss(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rg ) call Budget_store_init( tbudgets(NBUDGET_RG), 'SEDI', prgs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rh ) call Budget_store_init( tbudgets(NBUDGET_RH), 'SEDI', prhs(:, :, :) * prhodj(:, :, :) )
+
ZINVTSTEP=1./PTSTEP
!
!* 1. Parameters for cloud sedimentation
@@ -544,23 +551,21 @@ PINPRR3D (:,:,:) = 0.
ENDIF
!
-
-!
!* 2.3 budget storage
!
-IF (LBUDGET_RC .AND. OSEDIC) &
- CALL BUDGET( PRCS(:, :, : ) * PRHODJ(:, :, : ), NBUDGET_RC, 'SEDI_BU_RRC' )
-IF (LBUDGET_RR) CALL BUDGET( PRRS(:, :, : ) * PRHODJ(:, :, : ), NBUDGET_RR, 'SEDI_BU_RRR' )
-IF (LBUDGET_RI) CALL BUDGET( PRIS(:, :, : ) * PRHODJ(:, :, : ), NBUDGET_RI, 'SEDI_BU_RRI' )
-IF (LBUDGET_RS) CALL BUDGET( PRSS(:, :, : ) * PRHODJ(:, :, : ), NBUDGET_RS, 'SEDI_BU_RRS' )
-IF (LBUDGET_RG) CALL BUDGET( PRGS(:, :, : ) * PRHODJ(:, :, : ), NBUDGET_RG, 'SEDI_BU_RRG' )
-IF ( KRR == 7 .AND. LBUDGET_RH) &
- CALL BUDGET( PRHS(:, :, : ) * PRHODJ(:, :, : ), NBUDGET_RH, 'SEDI_BU_RRH' )
+if ( lbudget_rc .and. osedic ) call Budget_store_end( tbudgets(NBUDGET_RC), 'SEDI', prcs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'SEDI', prrs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'SEDI', pris(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rs ) call Budget_store_end( tbudgets(NBUDGET_RS), 'SEDI', prss(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG), 'SEDI', prgs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rh ) call Budget_store_end( tbudgets(NBUDGET_RH), 'SEDI', prhs(:, :, :) * prhodj(:, :, :) )
!
!
!* 2.4 DROPLET DEPOSITION AT THE 1ST LEVEL ABOVE GROUND
!
IF (LDEPOSC) THEN
+ if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'DEPO', prcs(:, :, :) * prhodj(:, :, :) )
+
GDEP(:,:) = .FALSE.
GDEP(KIB:KIE,KJB:KJE) = PRCS(KIB:KIE,KJB:KJE,KKB) >0
WHERE (GDEP)
@@ -568,13 +573,10 @@ IF (LDEPOSC) THEN
PINPRC(:,:) = PINPRC(:,:) + XVDEPOSC * PRCT(:,:,KKB) * PRHODREF(:,:,KKB) /XRHOLW
PINDEP(:,:) = XVDEPOSC * PRCT(:,:,KKB) * PRHODREF(:,:,KKB) /XRHOLW
END WHERE
+
+ if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'DEPO', prcs(:, :, :) * prhodj(:, :, :) )
END IF
-!
-!* 2.5 budget storage
-!
-IF ( LBUDGET_RC .AND. LDEPOSC ) &
- CALL BUDGET( PRCS(:, :, : ) * PRHODJ(:, :, : ), NBUDGET_RC, 'DEPO_BU_RRC' )
-!
+
END SUBROUTINE RAIN_ICE_SEDIMENTATION_STAT
END MODULE MODE_RAIN_ICE_SEDIMENTATION_STAT
diff --git a/src/MNH/rain_ice_slow.f90 b/src/MNH/rain_ice_slow.f90
index 844d8301670c79c70714b7623e3b5d1909223b27..13803b25db289e5276d088bb687d8ecd23052382 100644
--- a/src/MNH/rain_ice_slow.f90
+++ b/src/MNH/rain_ice_slow.f90
@@ -1,10 +1,11 @@
-!MNH_LIC Copyright 1995-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1995-2020 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 25/02/2019: split rain_ice (cleaner and easier to maintain/debug)
+! P. Wautelet 02/2020: use the new data structures and subroutines for budgets
!-----------------------------------------------------------------
MODULE MODE_RAIN_ICE_SLOW
@@ -26,15 +27,16 @@ SUBROUTINE RAIN_ICE_SLOW(OMICRO, PINVTSTEP, PRHODREF, &
!* 0. DECLARATIONS
! ------------
!
-use MODD_BUDGET, only: LBUDGET_TH, LBUDGET_RV, LBUDGET_RC, LBUDGET_RR, LBUDGET_RI, LBUDGET_RS, LBUDGET_RG, &
- NBUDGET_TH, NBUDGET_RV, NBUDGET_RC, NBUDGET_RR, NBUDGET_RI, NBUDGET_RS, NBUDGET_RG
+use modd_budget, only: lbudget_th, lbudget_rv, lbudget_rc, lbudget_rr, lbudget_ri, lbudget_rs, lbudget_rg, &
+ NBUDGET_TH, NBUDGET_RV, NBUDGET_RC, NBUDGET_RR, NBUDGET_RI, NBUDGET_RS, NBUDGET_RG, &
+ tbudgets
use MODD_CST, only: XALPI, XBETAI, XCI, XCPV, XGAMI, XLSTT, XMNH_HUGE_12_LOG, XP00, XRV, XTT
use MODD_RAIN_ICE_DESCR, only: XCEXVT, XLBDAS_MAX, XLBEXG, XLBEXS, XLBG, XLBS, XRTMIN
use MODD_RAIN_ICE_PARAM, only: X0DEPG, X0DEPS, X1DEPG, X1DEPS, XACRIAUTI, XALPHA3, XBCRIAUTI, XBETA3, XCOLEXIS, XCRIAUTI, &
XEX0DEPG, XEX0DEPS, XEX1DEPG, XEX1DEPS, XEXIAGGS, XFIAGGS, XHON, XSCFAC, XTEXAUTI, XTIMAUTI
-!
-use MODI_BUDGET
-!
+
+use mode_budget, only: Budget_store_add
+
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
@@ -74,8 +76,10 @@ REAL, DIMENSION(:), intent(OUT) :: PLBDAG ! Slope parameter of the g
!
REAL, DIMENSION(size(PRHODREF)) :: ZZW ! Work array
REAL, DIMENSION(size(PRHODREF)) :: ZCRIAUTI ! Snow-to-ice autoconversion thres.
+real, dimension(size(plsfact)) :: zz_diff
!
!-------------------------------------------------------------------------------
+ zz_diff(:) = plsfact(:) - plvfact(:)
!
!
!* 3.2 compute the homogeneous nucleation source: RCHONI
@@ -87,18 +91,15 @@ REAL, DIMENSION(size(PRHODREF)) :: ZCRIAUTI ! Snow-to-ice autoconversion thres.
! *EXP( XALPHA3*(PZT(:)-XTT)-XBETA3 ) )
PRIS(:) = PRIS(:) + ZZW(:)
PRCS(:) = PRCS(:) - ZZW(:)
- PTHS(:) = PTHS(:) + ZZW(:)*(PLSFACT(:)-PLVFACT(:)) ! f(L_f*(RCHONI))
+ PTHS(:) = PTHS(:) + ZZW(:) * zz_diff(:) ! f(L_f*(RCHONI))
ENDWHERE
-!
- IF (LBUDGET_TH) CALL BUDGET ( &
- UNPACK(PTHS(:),MASK=OMICRO(:,:,:),FIELD=PTHS3D)*PRHODJ3D(:,:,:), &
- NBUDGET_TH,'HON_BU_RTH')
- IF (LBUDGET_RC) CALL BUDGET ( &
- UNPACK(PRCS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
- NBUDGET_RC,'HON_BU_RRC')
- IF (LBUDGET_RI) CALL BUDGET ( &
- UNPACK(PRIS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
- NBUDGET_RI,'HON_BU_RRI')
+
+ if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'HON', &
+ Unpack( zzw(:) * zz_diff(:) * prhodj(:), mask = omicro(:,:,:), field = 0.) )
+ if ( lbudget_rc ) call Budget_store_add( tbudgets(NBUDGET_RC), 'HON', &
+ Unpack( -zzw(:) * prhodj(:), mask = omicro(:,:,:), field = 0.) )
+ if ( lbudget_ri ) call Budget_store_add( tbudgets(NBUDGET_RI), 'HON', &
+ Unpack( zzw(:) * prhodj(:), mask = omicro(:,:,:), field = 0.) )
!
!* 3.3 compute the spontaneous freezing source: RRHONG
!
@@ -107,18 +108,15 @@ REAL, DIMENSION(size(PRHODREF)) :: ZCRIAUTI ! Snow-to-ice autoconversion thres.
ZZW(:) = MIN( PRRS(:),PRRT(:)* PINVTSTEP )
PRGS(:) = PRGS(:) + ZZW(:)
PRRS(:) = PRRS(:) - ZZW(:)
- PTHS(:) = PTHS(:) + ZZW(:)*(PLSFACT(:)-PLVFACT(:)) ! f(L_f*(RRHONG))
+ PTHS(:) = PTHS(:) + ZZW(:) * zz_diff(:) ! f(L_f*(RRHONG))
ENDWHERE
-!
- IF (LBUDGET_TH) CALL BUDGET ( &
- UNPACK(PTHS(:),MASK=OMICRO(:,:,:),FIELD=PTHS3D)*PRHODJ3D(:,:,:), &
- NBUDGET_TH,'SFR_BU_RTH')
- IF (LBUDGET_RR) CALL BUDGET ( &
- UNPACK(PRRS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
- NBUDGET_RR,'SFR_BU_RRR')
- IF (LBUDGET_RG) CALL BUDGET ( &
- UNPACK(PRGS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
- NBUDGET_RG,'SFR_BU_RRG')
+
+ if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'SFR', &
+ Unpack( zzw(:) * zz_diff(:) * prhodj(:), mask = omicro(:,:,:), field = 0.) )
+ if ( lbudget_rr ) call Budget_store_add( tbudgets(NBUDGET_RR), 'SFR', &
+ Unpack( -zzw(:) * prhodj(:), mask = omicro(:,:,:), field = 0.) )
+ if ( lbudget_rg ) call Budget_store_add( tbudgets(NBUDGET_RG), 'SFR', &
+ Unpack( zzw(:) * prhodj(:), mask = omicro(:,:,:), field = 0.) )
!
!* 3.4 compute the deposition, aggregation and autoconversion sources
!
@@ -142,7 +140,7 @@ REAL, DIMENSION(size(PRHODREF)) :: ZCRIAUTI ! Snow-to-ice autoconversion thres.
! ZZW(:) = MIN( PRCS(:),ZTIMAUTIC * MAX( SQRT( PRIT(:)*PRCT(:) ),0.0 ) )
! PRIS(:) = PRIS(:) + ZZW(:)
! PRCS(:) = PRCS(:) - ZZW(:)
-! PTHS(:) = PTHS(:) + ZZW(:)*(PLSFACT(:)-PLVFACT(:)) ! f(L_f*(RCAUTI))
+! PTHS(:) = PTHS(:) + ZZW(:) * zz_diff(:) ! f(L_f*(RCAUTI))
! END WHERE
!
!* 3.4.3 compute the deposition on r_s: RVDEPS
@@ -161,15 +159,13 @@ REAL, DIMENSION(size(PRHODREF)) :: ZCRIAUTI ! Snow-to-ice autoconversion thres.
PRVS(:) = PRVS(:) - ZZW(:)
PTHS(:) = PTHS(:) + ZZW(:)*PLSFACT(:)
END WHERE
- IF (LBUDGET_TH) CALL BUDGET ( &
- UNPACK(PTHS(:),MASK=OMICRO(:,:,:),FIELD=PTHS3D)*PRHODJ3D(:,:,:), &
- NBUDGET_TH,'DEPS_BU_RTH')
- IF (LBUDGET_RV) CALL BUDGET ( &
- UNPACK(PRVS(:),MASK=OMICRO(:,:,:),FIELD=PRVS3D)*PRHODJ3D(:,:,:), &
- NBUDGET_RV,'DEPS_BU_RRV')
- IF (LBUDGET_RS) CALL BUDGET ( &
- UNPACK(PRSS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
- NBUDGET_RS,'DEPS_BU_RRS')
+
+ if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'DEPS', &
+ Unpack( zzw(:) * plsfact(:) * prhodj(:), mask = omicro(:,:,:), field = 0.) )
+ if ( lbudget_rv ) call Budget_store_add( tbudgets(NBUDGET_RV), 'DEPS', &
+ Unpack( -zzw(:) * prhodj(:), mask = omicro(:,:,:), field = 0.) )
+ if ( lbudget_rs ) call Budget_store_add( tbudgets(NBUDGET_RS), 'DEPS', &
+ Unpack( zzw(:) * prhodj(:), mask = omicro(:,:,:), field = 0.) )
!
!* 3.4.4 compute the aggregation on r_s: RIAGGS
!
@@ -182,12 +178,11 @@ REAL, DIMENSION(size(PRHODREF)) :: ZCRIAUTI ! Snow-to-ice autoconversion thres.
PRSS(:) = PRSS(:) + ZZW(:)
PRIS(:) = PRIS(:) - ZZW(:)
END WHERE
- IF (LBUDGET_RI) CALL BUDGET ( &
- UNPACK(PRIS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
- NBUDGET_RI,'AGGS_BU_RRI')
- IF (LBUDGET_RS) CALL BUDGET ( &
- UNPACK(PRSS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
- NBUDGET_RS,'AGGS_BU_RRS')
+
+ if ( lbudget_ri ) call Budget_store_add( tbudgets(NBUDGET_RI), 'AGGS', &
+ Unpack( -zzw(:) * prhodj(:), mask = omicro(:,:,:), field = 0.) )
+ if ( lbudget_rs ) call Budget_store_add( tbudgets(NBUDGET_RS), 'AGGS', &
+ Unpack( zzw(:) * prhodj(:), mask = omicro(:,:,:), field = 0.) )
!
!* 3.4.5 compute the autoconversion of r_i for r_s production: RIAUTS
!
@@ -200,12 +195,11 @@ REAL, DIMENSION(size(PRHODREF)) :: ZCRIAUTI ! Snow-to-ice autoconversion thres.
PRSS(:) = PRSS(:) + ZZW(:)
PRIS(:) = PRIS(:) - ZZW(:)
END WHERE
- IF (LBUDGET_RI) CALL BUDGET ( &
- UNPACK(PRIS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
- NBUDGET_RI,'AUTS_BU_RRI')
- IF (LBUDGET_RS) CALL BUDGET ( &
- UNPACK(PRSS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
- NBUDGET_RS,'AUTS_BU_RRS')
+
+ if ( lbudget_ri ) call Budget_store_add( tbudgets(NBUDGET_RI), 'AUTS', &
+ Unpack( -zzw(:) * prhodj(:), mask = omicro(:,:,:), field = 0.) )
+ if ( lbudget_rs ) call Budget_store_add( tbudgets(NBUDGET_RS), 'AUTS', &
+ Unpack( zzw(:) * prhodj(:), mask = omicro(:,:,:), field = 0.) )
!
!* 3.4.6 compute the deposition on r_g: RVDEPG
!
@@ -223,16 +217,13 @@ REAL, DIMENSION(size(PRHODREF)) :: ZCRIAUTI ! Snow-to-ice autoconversion thres.
PRVS(:) = PRVS(:) - ZZW(:)
PTHS(:) = PTHS(:) + ZZW(:)*PLSFACT(:)
END WHERE
- IF (LBUDGET_TH) CALL BUDGET ( &
- UNPACK(PTHS(:),MASK=OMICRO(:,:,:),FIELD=PTHS3D)*PRHODJ3D(:,:,:), &
- NBUDGET_TH,'DEPG_BU_RTH')
- IF (LBUDGET_RV) CALL BUDGET ( &
- UNPACK(PRVS(:),MASK=OMICRO(:,:,:),FIELD=PRVS3D)*PRHODJ3D(:,:,:), &
- NBUDGET_RV,'DEPG_BU_RRV')
- IF (LBUDGET_RG) CALL BUDGET ( &
- UNPACK(PRGS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
- NBUDGET_RG,'DEPG_BU_RRG')
-!
+
+ if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'DEPG', &
+ Unpack( zzw(:) * plsfact(:) * prhodj(:), mask = omicro(:,:,:), field = 0.) )
+ if ( lbudget_rv ) call Budget_store_add( tbudgets(NBUDGET_RV), 'DEPG', &
+ Unpack( -zzw(:) * prhodj(:), mask = omicro(:,:,:), field = 0.) )
+ if ( lbudget_rg ) call Budget_store_add( tbudgets(NBUDGET_RG), 'DEPG', &
+ Unpack( zzw(:) * prhodj(:), mask = omicro(:,:,:), field = 0.) )
END SUBROUTINE RAIN_ICE_SLOW
END MODULE MODE_RAIN_ICE_SLOW
diff --git a/src/MNH/rain_ice_warm.f90 b/src/MNH/rain_ice_warm.f90
index 15f61b57067a485162324ead8a01ad9c22dacd48..e030d5ca7dcd74b40433b5f7626355ab3bd440a0 100644
--- a/src/MNH/rain_ice_warm.f90
+++ b/src/MNH/rain_ice_warm.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1995-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1995-2020 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.
@@ -6,6 +6,7 @@
! Modifications:
! P. Wautelet 25/02/2019: split rain_ice (cleaner and easier to maintain/debug)
! P. Wautelet 03/06/2019: remove PACK/UNPACK intrinsics (to get more performance and better OpenACC support)
+! P. Wautelet 02/2020: use the new data structures and subroutines for budgets
!-----------------------------------------------------------------
MODULE MODE_RAIN_ICE_WARM
@@ -25,17 +26,17 @@ SUBROUTINE RAIN_ICE_WARM(OMICRO, KMICRO, K1, K2, K3,
!* 0. DECLARATIONS
! ------------
!
-use MODD_BUDGET, only: LBUDGET_TH, LBUDGET_RV, LBUDGET_RC, LBUDGET_RR, &
- NBUDGET_TH, NBUDGET_RV, NBUDGET_RC, NBUDGET_RR
+use modd_budget, only: lbudget_th, lbudget_rv, lbudget_rc, lbudget_rr, &
+ NBUDGET_TH, NBUDGET_RV, NBUDGET_RC, NBUDGET_RR, &
+ tbudgets
use MODD_CST, only: XALPW, XBETAW, XCL, XCPV, XGAMW, XLVTT, XMD, XMV, XRV, XTT
use MODD_PARAM_ICE, only: CSUBG_RC_RR_ACCR, CSUBG_RR_EVAP
use MODD_RAIN_ICE_DESCR, only: XCEXVT, XRTMIN
use MODD_RAIN_ICE_PARAM, only: X0EVAR, X1EVAR, XCRIAUTC, XEX0EVAR, XEX1EVAR, XEXCACCR, XFCACCR, XTIMAUTC
-!
+
+use mode_budget, only: Budget_store_add
use MODE_MSG
-!
-use MODI_BUDGET
-!
+
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
@@ -90,23 +91,22 @@ REAL, DIMENSION(size(PRHODREF)) :: ZZW4 ! Work array
!
!* 4.2 compute the autoconversion of r_c for r_r production: RCAUTR
!
-
+ zzw(:) = 0.
WHERE( PRCS(:)>0.0 .AND. PHLC_HCF(:).GT.0.0 )
ZZW(:) = XTIMAUTC*MAX( PHLC_HRC(:)/PHLC_HCF(:) - XCRIAUTC/PRHODREF(:),0.0)
ZZW(:) = MIN( PRCS(:),PHLC_HCF(:)*ZZW(:))
PRCS(:) = PRCS(:) - ZZW(:)
PRRS(:) = PRRS(:) + ZZW(:)
END WHERE
-!
- IF (LBUDGET_RC) CALL BUDGET ( &
- UNPACK(PRCS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
- NBUDGET_RC,'AUTO_BU_RRC')
- IF (LBUDGET_RR) CALL BUDGET ( &
- UNPACK(PRRS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
- NBUDGET_RR,'AUTO_BU_RRR')
+
+ if ( lbudget_rc ) call Budget_store_add( tbudgets(NBUDGET_RC), 'AUTO', &
+ Unpack( -zzw(:) * prhodj(:), mask = omicro(:,:,:), field = 0.) )
+ if ( lbudget_rr ) call Budget_store_add( tbudgets(NBUDGET_RR), 'AUTO', &
+ Unpack( zzw(:) * prhodj(:), mask = omicro(:,:,:), field = 0.) )
!
!* 4.3 compute the accretion of r_c for r_r production: RCACCR
!
+ zzw(:) = 0.
IF (CSUBG_RC_RR_ACCR=='NONE') THEN
!CLoud water and rain are diluted over the grid box
WHERE( PRCT(:)>XRTMIN(2) .AND. PRRT(:)>XRTMIN(3) .AND. PRCS(:)>0.0 )
@@ -125,7 +125,6 @@ REAL, DIMENSION(size(PRHODREF)) :: ZZW4 ! Work array
! if PRF<PCF (rain is entirely falling in cloud): PRF-PHLC_HCF
! if PRF>PCF (rain is falling in cloud and in clear sky): PCF-PHLC_HCF
! => min(PCF, PRF)-PHLC_HCF
- ZZW(:) = 0.
WHERE( PHLC_HRC(:)>XRTMIN(2) .AND. PRRT(:)>XRTMIN(3) .AND. PRCS(:)>0.0 &
.AND. PHLC_HCF(:)>0 )
!Accretion due to rain falling in high cloud content
@@ -147,17 +146,13 @@ REAL, DIMENSION(size(PRHODREF)) :: ZZW4 ! Work array
PRRS(:) = PRRS(:) + ZZW(:)
ELSE
- !wrong CSUBG_RC_RR_ACCR case
- WRITE(*,*) 'wrong CSUBG_RC_RR_ACCR case'
- CALL PRINT_MSG(NVERB_FATAL,'GEN','RAIN_ICE_WARM','')
+ call Print_msg( NVERB_FATAL, 'GEN', 'RAIN_ICE_WARM', 'invalid CSUBG_RC_RR_ACCR value: '//Trim(csubg_rc_rr_accr) )
ENDIF
- IF (LBUDGET_RC) CALL BUDGET ( &
- UNPACK(PRCS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
- NBUDGET_RC,'ACCR_BU_RRC')
- IF (LBUDGET_RR) CALL BUDGET ( &
- UNPACK(PRRS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
- NBUDGET_RR,'ACCR_BU_RRR')
+ if ( lbudget_rc ) call Budget_store_add( tbudgets(NBUDGET_RC), 'ACCR', &
+ Unpack( -zzw(:) * prhodj(:), mask = omicro(:,:,:), field = 0.) )
+ if ( lbudget_rr ) call Budget_store_add( tbudgets(NBUDGET_RR), 'ACCR', &
+ Unpack( zzw(:) * prhodj(:), mask = omicro(:,:,:), field = 0.) )
!
!* 4.4 compute the evaporation of r_r: RREVAV
!
@@ -224,20 +219,15 @@ REAL, DIMENSION(size(PRHODREF)) :: ZZW4 ! Work array
END WHERE
ELSE
- !wrong CSUBG_RR_EVAP case
- WRITE(*,*) 'wrong CSUBG_RR_EVAP case'
- CALL PRINT_MSG(NVERB_FATAL,'GEN','RAIN_ICE_WARM','')
+ call Print_msg( NVERB_FATAL, 'GEN', 'RAIN_ICE_WARM', 'invalid CSUBG_RR_EVAP value: '//Trim( csubg_rr_evap ) )
END IF
- IF (LBUDGET_TH) CALL BUDGET ( &
- UNPACK(PTHS(:),MASK=OMICRO(:,:,:),FIELD=PTHS3D)*PRHODJ3D(:,:,:), &
- NBUDGET_TH,'REVA_BU_RTH')
- IF (LBUDGET_RV) CALL BUDGET ( &
- UNPACK(PRVS(:),MASK=OMICRO(:,:,:),FIELD=PRVS3D)*PRHODJ3D(:,:,:), &
- NBUDGET_RV,'REVA_BU_RRV')
- IF (LBUDGET_RR) CALL BUDGET ( &
- UNPACK(PRRS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
- NBUDGET_RR,'REVA_BU_RRR')
+ if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'REVA', &
+ Unpack( -zzw(:) * plvfact(:) * prhodj(:), mask = omicro(:,:,:), field = 0.) )
+ if ( lbudget_rv ) call Budget_store_add( tbudgets(NBUDGET_RV), 'REVA', &
+ Unpack( zzw(:) * prhodj(:), mask = omicro(:,:,:), field = 0.) )
+ if ( lbudget_rr ) call Budget_store_add( tbudgets(NBUDGET_RR), 'REVA', &
+ Unpack( -zzw(:) * prhodj(:), mask = omicro(:,:,:), field = 0.) )
DO JL = 1, KMICRO
PEVAP3D(K1(JL), K2(JL), K3(JL)) = ZZW( JL )
diff --git a/src/MNH/rel_forcingn.f90 b/src/MNH/rel_forcingn.f90
index e9c05ea10b1a13d97eed562531ce3e1cac1b9c59..47c25af9c5f31c2f4108e0c0c23d228fe6426995 100644
--- a/src/MNH/rel_forcingn.f90
+++ b/src/MNH/rel_forcingn.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 2010-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2010-2020 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.
@@ -94,7 +94,7 @@ END MODULE MODI_REL_FORCING_n
!! 28/03/2018 P. Wautelet: replace TEMPORAL_DIST by DATETIME_DISTANCE
!! use overloaded comparison operator for date_time
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
-!!
+! P. Wautelet 02/2020: use the new data structures and subroutines for budgets
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -108,9 +108,9 @@ USE MODD_PARAMETERS
USE MODD_RELFRC_n ! Modules for time evolving advfrc
USE MODD_TIME
!
+use mode_budget, only: Budget_store_init, Budget_store_end
USE MODE_DATETIME
!
-USE MODI_BUDGET
USE MODI_SHUMAN
!
IMPLICIT NONE
@@ -147,10 +147,13 @@ INTEGER :: IKU
!----------------------------------------------------------------------------
!
-IKU = SIZE(PTHM,3)
!* 1. PREPARATION OF FORCING
! ----------------------
-!
+
+if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), '2DREL', prths(:, :, :) )
+if ( lbudget_rv ) call Budget_store_init( tbudgets(NBUDGET_TH), '2DREL', prrs (:, :, :, 1) )
+
+IKU = SIZE(PTHM,3)
IF (GSFIRSTCALL) THEN
!
@@ -249,8 +252,9 @@ END IF
!
!* 3. BUDGET CALLS
! ------------
-IF (LBUDGET_TH) CALL BUDGET (PRTHS,NBUDGET_TH,'2DREL_BU_RTH')
-IF (LBUDGET_RV) CALL BUDGET (PRRS(:,:,:,1),NBUDGET_RV,'2DREL_BU_RRV')
+if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), '2DREL', prths(:, :, :) )
+if ( lbudget_rv ) call Budget_store_end( tbudgets(NBUDGET_TH), '2DREL', prrs (:, :, :, 1) )
+
!----------------------------------------------------------------------------
!
END SUBROUTINE REL_FORCING_n
diff --git a/src/MNH/relax2fw_ion.f90 b/src/MNH/relax2fw_ion.f90
index cae86dedffd855da3c36911bbe488fe8578bc611..df2dafc7e90590c71bbf5826dd86f2bd12350744 100644
--- a/src/MNH/relax2fw_ion.f90
+++ b/src/MNH/relax2fw_ion.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 2010-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2010-2020 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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! ########################
@@ -96,24 +96,23 @@ END MODULE MODI_RELAX2FW_ION
!! -------------
!! C.Lac, 07/11 : Avoid the horizontal relaxation if not father model
!! C.Lac, 11/11 : Adaptation to FIT temporal scheme
-!!
-!!
+! P. Wautelet 02/2020: use the new data structures and subroutines for budgets
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-use modd_budget, only: lbudget_sv, NBUDGET_SV1
+use modd_budget, only: lbudget_sv, NBUDGET_SV1, tbudgets
USE MODD_CONF
USE MODD_ELEC_n, ONLY: XCION_POS_FW, XCION_NEG_FW
USE MODD_NSV, ONLY: NSV_ELECBEG, NSV_ELECEND
USE MODD_PARAMETERS
-!
+
+use mode_budget, only: Budget_store_init, Budget_store_end
USE MODE_ll
-!
-USE MODI_BUDGET
+
USE MODI_SHUMAN
-!
+
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
@@ -155,6 +154,12 @@ REAL, DIMENSION(SIZE(PSVM,1),SIZE(PSVM,2)) :: ZKH
!
!* 1. PRELIMINARIES
! -------------
+
+if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg), 'REL', prsvs(:, :, :, nsv_elecbeg) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecend), 'REL', prsvs(:, :, :, nsv_elecend) )
+end if
+
IKU = SIZE(PSVM,3)
IKE = IKU - JPVEXT
CALL GET_INDICE_ll(IIB,IJB,IIE,IJE)
@@ -212,11 +217,10 @@ END IF
!* 4. STORES FIELDS IN BUDGET ARRAYS
! ------------------------------
!
-IF (LBUDGET_SV) THEN
- CALL BUDGET( PRSVS(:, :, :, NSV_ELECBEG ), NBUDGET_SV1 - 1 + NSV_ELECBEG, 'REL_BU_RSV' )
- CALL BUDGET( PRSVS(:, :, :, NSV_ELECEND ), NBUDGET_SV1 - 1 + NSV_ELECEND, 'REL_BU_RSV' )
-END IF
-!
+if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg), 'REL', prsvs(:, :, :, nsv_elecbeg) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecend), 'REL', prsvs(:, :, :, nsv_elecend) )
+end if
!
!-------------------------------------------------------------------------------
!
diff --git a/src/MNH/relaxation.f90 b/src/MNH/relaxation.f90
index e6c57710c2b221ad42ff3894ee050071cd1d4757..b75529537a2040f901f9c6f75bb0cdae7a1b3d91 100644
--- a/src/MNH/relaxation.f90
+++ b/src/MNH/relaxation.f90
@@ -256,7 +256,7 @@ END MODULE MODI_RELAXATION
!! 06/2011 (M.Chong) Case of ELEC
!! 11/2011 (C.Lac) Adaptation to FIT temporal scheme
!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
-! P. Wautelet 28/01/2020: use the new data structures and subroutines for budgets for U
+! P. Wautelet 02/2020: use the new data structures and subroutines for budgets
!
!-------------------------------------------------------------------------------
!
@@ -278,7 +278,6 @@ USE MODE_EXTRAPOL, only: Extrapol
USE MODE_ll, only: Get_intersection_ll
USE MODE_MPPDB
-USE MODI_BUDGET
USE MODI_SHUMAN
IMPLICIT NONE
@@ -424,6 +423,7 @@ REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZKHU,ZKHV,ZKHW, &
! averages along x,y,z of the PRHODJ field
ZWORK
! work array used to expand the LB fields
+logical :: grelax_uvwth
LOGICAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: GMASK3D_RELAX ! 3D
! mask for hor. relax.
LOGICAL, DIMENSION(7) :: GHORELAXR ! local array of logical
@@ -444,8 +444,26 @@ CALL GET_INDICE_ll(IIB,IJB,IIE,IJE)
CALL GET_GLOBALDIMS_ll(IIU_ll,IJU_ll)
IIU_ll=IIU_ll+2*JPHEXT
IJU_ll=IJU_ll+2*JPHEXT
-!
-if ( lbudget_u ) call Budget_store_init( tbudgets(NBUDGET_U), 'REL', prus )
+
+grelax_uvwth = ohorelax_uvwth .or. ove_relax .or. ove_relax_grd
+
+if ( lbudget_u .and. grelax_uvwth ) call Budget_store_init( tbudgets(NBUDGET_U ), 'REL', prus (:, :, :) )
+if ( lbudget_v .and. grelax_uvwth ) call Budget_store_init( tbudgets(NBUDGET_V ), 'REL', prvs (:, :, :) )
+if ( lbudget_w .and. grelax_uvwth ) call Budget_store_init( tbudgets(NBUDGET_W ), 'REL', prws (:, :, :) )
+if ( lbudget_th .and. grelax_uvwth ) call Budget_store_init( tbudgets(NBUDGET_TH ), 'REL', prths (:, :, :) )
+if ( lbudget_tke .and. ohorelax_tke ) call Budget_store_init( tbudgets(NBUDGET_TKE), 'REL', prtkes(:, :, :) )
+if ( lbudget_rv .and. ohorelax_rv ) call Budget_store_init( tbudgets(NBUDGET_RV ), 'REL', prrs (:, :, :, 1) )
+if ( lbudget_rc .and. ohorelax_rc ) call Budget_store_init( tbudgets(NBUDGET_RC ), 'REL', prrs (:, :, :, 2) )
+if ( lbudget_rr .and. ohorelax_rr ) call Budget_store_init( tbudgets(NBUDGET_RR ), 'REL', prrs (:, :, :, 3) )
+if ( lbudget_ri .and. ohorelax_ri ) call Budget_store_init( tbudgets(NBUDGET_RI ), 'REL', prrs (:, :, :, 4) )
+if ( lbudget_rs .and. ohorelax_rs ) call Budget_store_init( tbudgets(NBUDGET_RS ), 'REL', prrs (:, :, :, 5) )
+if ( lbudget_rg .and. ohorelax_rg ) call Budget_store_init( tbudgets(NBUDGET_RG ), 'REL', prrs (:, :, :, 6) )
+if ( lbudget_rh .and. ohorelax_rh ) call Budget_store_init( tbudgets(NBUDGET_RH ), 'REL', prrs (:, :, :, 7) )
+if ( lbudget_sv ) then
+ do jsv = 1, ksv
+ if ( ohorelax_sv( jsv ) ) call Budget_store_init( tbudgets(jsv + NBUDGET_SV1 - 1), 'REL', prsvs(:, :, :, jsv) )
+ end do
+end if
ZRHODJU(:,:,:) = MXM(PRHODJ)
ZRHODJV(:,:,:) = MYM(PRHODJ)
@@ -714,25 +732,25 @@ END DO
!
CALL EXTRAPOL('W ', PRUS)
-if ( lbudget_u ) call Budget_store_end( tbudgets(NBUDGET_U), 'REL', prus )
+if ( lbudget_u .and. grelax_uvwth ) call Budget_store_end( tbudgets(NBUDGET_U ), 'REL', prus (:, :, :) )
+if ( lbudget_v .and. grelax_uvwth ) call Budget_store_end( tbudgets(NBUDGET_V ), 'REL', prvs (:, :, :) )
+if ( lbudget_w .and. grelax_uvwth ) call Budget_store_end( tbudgets(NBUDGET_W ), 'REL', prws (:, :, :) )
+if ( lbudget_th .and. grelax_uvwth ) call Budget_store_end( tbudgets(NBUDGET_TH ), 'REL', prths (:, :, :) )
+if ( lbudget_tke .and. ohorelax_tke ) call Budget_store_end( tbudgets(NBUDGET_TKE), 'REL', prtkes(:, :, :) )
+if ( lbudget_rv .and. ohorelax_rv ) call Budget_store_end( tbudgets(NBUDGET_RV ), 'REL', prrs (:, :, :, 1) )
+if ( lbudget_rc .and. ohorelax_rc ) call Budget_store_end( tbudgets(NBUDGET_RC ), 'REL', prrs (:, :, :, 2) )
+if ( lbudget_rr .and. ohorelax_rr ) call Budget_store_end( tbudgets(NBUDGET_RR ), 'REL', prrs (:, :, :, 3) )
+if ( lbudget_ri .and. ohorelax_ri ) call Budget_store_end( tbudgets(NBUDGET_RI ), 'REL', prrs (:, :, :, 4) )
+if ( lbudget_rs .and. ohorelax_rs ) call Budget_store_end( tbudgets(NBUDGET_RS ), 'REL', prrs (:, :, :, 5) )
+if ( lbudget_rg .and. ohorelax_rg ) call Budget_store_end( tbudgets(NBUDGET_RG ), 'REL', prrs (:, :, :, 6) )
+if ( lbudget_rh .and. ohorelax_rh ) call Budget_store_end( tbudgets(NBUDGET_RH ), 'REL', prrs (:, :, :, 7) )
+if ( lbudget_sv ) then
+ do jsv = 1, ksv
+ if ( ohorelax_sv( jsv ) ) call Budget_store_end( tbudgets(jsv + NBUDGET_SV1 - 1), 'REL', prsvs(:, :, :, jsv) )
+ end do
+end if
+
-IF ( LBUDGET_V ) CALL BUDGET( PRVS, NBUDGET_V, 'REL_BU_RV')
-IF ( LBUDGET_W ) CALL BUDGET( PRWS, NBUDGET_W, 'REL_BU_RW')
-IF ( LBUDGET_TH ) CALL BUDGET( PRTHS, NBUDGET_TH, 'REL_BU_RTH')
-IF ( LBUDGET_TKE ) CALL BUDGET( PRTKES, NBUDGET_TKE, 'REL_BU_RTKE')
-IF ( LBUDGET_RV ) CALL BUDGET( PRRS(:, :, :, 1 ), NBUDGET_RV, 'REL_BU_RRV')
-IF ( LBUDGET_RC ) CALL BUDGET( PRRS(:, :, :, 2 ), NBUDGET_RC, 'REL_BU_RRC')
-IF ( LBUDGET_RR ) CALL BUDGET( PRRS(:, :, :, 3 ), NBUDGET_RR, 'REL_BU_RRR')
-IF ( LBUDGET_RI ) CALL BUDGET( PRRS(:, :, :, 4 ), NBUDGET_RI, 'REL_BU_RRI')
-IF ( LBUDGET_RS ) CALL BUDGET( PRRS(:, :, :, 5 ), NBUDGET_RS, 'REL_BU_RRS')
-IF ( LBUDGET_RG ) CALL BUDGET( PRRS(:, :, :, 6 ), NBUDGET_RG, 'REL_BU_RRG')
-IF ( LBUDGET_RH ) CALL BUDGET( PRRS(:, :, :, 7 ), NBUDGET_RH, 'REL_BU_RRH')
-IF ( LBUDGET_SV ) THEN
- DO JSV=1,KSV
- CALL BUDGET( PRSVS(:, :, :, JSV ), NBUDGET_SV1 - 1 + JSV, 'REL_BU_RSV' )
- END DO
-END IF
-!
CONTAINS
! ######################################
SUBROUTINE EXPAND_LB (PLBX,PLBY,PWORK)
diff --git a/src/MNH/resolved_cloud.f90 b/src/MNH/resolved_cloud.f90
index f0257f5f08430f7651d2051edae09ad6c0440a1c..7f920b09eb3faf6e3266ebf57719c44a01e4667e 100644
--- a/src/MNH/resolved_cloud.f90
+++ b/src/MNH/resolved_cloud.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2020 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.
@@ -264,17 +264,19 @@ END MODULE MODI_RESOLVED_CLOUD
!! 10/2016 (C.Lac) Add droplet deposition
!! S.Riette : 11/2016 : ice_adjust before and after rain_ice
!! ICE3/ICE4 modified, old version under LRED=F
-!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
-!! P. Wautelet: 01/02/2019: ZRSMIN is now allocatable (instead of size of XRTMIN which was sometimes not allocated)
-!! 02/2019 C.Lac add rain fraction as an output field
+! P. Wautelet 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet 01/02/2019: ZRSMIN is now allocatable (instead of size of XRTMIN which was sometimes not allocated)
+! C. Lac 02/2019: add rain fraction as an output field
+! P. Wautelet 02/2020: use the new data structures and subroutines for budgets
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
-USE MODD_BUDGET, ONLY: LBUDGET_TH, LBUDGET_RV, LBUDGET_RC, LBUDGET_RR, LBUDGET_RI, LBUDGET_RS, LBUDGET_RG, LBUDGET_RH, &
- LBUDGET_SV, &
+use modd_budget, only: lbudget_th, lbudget_rv, lbudget_rc, lbudget_rr, lbudget_ri, lbudget_rs, lbudget_rg, lbudget_rh, &
+ lbudget_sv, &
NBUDGET_TH, NBUDGET_RV, NBUDGET_RC, NBUDGET_RR, NBUDGET_RI, NBUDGET_RS, NBUDGET_RG, NBUDGET_RH, &
- NBUDGET_SV1
+ NBUDGET_SV1, &
+ tbudgets
USE MODD_CH_AEROSOL, ONLY: LORILAM
USE MODD_DUST, ONLY: LDUST
USE MODD_CST, ONLY: XCI, XCL, XCPD, XCPV, XLSTT, XLVTT, XMNH_TINY, XP00, XRD, XRHOLW, XTT
@@ -291,9 +293,9 @@ USE MODD_PARAM_LIMA, ONLY: LCOLD, XCONC_CCN_TOT, NMOD_CCN, NMOD_IFN, NMOD_IM
USE MODD_RAIN_ICE_DESCR, ONLY: XRTMIN
USE MODD_SALT, ONLY: LSALT
!
+use mode_budget, only: Budget_store_init, Budget_store_end
USE MODE_ll
!
-USE MODI_BUDGET
USE MODI_C2R2_ADJUST
USE MODI_C3R5_ADJUST
USE MODI_FAST_TERMS
@@ -506,6 +508,37 @@ IF (HCLOUD(1:3)=='ICE' .AND. LRED) THEN
ALLOCATE(ZRSMIN(SIZE(XRTMIN)))
ZRSMIN(:) = XRTMIN(:) / PTSTEP
END IF
+if ( hcloud /= 'KHKO' .and. hcloud /= 'C2R2' ) then
+ if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'NEGA', pths(:, :, :) )
+ if ( lbudget_rv ) call Budget_store_init( tbudgets(NBUDGET_RV), 'NEGA', prs (:, :, :, 1) )
+ if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'NEGA', prs (:, :, :, 2) )
+! else
+! if ( .not. ( hactccn == 'ABRK' .and. ( lorilam .or. ldust .or. lsalt ) ) .and. (.not. lsupsat) ) then
+! if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'HENU', pths(:, :, :) )
+! end if
+end if
+if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'NEGA', prs(:, :, :, 3) )
+if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'NEGA', prs(:, :, :, 4) )
+if ( lbudget_rs ) call Budget_store_init( tbudgets(NBUDGET_RS), 'NEGA', prs(:, :, :, 5) )
+if ( lbudget_rg ) call Budget_store_init( tbudgets(NBUDGET_RG), 'NEGA', prs(:, :, :, 6) )
+if ( lbudget_rh ) call Budget_store_init( tbudgets(NBUDGET_RH), 'NEGA', prs(:, :, :, 7) )
+if ( lbudget_sv .and. hcloud == 'LIMA' ) then
+ if ( owarm ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'NEGA', zsvs(:, :, :, nsv_lima_nc) )
+ end if
+ if ( owarm .and. orain ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'NEGA', zsvs(:, :, :, nsv_lima_nr) )
+ end if
+ if ( lcold ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'NEGA', zsvs(:, :, :, nsv_lima_ni) )
+ end if
+ do jl = nsv_lima_ccn_free, nsv_lima_ccn_free + nmod_ccn - 1
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + jl), 'NEGA', zsvs(:, :, :, jl) )
+ end do
+ do jl = nsv_lima_ifn_free, nsv_lima_ifn_free + nmod_ifn - 1
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + jl), 'NEGA', zsvs(:, :, :, jl) )
+ end do
+end if
!
!* 2. TRANSFORMATION INTO PHYSICAL TENDENCIES
! ---------------------------------------
@@ -765,35 +798,34 @@ END SELECT
!* 3.3 STORE THE BUDGET TERMS
! ----------------------
!
-IF ((HCLOUD /= 'KHKO') .AND. (HCLOUD /= 'C2R2') ) THEN
- IF (LBUDGET_TH) CALL BUDGET (PTHS(:,:,:) * PRHODJ(:,:,:), NBUDGET_TH,'NEGA_BU_RTH')
- IF (LBUDGET_RV) CALL BUDGET (PRS(:,:,:,1) * PRHODJ(:,:,:), NBUDGET_RV,'NEGA_BU_RRV')
- IF (LBUDGET_RC) CALL BUDGET (PRS(:,:,:,2) * PRHODJ(:,:,:), NBUDGET_RC,'NEGA_BU_RRC')
-END IF
-IF (LBUDGET_RR) CALL BUDGET (PRS(:,:,:,3) * PRHODJ(:,:,:), NBUDGET_RR,'NEGA_BU_RRR')
-IF (LBUDGET_RI) CALL BUDGET (PRS(:,:,:,4) * PRHODJ(:,:,:), NBUDGET_RI,'NEGA_BU_RRI')
-IF (LBUDGET_RS) CALL BUDGET (PRS(:,:,:,5) * PRHODJ(:,:,:), NBUDGET_RS,'NEGA_BU_RRS')
-IF (LBUDGET_RG) CALL BUDGET (PRS(:,:,:,6) * PRHODJ(:,:,:), NBUDGET_RG,'NEGA_BU_RRG')
-IF (LBUDGET_RH) CALL BUDGET (PRS(:,:,:,7) * PRHODJ(:,:,:), NBUDGET_RH,'NEGA_BU_RRH')
-IF (LBUDGET_SV .AND. (HCLOUD == 'LIMA')) THEN
- IF (OWARM) CALL BUDGET (ZSVS(:,:,:,NSV_LIMA_NC) * PRHODJ(:,:,:),NBUDGET_SV1-1+NSV_LIMA_NC,'NEGA_BU_RSV')
- IF (OWARM.AND.ORAIN) CALL BUDGET (ZSVS(:,:,:,NSV_LIMA_NR) * PRHODJ(:,:,:),NBUDGET_SV1-1+NSV_LIMA_NR,'NEGA_BU_RSV')
- IF (LCOLD) CALL BUDGET (ZSVS(:,:,:,NSV_LIMA_NI) * PRHODJ(:,:,:),NBUDGET_SV1-1+NSV_LIMA_NI,'NEGA_BU_RSV')
- IF (NMOD_CCN.GE.1) THEN
- DO JL=1, NMOD_CCN
- CALL BUDGET ( ZSVS(:,:,:,NSV_LIMA_CCN_FREE+JL-1)* &
- PRHODJ(:,:,:),NBUDGET_SV1-1+NSV_LIMA_CCN_FREE+JL-1,'NEGA_BU_RSV')
- END DO
- END IF
- IF (NMOD_IFN.GE.1) THEN
- DO JL=1, NMOD_IFN
- CALL BUDGET ( ZSVS(:,:,:,NSV_LIMA_IFN_FREE+JL-1)* &
- PRHODJ(:,:,:),NBUDGET_SV1-1+NSV_LIMA_IFN_FREE+JL-1,'NEGA_BU_RSV')
- END DO
- END IF
-END IF
+if ( hcloud /= 'KHKO' .and. hcloud /= 'C2R2' ) then
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'NEGA', pths(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rv ) call Budget_store_end( tbudgets(NBUDGET_RV), 'NEGA', prs (:, :, :, 1) * prhodj(:, :, :) )
+ if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'NEGA', prs (:, :, :, 2) * prhodj(:, :, :) )
+end if
+if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'NEGA', prs(:, :, :, 3) * prhodj(:, :, :) )
+if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'NEGA', prs(:, :, :, 4) * prhodj(:, :, :) )
+if ( lbudget_rs ) call Budget_store_end( tbudgets(NBUDGET_RS), 'NEGA', prs(:, :, :, 5) * prhodj(:, :, :) )
+if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG), 'NEGA', prs(:, :, :, 6) * prhodj(:, :, :) )
+if ( lbudget_rh ) call Budget_store_end( tbudgets(NBUDGET_RH), 'NEGA', prs(:, :, :, 7) * prhodj(:, :, :) )
+if ( lbudget_sv .and. hcloud == 'LIMA' ) then
+ if ( owarm ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'NEGA', zsvs(:, :, :, nsv_lima_nc) * prhodj(:, :, :) )
+ end if
+ if ( owarm .and. orain ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'NEGA', zsvs(:, :, :, nsv_lima_nr) * prhodj(:, :, :) )
+ end if
+ if ( lcold ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'NEGA', zsvs(:, :, :, nsv_lima_ni) * prhodj(:, :, :) )
+ end if
+ do jl = nsv_lima_ccn_free, nsv_lima_ccn_free + nmod_ccn - 1
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + jl), 'NEGA', zsvs(:, :, :, jl) * prhodj(:, :, :) )
+ end do
+ do jl = nsv_lima_ifn_free, nsv_lima_ifn_free + nmod_ifn - 1
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + jl), 'NEGA', zsvs(:, :, :, jl) * prhodj(:, :, :) )
+ end do
+end if
!
-
!* 3.4 Limitations of Na and Nc to the CCN max number concentration
!
! Commented by O.Thouron 03/2013
@@ -956,7 +988,7 @@ SELECT CASE ( HCLOUD )
!
!
IF (.NOT. LRED .OR. (LRED .AND. LADJ_AFTER) ) THEN
- CALL ICE_ADJUST (1,IKU,1, KRR, CFRAC_ICE_ADJUST, 'DEPI', &
+ CALL ICE_ADJUST (1,IKU,1, KRR, CFRAC_ICE_ADJUST, 'CDEPI', &
OSUBG_COND, OSIGMAS, PTSTEP,PSIGQSAT, &
PRHODJ, PEXNREF, PSIGS, PMFCONV, PPABST, ZZZ, &
ZEXN, PCF_MF,PRC_MF,PRI_MF, &
@@ -1041,7 +1073,7 @@ SELECT CASE ( HCLOUD )
!* 10.2 Perform the saturation adjustment over cloud ice and cloud water
!
IF (.NOT. LRED .OR. (LRED .AND. LADJ_AFTER) ) THEN
- CALL ICE_ADJUST (1,IKU,1, KRR, CFRAC_ICE_ADJUST, 'DEPI', &
+ CALL ICE_ADJUST (1,IKU,1, KRR, CFRAC_ICE_ADJUST, 'CDEPI', &
OSUBG_COND, OSIGMAS, PTSTEP,PSIGQSAT, &
PRHODJ, PEXNREF, PSIGS, PMFCONV, PPABST, ZZZ, &
ZEXN, PCF_MF,PRC_MF,PRI_MF, &
@@ -1140,6 +1172,9 @@ IF(HCLOUD=='ICE3' .OR. HCLOUD=='ICE4' ) THEN
ENDIF
!
IF ( (HCLOUD == 'KHKO') .OR. (HCLOUD == 'C2R2') ) THEN
+ if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'NECON', pths(:, :, :) )
+ if ( lbudget_rv ) call Budget_store_init( tbudgets(NBUDGET_RV), 'NECON', prs (:, :, :, 1) )
+ if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'NECON', prs (:, :, :, 2) )
! CALL GET_HALO(PRS(:,:,:,2))
! CALL GET_HALO(ZSVS(:,:,:,2))
! CALL GET_HALO(ZSVS(:,:,:,3))
@@ -1155,9 +1190,6 @@ IF ( (HCLOUD == 'KHKO') .OR. (HCLOUD == 'C2R2') ) THEN
ZSVS(:,:,:,JSV) = 0.0
END WHERE
ENDDO
- IF (LBUDGET_TH) CALL BUDGET (PTHS(:,:,:) * PRHODJ(:,:,:), NBUDGET_TH,'NECON_BU_RTH')
- IF (LBUDGET_RV) CALL BUDGET (PRS(:,:,:,1) * PRHODJ(:,:,:), NBUDGET_RV,'NECON_BU_RRV')
- IF (LBUDGET_RC) CALL BUDGET (PRS(:,:,:,2) * PRHODJ(:,:,:), NBUDGET_RC,'NECON_BU_RRC')
END IF
!-------------------------------------------------------------------------------
!
@@ -1181,6 +1213,12 @@ IF (HCLOUD=='C2R2' .OR. HCLOUD=='C3R5' .OR. HCLOUD=='KHKO' .OR. HCLOUD=='LIMA')
DEALLOCATE(ZSVS)
DEALLOCATE(ZSVT)
ENDIF
+
+IF ( (HCLOUD == 'KHKO') .OR. (HCLOUD == 'C2R2') ) THEN
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'NECON', pths(:, :, :) )
+ if ( lbudget_rv ) call Budget_store_end( tbudgets(NBUDGET_RV), 'NECON', prs (:, :, :, 1) )
+ if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'NECON', prs (:, :, :, 2) )
+END IF
!
!-------------------------------------------------------------------------------
!
diff --git a/src/MNH/resolved_elecn.f90 b/src/MNH/resolved_elecn.f90
index 535a783271b01d0fc10c22348684a1f1092b447d..a19e05f5c7fd3cb17481c7d72f9e0c5e126c0d40 100644
--- a/src/MNH/resolved_elecn.f90
+++ b/src/MNH/resolved_elecn.f90
@@ -177,12 +177,18 @@ END MODULE MODI_RESOLVED_ELEC_n
!* 0. DECLARATIONS
! ------------
!
+use mode_budget, only: Budget_store_init, Budget_store_end
USE MODE_ELEC_ll
USE MODE_IO_FILE, ONLY: IO_File_close, IO_File_open
USE MODE_IO_MANAGE_STRUCT, ONLY: IO_File_add2list, IO_File_find_byname
USE MODE_ll
!
-USE MODD_METRICS_n, ONLY : XDXX, XDYY, XDZX, XDZY, XDZZ
+use modd_budget, only: lbudget_th, lbudget_rv, lbudget_rc, lbudget_rr, lbudget_ri, lbudget_rs, lbudget_rg, lbudget_rh, &
+ lbudget_sv, &
+ NBUDGET_TH, NBUDGET_RV, NBUDGET_RC, NBUDGET_RR, NBUDGET_RI, NBUDGET_RS, NBUDGET_RG, NBUDGET_RH, &
+ NBUDGET_SV1, &
+ tbudgets
+USE MODD_METRICS_n, ONLY : XDXX, XDYY, XDZX, XDZY, XDZZ
USE MODD_FIELD_n, ONLY : XRSVS
USE MODD_CONF, ONLY : L1D, L2D, CEXP
USE MODD_CST
@@ -190,7 +196,6 @@ USE MODD_IO, ONLY: TFILEDATA, TFILE_DUMMY
USE MODD_PARAMETERS, ONLY : JPVEXT
USE MODD_ELEC_DESCR
USE MODD_ELEC_n
-USE MODD_BUDGET
USE MODD_NSV
USE MODD_CH_MNHC_n, ONLY: LUSECHEM,LCH_CONV_LINOX
USE MODD_DYN_n, ONLY: NSTOP, XTSTEP
@@ -205,7 +210,6 @@ USE MODI_ICE_ADJUST_ELEC
USE MODI_TO_ELEC_FIELD_n
USE MODI_FLASH_GEOM_ELEC_n
USE MODI_SHUMAN
-USE MODI_BUDGET
USE MODI_ION_ATTACH_ELEC
USE MODD_ARGSLIST_ll, ONLY : LIST_ll
!
@@ -373,6 +377,19 @@ IKB = 1 + JPVEXT
IKE = SIZE(PZZ,3) - JPVEXT
IKU = SIZE(PZZ,3)
!
+if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'NEGA', pths(:, :, :) )
+if ( lbudget_rv ) call Budget_store_init( tbudgets(NBUDGET_RV), 'NEGA', prs (:, :, :, 1) )
+if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'NEGA', prs (:, :, :, 2) )
+if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'NEGA', prs (:, :, :, 3) )
+if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'NEGA', prs (:, :, :, 4) )
+if ( lbudget_rs ) call Budget_store_init( tbudgets(NBUDGET_RS), 'NEGA', prs (:, :, :, 5) )
+if ( lbudget_rg ) call Budget_store_init( tbudgets(NBUDGET_RG), 'NEGA', prs (:, :, :, 6) )
+if ( lbudget_rh ) call Budget_store_init( tbudgets(NBUDGET_RH), 'NEGA', prs (:, :, :, 7) )
+if ( lbudget_sv ) then
+ do jsv = nsv_elecbeg, nsv_elecend
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + jsv), 'NEGA', psvs(:, :, :, jsv) )
+ end do
+end if
!
!------------------------------------------------------------------------------
!
@@ -612,21 +629,19 @@ END DO
!
!* 3.4 store the budget terms
!
-IF (LBUDGET_RV) CALL BUDGET (PRS(:,:,:,1) * PRHODJ(:,:,:), NBUDGET_RV, 'NEGA_BU_RRV')
-IF (LBUDGET_RC) CALL BUDGET (PRS(:,:,:,2) * PRHODJ(:,:,:), NBUDGET_RC, 'NEGA_BU_RRC')
-IF (LBUDGET_RR) CALL BUDGET (PRS(:,:,:,3) * PRHODJ(:,:,:), NBUDGET_RR, 'NEGA_BU_RRR')
-IF (LBUDGET_RI) CALL BUDGET (PRS(:,:,:,4) * PRHODJ(:,:,:) ,NBUDGET_RI, 'NEGA_BU_RRI')
-IF (LBUDGET_RS) CALL BUDGET (PRS(:,:,:,5) * PRHODJ(:,:,:), NBUDGET_RS, 'NEGA_BU_RRS')
-IF (LBUDGET_RG) CALL BUDGET (PRS(:,:,:,6) * PRHODJ(:,:,:), NBUDGET_RG, 'NEGA_BU_RRG')
-IF (LBUDGET_RH) CALL BUDGET (PRS(:,:,:,7) * PRHODJ(:,:,:), NBUDGET_RH, 'NEGA_BU_RRH')
-IF (LBUDGET_TH) CALL BUDGET (PTHS(:,:,:) * PRHODJ(:,:,:), NBUDGET_TH, 'NEGA_BU_RTH')
-!
-IF (LBUDGET_SV) THEN
- DO JSV = NSV_ELECBEG, NSV_ELECEND
- CALL BUDGET (PSVS(:,:,:,JSV) * PRHODJ(:,:,:), NBUDGET_SV1-1+JSV, 'NEGA_BU_RSV')
- END DO
-END IF
-!
+if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'NEGA', pths(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rv ) call Budget_store_end( tbudgets(NBUDGET_RV), 'NEGA', prs (:, :, :, 1) * prhodj(:, :, :) )
+if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'NEGA', prs (:, :, :, 2) * prhodj(:, :, :) )
+if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'NEGA', prs (:, :, :, 3) * prhodj(:, :, :) )
+if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'NEGA', prs (:, :, :, 4) * prhodj(:, :, :) )
+if ( lbudget_rs ) call Budget_store_end( tbudgets(NBUDGET_RS), 'NEGA', prs (:, :, :, 5) * prhodj(:, :, :) )
+if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG), 'NEGA', prs (:, :, :, 6) * prhodj(:, :, :) )
+if ( lbudget_rh ) call Budget_store_end( tbudgets(NBUDGET_RH), 'NEGA', prs (:, :, :, 7) * prhodj(:, :, :) )
+if ( lbudget_sv ) then
+ do jsv = nsv_elecbeg, nsv_elecend
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + jsv), 'NEGA', psvs(:, :, :, jsv) * prhodj(:, :, :) )
+ end do
+end if
!
!------------------------------------------------------------------------------
!
diff --git a/src/MNH/shallow_mf_pack.f90 b/src/MNH/shallow_mf_pack.f90
index 33946f46ef349dacfe9e9afda3c546f87985af81..e3fb2799f22eea29e879a4fabc79686a8441fbb6 100644
--- a/src/MNH/shallow_mf_pack.f90
+++ b/src/MNH/shallow_mf_pack.f90
@@ -119,7 +119,7 @@ END MODULE MODI_SHALLOW_MF_PACK
! P. Wautelet 05/2016-04/2018: new data structures and calls for I/O
! S. Riette 11/2016: support for CFRAC_ICE_SHALLOW_MF
! P. Wautelet 28/03/2019: use MNHTIME for time measurement variables
-! P. Wautelet 28/01/2020: use the new data structures and subroutines for budgets for U
+! P. Wautelet 02/2020: use the new data structures and subroutines for budgets
! --------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -141,7 +141,6 @@ use modd_precision, only: MNHTIME
use mode_budget, only: Budget_store_init, Budget_store_end
USE MODE_IO_FIELD_WRITE, only: IO_Field_write
-USE MODI_BUDGET
USE MODI_DIAGNOS_LES_MF
USE MODI_SHALLOW_MF
USE MODI_SHUMAN
@@ -280,7 +279,15 @@ IRR=SIZE(PRM,4)
! number of scalar var
ISV=SIZE(PSVM,4)
-if ( lbudget_u ) call Budget_store_init( tbudgets(NBUDGET_U), 'MAFL', prus )
+if ( lbudget_u ) call Budget_store_init( tbudgets(NBUDGET_U ), 'MAFL', prus (:, :, :) )
+if ( lbudget_v ) call Budget_store_init( tbudgets(NBUDGET_V ), 'MAFL', prvs (:, :, :) )
+if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'MAFL', prths(:, :, :) )
+if ( lbudget_rv ) call Budget_store_init( tbudgets(NBUDGET_RV), 'MAFL', prrs (:, :, :, 1) )
+if ( lbudget_sv ) then
+ do jsv = 1, isv
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + jsv), 'MAFL', prsvs(:, :, :, jsv) )
+ end do
+end if
ZSVM(:,:,:) = 0.
!
@@ -377,15 +384,16 @@ DO JSV=1,ISV
END DO
!!! 7. call to MesoNH budgets
-if ( lbudget_u ) call Budget_store_end( tbudgets(NBUDGET_U), 'MAFL', prus )
+if ( lbudget_u ) call Budget_store_end( tbudgets(NBUDGET_U ), 'MAFL', prus (:, :, :) )
+if ( lbudget_v ) call Budget_store_end( tbudgets(NBUDGET_V ), 'MAFL', prvs (:, :, :) )
+if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'MAFL', prths(:, :, :) )
+if ( lbudget_rv ) call Budget_store_end( tbudgets(NBUDGET_RV), 'MAFL', prrs (:, :, :, 1) )
+if ( lbudget_sv ) then
+ do jsv = 1, isv
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + jsv), 'MAFL', prsvs(:, :, :, jsv) )
+ end do
+end if
-IF (LBUDGET_TH) CALL BUDGET (PRTHS,NBUDGET_TH,'MAFL_BU_RTH')
-IF (LBUDGET_RV) CALL BUDGET (PRRS(:,:,:,1),NBUDGET_RV,'MAFL_BU_RRV')
-IF (LBUDGET_V) CALL BUDGET (PRVS,NBUDGET_V,'MAFL_BU_RV')
-DO JSV=1,ISV
- IF (LBUDGET_SV) CALL BUDGET (PRSVS(:,:,:,JSV),NBUDGET_SV1-1+JSV,'MAFL_BU_RSV')
-END DO
-
!!! 8. Prints the fluxes in output file
!
IF ( OMF_FLX .AND. OCLOSE_OUT ) THEN
diff --git a/src/MNH/slow_terms.f90 b/src/MNH/slow_terms.f90
index 62ffffc269f1a2eb1b2d6fa19107cb8adcf3fa04..2b0c58658dcd21e3622d8ab85c051368ee86e3e4 100644
--- a/src/MNH/slow_terms.f90
+++ b/src/MNH/slow_terms.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2020 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.
@@ -151,19 +151,22 @@ END MODULE MODI_SLOW_TERMS
!! 06/11/02 (V. Masson) update the budget calls
!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
+! P. Wautelet 02/2020: use the new data structures and subroutines for budgets
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_PARAMETERS
-USE MODD_CLOUDPAR
-USE MODD_CST
+use modd_budget, only: lbudget_th, lbudget_rv, lbudget_rc, lbudget_rr, &
+ NBUDGET_TH, NBUDGET_RV, NBUDGET_RC, NBUDGET_RR, &
+ tbudgets
+USE MODD_CLOUDPAR
USE MODD_CONF
-USE MODD_BUDGET
-!
-USE MODI_BUDGET
-!
+USE MODD_CST
+USE MODD_PARAMETERS
+
+use mode_budget, only: Budget_store_init, Budget_store_end
+
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
@@ -232,6 +235,7 @@ END DO
!* 2. COMPUTE THE SEDIMENTATION (RS) SOURCE
! -------------------------------------
!
+if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'SEDI', prrs(:, :, :) * prhodj(:, :, :) )
!
!* 2.1 time splitting loop initialization
!
@@ -324,7 +328,7 @@ PRRS(:,:,:) = ZW1(:,:,:) / PTSTEP
!
!* 2.5 budget storage
!
-IF (LBUDGET_RR) CALL BUDGET (PRRS(:,:,:)*PRHODJ(:,:,:),NBUDGET_RR,'SEDI_BU_RRR')
+if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'SEDI', prrs(:, :, :) * prhodj(:, :, :) )
!
!-------------------------------------------------------------------------------
!
@@ -332,6 +336,8 @@ IF (LBUDGET_RR) CALL BUDGET (PRRS(:,:,:)*PRHODJ(:,:,:),NBUDGET_RR,'SEDI_BU_RRR')
!* 3. COMPUTES THE ACCRETION SOURCE
! -----------------------------
!
+if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'ACCR', prcs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'ACCR', prrs(:, :, :) * prhodj(:, :, :) )
!
!* 3.1 compute the accretion and update the tendencies
!
@@ -348,8 +354,8 @@ END WHERE
!
!* 3.2 budget storage
!
-IF (LBUDGET_RC) CALL BUDGET (PRCS(:,:,:)*PRHODJ(:,:,:),NBUDGET_RC,'ACCR_BU_RRC')
-IF (LBUDGET_RR) CALL BUDGET (PRRS(:,:,:)*PRHODJ(:,:,:),NBUDGET_RR,'ACCR_BU_RRR')
+if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'ACCR', prcs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'ACCR', prrs(:, :, :) * prhodj(:, :, :) )
!
!-------------------------------------------------------------------------------
!
@@ -357,6 +363,8 @@ IF (LBUDGET_RR) CALL BUDGET (PRRS(:,:,:)*PRHODJ(:,:,:),NBUDGET_RR,'ACCR_BU_RRR')
!* 4. COMPUTES THE AUTOCONVERSION SOURCE
! ----------------------------------
!
+if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'AUTO', prcs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'AUTO', prrs(:, :, :) * prhodj(:, :, :) )
!
!* 4.1 compute the autoconversion and update the tendencies
!
@@ -379,14 +387,18 @@ END IF
!
!* 4.2 budget storage
!
-IF (LBUDGET_RC) CALL BUDGET (PRCS(:,:,:)*PRHODJ(:,:,:),NBUDGET_RC,'AUTO_BU_RRC')
-IF (LBUDGET_RR) CALL BUDGET (PRRS(:,:,:)*PRHODJ(:,:,:),NBUDGET_RR,'AUTO_BU_RRR')
+if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'AUTO', prcs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'AUTO', prrs(:, :, :) * prhodj(:, :, :) )
!
!-------------------------------------------------------------------------------
!
!* 5. COMPUTES THE RAIN EVAPORATION (RE) SOURCE
! -----------------------------------------
!
+if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'REVA', pths(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rv ) call Budget_store_init( tbudgets(NBUDGET_RV), 'REVA', prvs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'REVA', prrs(:, :, :) * prhodj(:, :, :) )
+
PEVAP3D(:,:,:)=0.
WHERE ( (PRRT(:,:,:)>0.0) .AND. (PRCT(:,:,:)==0.0) )
!
@@ -436,9 +448,9 @@ END WHERE
!
!* 5.8 budget storage
!
-IF (LBUDGET_RV) CALL BUDGET (PRVS(:,:,:)*PRHODJ(:,:,:),NBUDGET_RV,'REVA_BU_RRV')
-IF (LBUDGET_RR) CALL BUDGET (PRRS(:,:,:)*PRHODJ(:,:,:),NBUDGET_RR,'REVA_BU_RRR')
-IF (LBUDGET_TH) CALL BUDGET (PTHS(:,:,:)*PRHODJ(:,:,:),NBUDGET_TH,'REVA_BU_RTH')
+if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'REVA', pths(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rv ) call Budget_store_end( tbudgets(NBUDGET_RV), 'REVA', prvs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'REVA', prrs(:, :, :) * prhodj(:, :, :) )
!
!-------------------------------------------------------------------------------
!
diff --git a/src/MNH/tke_eps_sources.f90 b/src/MNH/tke_eps_sources.f90
index f903b4e875376cbf4fa9bb2ceb10494bae5330af..d945774a3e93e7b2704654cc7b69d19345aa6678 100644
--- a/src/MNH/tke_eps_sources.f90
+++ b/src/MNH/tke_eps_sources.f90
@@ -168,36 +168,35 @@ END MODULE MODI_TKE_EPS_SOURCES
!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
! P. Wautelet 20/05/2019: add name argument to ADDnFIELD_ll + new ADD4DFIELD_ll subroutine
-!! --------------------------------------------------------------------------
+! P. Wautelet 02/2020: use the new data structures and subroutines for budgets
+! --------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_CST
+USE MODD_ARGSLIST_ll, ONLY: LIST_ll
+use modd_budget, only: lbudget_tke, lbudget_th, NBUDGET_TKE, NBUDGET_TH, tbudgets
USE MODD_CONF
+USE MODD_CST
USE MODD_CTURB
+USE MODD_DIAG_IN_RUN, ONLY: LDIAG_IN_RUN, XCURRENT_TKE_DISS
use modd_field, only: tfielddata, TYPEREAL
-USE MODD_IO, ONLY: TFILEDATA
-USE MODD_PARAMETERS
-USE MODD_BUDGET
+USE MODD_IO, ONLY: TFILEDATA
USE MODD_LES
-USE MODD_DIAG_IN_RUN, ONLY : LDIAG_IN_RUN, XCURRENT_TKE_DISS
+USE MODD_PARAMETERS
!
-USE MODE_ll
+use mode_budget, only: Budget_store_add, Budget_store_end, Budget_store_init
USE MODE_IO_FIELD_WRITE, only: IO_Field_write
+USE MODE_ll
!
+USE MODI_GET_HALO
USE MODI_GRADIENT_M
USE MODI_GRADIENT_U
USE MODI_GRADIENT_V
USE MODI_GRADIENT_W
-USE MODI_SHUMAN
-USE MODI_TRIDIAG_TKE
-USE MODI_BUDGET
USE MODI_LES_MEAN_SUBGRID
-!
-USE MODD_ARGSLIST_ll, ONLY : LIST_ll
-!
-USE MODI_GET_HALO
+USE MODI_SHUMAN
+USE MODI_TRIDIAG_TKE
!
IMPLICIT NONE
!
@@ -277,7 +276,10 @@ IKE=KKU-JPVEXT_TURB*KKL
!
! compute the effective diffusion coefficient at the mass point
ZKEFF(:,:,:) = PLM(:,:,:) * SQRT(PTKEM(:,:,:))
-!
+
+if (lbudget_th) call Budget_store_init( tbudgets(NBUDGET_TH), 'DISSH', prthls(:, :, :) )
+if (lbudget_tke) call Budget_store_init( tbudgets(NBUDGET_TKE), 'TR', prtkes(:, :, :) )
+
!----------------------------------------------------------------------------
!
!* 2. TKE EQUATION
@@ -370,24 +372,15 @@ END IF
!
!* 2.4 stores the explicit sources for budget purposes
!
-IF (LBUDGET_TKE) THEN
-!
-! add the dynamical production
-!
- PRTKES(:,:,:) = PRTKES(:,:,:) + PDP(:,:,:) * PRHODJ(:,:,:)
- CALL BUDGET (PRTKES(:,:,:),NBUDGET_TKE,'DP_BU_RTKE')
-!
-! add the thermal production
-!
- PRTKES(:,:,:) = PRTKES(:,:,:) + PTP(:,:,:) * PRHODJ(:,:,:)
- CALL BUDGET (PRTKES(:,:,:),NBUDGET_TKE,'TP_BU_RTKE')
-!
-! add the dissipation
-!
-PRTKES(:,:,:) = PRTKES(:,:,:) - XCED * SQRT(PTKEM(:,:,:)) / PLEPS(:,:,:) * &
- (PEXPL*PTKEM(:,:,:) + PIMPL*ZRES(:,:,:)) * PRHODJ(:,:,:)
-CALL BUDGET (PRTKES(:,:,:),NBUDGET_TKE,'DISS_BU_RTKE')
-END IF
+if (lbudget_tke) then
+ ! Dynamical production
+ call Budget_store_add( tbudgets(NBUDGET_TKE), 'DP', pdp(:, :, :) * prhodj(:, :, :) )
+ ! Thermal production
+ call Budget_store_add( tbudgets(NBUDGET_TKE), 'TP', ptp(:, :, :) * prhodj(:, :, :) )
+ ! Dissipation
+ call Budget_store_add( tbudgets(NBUDGET_TKE), 'DISS', -xced * sqrt( ptkem(:, :, :) ) / pleps(:, :, :) &
+ * ( pexpl * ptkem(:, :, :) + pimpl * zres(:, :, :) ) * prhodj(:, :, :) )
+end if
!
!* 2.5 computes the final RTKE and stores the whole turbulent transport
! with the removal of the advection part
@@ -395,9 +388,8 @@ PRTKES(:,:,:) = ZRES(:,:,:) * PRHODJ(:,:,:) / PTSTEP - PRTKESM(:,:,:)
!
! stores the whole turbulent transport
!
-IF (LBUDGET_TKE) CALL BUDGET (PRTKES(:,:,:),NBUDGET_TKE,'TR_BU_RTKE')
-!
-!
+if (lbudget_tke) call Budget_store_end( tbudgets(NBUDGET_TKE), 'TR', prtkes(:, :, :) )
+
!----------------------------------------------------------------------------
!
!* 3. COMPUTE THE DISSIPATIVE HEATING
@@ -405,7 +397,9 @@ IF (LBUDGET_TKE) CALL BUDGET (PRTKES(:,:,:),NBUDGET_TKE,'TR_BU_RTKE')
!
PRTHLS(:,:,:) = PRTHLS(:,:,:) + XCED * SQRT(PTKEM(:,:,:)) / PLEPS(:,:,:) * &
(PEXPL*PTKEM(:,:,:) + PIMPL*ZRES(:,:,:)) * PRHODJ(:,:,:) * PCOEF_DISS(:,:,:)
-!
+
+if (lbudget_th) call Budget_store_end( tbudgets(NBUDGET_TH), 'DISSH', prthls(:, :, :) )
+
!----------------------------------------------------------------------------
!
!* 4. STORES SOME DIAGNOSTICS
diff --git a/src/MNH/turb.f90 b/src/MNH/turb.f90
index 7f9877b568ca57b55d6a5a27999095434ac6f5ce..026ede0381603b6068cfe8ffe6859d19de7a0d8e 100644
--- a/src/MNH/turb.f90
+++ b/src/MNH/turb.f90
@@ -341,7 +341,7 @@ END MODULE MODI_TURB
! P. Wautelet 05/2016-04/2018: new data structures and calls for I/O
! Q. Rodier 01/2018: introduction of RM17
! P. Wautelet 20/05/2019: add name argument to ADDnFIELD_ll + new ADD4DFIELD_ll subroutine
-! P. Wautelet 28/01/2020: use the new data structures and subroutines for budgets for U
+! P. Wautelet 02/2020: use the new data structures and subroutines for budgets
! --------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -909,7 +909,18 @@ ENDIF
!* 5. TURBULENT SOURCES
! -----------------
!
-if ( lbudget_u ) call Budget_store_init( tbudgets(NBUDGET_U), 'VTURB', prus )
+if ( lbudget_u ) call Budget_store_init( tbudgets(NBUDGET_U ), 'VTURB', prus (:, :, :) )
+if ( lbudget_v ) call Budget_store_init( tbudgets(NBUDGET_V ), 'VTURB', prvs (:, :, :) )
+if ( lbudget_w ) call Budget_store_init( tbudgets(NBUDGET_W ), 'VTURB', prws (:, :, :) )
+if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'VTURB', prthls(:, :, :) )
+if ( lbudget_rv ) call Budget_store_init( tbudgets(NBUDGET_RV), 'VTURB', prrs (:, :, :, 1) )
+if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'VTURB', prrs (:, :, :, 2) )
+if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'VTURB', prrs (:, :, :, 4) )
+if ( lbudget_sv ) then
+ do jsv = 1, nsv
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + jsv), 'VTURB', prsvs(:, :, :, jsv) )
+ end do
+end if
CALL TURB_VER(KKA,KKU,KKL,KRR, KRRL, KRRI, &
OCLOSE_OUT,OTURB_FLX, &
@@ -928,40 +939,75 @@ CALL TURB_VER(KKA,KKU,KKL,KRR, KRRL, KRRI, &
PRUS,PRVS,PRWS,PRTHLS,PRRS,PRSVS, &
PDYP,PTHP,PSIGS,PWTH,PWRC,PWSV )
-if ( lbudget_u ) call Budget_store_end( tbudgets(NBUDGET_U), 'VTURB', prus )
+if ( lbudget_u ) call Budget_store_end( tbudgets(NBUDGET_U), 'VTURB', prus(:, :, :) )
+if ( lbudget_v ) call Budget_store_end( tbudgets(NBUDGET_V), 'VTURB', prvs(:, :, :) )
+if ( lbudget_w ) call Budget_store_end( tbudgets(NBUDGET_W), 'VTURB', prws(:, :, :) )
-IF (LBUDGET_V) CALL BUDGET (PRVS,NBUDGET_V,'VTURB_BU_RV')
-IF (LBUDGET_W) CALL BUDGET (PRWS,NBUDGET_W,'VTURB_BU_RW')
-IF (LBUDGET_TH) THEN
- IF ( KRRI >= 1 .AND. KRRL >= 1 ) THEN
- CALL BUDGET (PRTHLS+ ZLVOCPEXNM * PRRS(:,:,:,2) + ZLSOCPEXNM * PRRS(:,:,:,4),NBUDGET_TH,'VTURB_BU_RTH')
- ELSE IF ( KRRL >= 1 ) THEN
- CALL BUDGET (PRTHLS+ ZLOCPEXNM * PRRS(:,:,:,2),NBUDGET_TH,'VTURB_BU_RTH')
- ELSE
- CALL BUDGET (PRTHLS,NBUDGET_TH,'VTURB_BU_RTH')
- END IF
-END IF
-IF (LBUDGET_SV) THEN
- DO JSV = 1,NSV
- CALL BUDGET (PRSVS(:,:,:,JSV),NBUDGET_SV1-1+JSV,'VTURB_BU_RSV')
- END DO
-END IF
-IF (LBUDGET_RV) THEN
- IF ( KRRI >= 1 .AND. KRRL >= 1) THEN
- CALL BUDGET (PRRS(:,:,:,1)-PRRS(:,:,:,2)-PRRS(:,:,:,4),NBUDGET_RV,'VTURB_BU_RRV')
- ELSE IF ( KRRL >= 1 ) THEN
- CALL BUDGET (PRRS(:,:,:,1)-PRRS(:,:,:,2),NBUDGET_RV,'VTURB_BU_RRV')
- ELSE
- CALL BUDGET (PRRS(:,:,:,1),NBUDGET_RV,'VTURB_BU_RRV')
- END IF
-END IF
-IF (LBUDGET_RC) CALL BUDGET (PRRS(:,:,:,2),NBUDGET_RC,'VTURB_BU_RRC')
-IF (LBUDGET_RI) CALL BUDGET (PRRS(:,:,:,4),NBUDGET_RI,'VTURB_BU_RRI')
-!
-!
-if ( lbudget_u ) call Budget_store_init( tbudgets(NBUDGET_U), 'HTURB', prus )
+if ( lbudget_th ) then
+ if ( krri >= 1 .and. krrl >= 1 ) then
+ call Budget_store_end( tbudgets(NBUDGET_TH), 'VTURB', prthls(:, :, :) + zlvocpexnm(:, :, :) * prrs(:, :, :, 2) &
+ + zlsocpexnm(:, :, :) * prrs(:, :, :, 4) )
+ else if ( krrl >= 1 ) then
+ call Budget_store_end( tbudgets(NBUDGET_TH), 'VTURB', prthls(:, :, :) + zlocpexnm(:, :, :) * prrs(:, :, :, 2) )
+ else
+ call Budget_store_end( tbudgets(NBUDGET_TH), 'VTURB', prthls(:, :, :) )
+ end if
+end if
+
+if ( lbudget_rv ) then
+ if ( krri >= 1 .and. krrl >= 1 ) then
+ call Budget_store_end( tbudgets(NBUDGET_RV), 'VTURB', prrs(:, :, :, 1) - prrs(:, :, :, 2) - prrs(:, :, :, 4) )
+ else if ( krrl >= 1 ) then
+ call Budget_store_end( tbudgets(NBUDGET_RV), 'VTURB', prrs(:, :, :, 1) - prrs(:, :, :, 2) )
+ else
+ call Budget_store_end( tbudgets(NBUDGET_RV), 'VTURB', prrs(:, :, :, 1) )
+ end if
+end if
+
+if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'VTURB', prrs(:, :, :, 2) )
+if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'VTURB', prrs(:, :, :, 4) )
+
+if ( lbudget_sv ) then
+ do jsv = 1, nsv
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + jsv), 'VTURB', prsvs(:, :, :, jsv) )
+ end do
+end if
+!
+if ( hturbdim == '3DIM' ) then
+ if ( lbudget_u ) call Budget_store_init( tbudgets(NBUDGET_U ), 'HTURB', prus (:, :, :) )
+ if ( lbudget_v ) call Budget_store_init( tbudgets(NBUDGET_V ), 'HTURB', prvs (:, :, :) )
+ if ( lbudget_w ) call Budget_store_init( tbudgets(NBUDGET_W ), 'HTURB', prws (:, :, :) )
+
+ if (lbudget_th) then
+ if ( krri >= 1 .and. krrl >= 1 ) then
+ call Budget_store_init( tbudgets(NBUDGET_TH), 'HTURB', prthls(:, :, :) + zlvocpexnm(:, :, :) * prrs(:, :, :, 2) &
+ + zlsocpexnm(:, :, :) * prrs(:, :, :, 4) )
+ else if ( krrl >= 1 ) then
+ call Budget_store_init( tbudgets(NBUDGET_TH), 'HTURB', prthls(:, :, :) + zlocpexnm(:, :, :) * prrs(:, :, :, 2) )
+ else
+ call Budget_store_init( tbudgets(NBUDGET_TH), 'HTURB', prthls(:, :, :) )
+ end if
+ end if
+
+ if ( lbudget_rv ) then
+ if ( krri >= 1 .and. krrl >= 1 ) then
+ call Budget_store_init( tbudgets(NBUDGET_RV), 'HTURB', prrs(:, :, :, 1) - prrs(:, :, :, 2) - prrs(:, :, :, 4) )
+ else if ( krrl >= 1 ) then
+ call Budget_store_init( tbudgets(NBUDGET_RV), 'HTURB', prrs(:, :, :, 1) - prrs(:, :, :, 2) )
+ else
+ call Budget_store_init( tbudgets(NBUDGET_RV), 'HTURB', prrs(:, :, :, 1) )
+ end if
+ end if
+
+ if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'HTURB', prrs(:, :, :, 2) )
+ if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'HTURB', prrs(:, :, :, 4) )
+
+ if ( lbudget_sv ) then
+ do jsv = 1, nsv
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + jsv), 'HTURB', prsvs(:, :, :, jsv) )
+ end do
+ end if
-IF (HTURBDIM=='3DIM') THEN
CALL TURB_HOR_SPLT(KSPLIT, KRR, KRRL, KRRI, PTSTEP, &
HLBCX,HLBCY,OCLOSE_OUT,OTURB_FLX,OSUBG_COND, &
TPFILE, &
@@ -977,39 +1023,41 @@ IF (HTURBDIM=='3DIM') THEN
PDYP,PTHP,PSIGS, &
ZTRH, &
PRUS,PRVS,PRWS,PRTHLS,PRRS,PRSVS )
-END IF
-if ( lbudget_u ) call Budget_store_end( tbudgets(NBUDGET_U), 'HTURB', prus )
+ if ( lbudget_u ) call Budget_store_end( tbudgets(NBUDGET_U), 'HTURB', prus(:, :, :) )
+ if ( lbudget_v ) call Budget_store_end( tbudgets(NBUDGET_V), 'HTURB', prvs(:, :, :) )
+ if ( lbudget_w ) call Budget_store_end( tbudgets(NBUDGET_W), 'HTURB', prws(:, :, :) )
-IF (LBUDGET_V) CALL BUDGET (PRVS,NBUDGET_V,'HTURB_BU_RV')
-IF (LBUDGET_W) CALL BUDGET (PRWS,NBUDGET_W,'HTURB_BU_RW')
-IF (LBUDGET_TH) THEN
- IF ( KRRI >= 1 .AND. KRRL >= 1 ) THEN
- CALL BUDGET (PRTHLS+ZLVOCPEXNM*PRRS(:,:,:,2)+ZLSOCPEXNM*PRRS(:,:,:,4) &
- ,NBUDGET_TH,'HTURB_BU_RTH')
- ELSE IF ( KRRL >= 1 ) THEN
- CALL BUDGET (PRTHLS+ ZLOCPEXNM * PRRS(:,:,:,2),NBUDGET_TH,'HTURB_BU_RTH')
- ELSE
- CALL BUDGET (PRTHLS,NBUDGET_TH,'HTURB_BU_RTH')
- END IF
-END IF
-IF (LBUDGET_SV) THEN
- DO JSV = 1,NSV
- CALL BUDGET (PRSVS(:,:,:,JSV),NBUDGET_SV1-1+JSV,'HTURB_BU_RSV')
- END DO
-END IF
-IF (LBUDGET_RV) THEN
- IF ( KRRI >= 1 .AND. KRRL >= 1) THEN
- CALL BUDGET (PRRS(:,:,:,1)-PRRS(:,:,:,2)-PRRS(:,:,:,4),NBUDGET_RV,'HTURB_BU_RRV')
- ELSE IF ( KRRL >= 1 ) THEN
- CALL BUDGET (PRRS(:,:,:,1)-PRRS(:,:,:,2),NBUDGET_RV,'HTURB_BU_RRV')
- ELSE
- CALL BUDGET (PRRS(:,:,:,1),NBUDGET_RV,'HTURB_BU_RRV')
- END IF
-END IF
-IF (LBUDGET_RC) CALL BUDGET (PRRS(:,:,:,2),NBUDGET_RC,'HTURB_BU_RRC')
-IF (LBUDGET_RI) CALL BUDGET (PRRS(:,:,:,4),NBUDGET_RI,'HTURB_BU_RRI')
-!
+ if ( lbudget_th ) then
+ if ( krri >= 1 .and. krrl >= 1 ) then
+ call Budget_store_end( tbudgets(NBUDGET_TH), 'HTURB', prthls(:, :, :) + zlvocpexnm(:, :, :) * prrs(:, :, :, 2) &
+ + zlsocpexnm(:, :, :) * prrs(:, :, :, 4) )
+ else if ( krrl >= 1 ) then
+ call Budget_store_end( tbudgets(NBUDGET_TH), 'HTURB', prthls(:, :, :) + zlocpexnm(:, :, :) * prrs(:, :, :, 2) )
+ else
+ call Budget_store_end( tbudgets(NBUDGET_TH), 'HTURB', prthls(:, :, :) )
+ end if
+ end if
+
+ if ( lbudget_rv ) then
+ if ( krri >= 1 .and. krrl >= 1 ) then
+ call Budget_store_end( tbudgets(NBUDGET_RV), 'HTURB', prrs(:, :, :, 1) - prrs(:, :, :, 2) - prrs(:, :, :, 4) )
+ else if ( krrl >= 1 ) then
+ call Budget_store_end( tbudgets(NBUDGET_RV), 'HTURB', prrs(:, :, :, 1) - prrs(:, :, :, 2) )
+ else
+ call Budget_store_end( tbudgets(NBUDGET_RV), 'HTURB', prrs(:, :, :, 1) )
+ end if
+ end if
+
+ if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'HTURB', prrs(:, :, :, 2) )
+ if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'HTURB', prrs(:, :, :, 4) )
+
+ if ( lbudget_sv ) then
+ do jsv = 1, nsv
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + jsv), 'HTURB', prsvs(:, :, :, jsv) )
+ end do
+ end if
+end if
!----------------------------------------------------------------------------
!
!* 6. EVOLUTION OF THE TKE AND ITS DISSIPATION
@@ -1028,18 +1076,7 @@ CALL TKE_EPS_SOURCES(KKA,KKU,KKL,KMI,PTKET,PLEM,ZLEPS,PDYP,ZTRH, &
HTURBLEN,HTURBDIM, &
TPFILE,OCLOSE_OUT,OTURB_DIAG, &
PTHP,PRTKES,PRTKEMS,PRTHLS,ZCOEF_DISS,PTR,PDISS )
-!
-IF (LBUDGET_TH) THEN
- IF ( KRRI >= 1 .AND. KRRL >= 1 ) THEN
- CALL BUDGET (PRTHLS+ZLVOCPEXNM*PRRS(:,:,:,2)+ZLSOCPEXNM*PRRS(:,:,:,4) &
- ,NBUDGET_TH,'DISSH_BU_RTH')
- ELSE IF ( KRRL >= 1 ) THEN
- CALL BUDGET (PRTHLS+ZLOCPEXNM* PRRS(:,:,:,2),NBUDGET_TH,'DISSH_BU_RTH')
- ELSE
- CALL BUDGET (PRTHLS,NBUDGET_TH,'DISSH_BU_RTH')
- END IF
-END IF
-!
+
!----------------------------------------------------------------------------
!
!* 7. STORES SOME INFORMATIONS RELATED TO THE TURBULENCE SCHEME
@@ -1118,6 +1155,19 @@ IF ( KRRL >= 1 ) THEN
END IF
!
IF ((HCLOUD == 'KHKO') .OR. (HCLOUD == 'C2R2')) THEN
+ if (lbudget_th) then
+ if ( krri >= 1 .and. krrl >= 1 ) then
+ call Budget_store_init( tbudgets(NBUDGET_TH), 'NETUR', prthls(:, :, :) + zlvocpexnm(:, :, :) * prrs(:, :, :, 2) &
+ + zlsocpexnm(:, :, :) * prrs(:, :, :, 4) )
+ else if ( krrl >= 1 ) then
+ call Budget_store_init( tbudgets(NBUDGET_TH), 'NETUR', prthls(:, :, :) + zlocpexnm(:, :, :) * prrs(:, :, :, 2) )
+ else
+ call Budget_store_init( tbudgets(NBUDGET_TH), 'NETUR', prthls(:, :, :) )
+ end if
+ end if
+ if (lbudget_rv) call Budget_store_init( tbudgets(NBUDGET_RV), 'NETUR', prrs (:, :, :, 1) )
+ if (lbudget_rc) call Budget_store_init( tbudgets(NBUDGET_RC), 'NETUR', prrs (:, :, :, 2) )
+
ZEXNE(:,:,:)= (PPABST(:,:,:)/XP00)**(XRD/XCPD)
ZTT(:,:,:)= PTHLT(:,:,:)*ZEXNE(:,:,:)
ZLV(:,:,:)=XLVTT +(XCPV-XCL) *(ZTT(:,:,:)-XTT)
@@ -1138,10 +1188,10 @@ IF ((HCLOUD == 'KHKO') .OR. (HCLOUD == 'C2R2')) THEN
PRSVS(:,:,:,JSV) = 0.0
END WHERE
END DO
-!
- IF (LBUDGET_TH) CALL BUDGET (PRTHLS(:,:,:), NBUDGET_TH,'NETUR_BU_RTH')
- IF (LBUDGET_RV) CALL BUDGET (PRRS(:,:,:,1), NBUDGET_RV,'NETUR_BU_RRV')
- IF (LBUDGET_RC) CALL BUDGET (PRRS(:,:,:,2), NBUDGET_RC,'NETUR_BU_RRC')
+
+ if (lbudget_th) call Budget_store_end( tbudgets(NBUDGET_TH), 'NETUR', prthls(:, :, :) )
+ if (lbudget_rv) call Budget_store_end( tbudgets(NBUDGET_RV), 'NETUR', prrs (:, :, :, 1) )
+ if (lbudget_rc) call Budget_store_end( tbudgets(NBUDGET_RC), 'NETUR', prrs (:, :, :, 2) )
END IF
!
!----------------------------------------------------------------------------
diff --git a/src/MNH/two_way.f90 b/src/MNH/two_way.f90
index 38d2e2857248de5ff57fedfc43d871b56d2fc867..bd6a98cdc980bdc292adc3775a83bd2b02733c2e 100644
--- a/src/MNH/two_way.f90
+++ b/src/MNH/two_way.f90
@@ -93,7 +93,7 @@ END MODULE MODI_TWO_WAY
!! + MASKkids array
!! 20/05/06 Remove EPS
! P. Wautelet 05/2016-04/2018: new data structures and calls for I/O
-! P. Wautelet 28/01/2020: use the new data structures and subroutines for budgets for U
+! P. Wautelet /02/2020: use the new data structures and subroutines for budgets
!
!------------------------------------------------------------------------------
!
@@ -111,7 +111,6 @@ USE MODD_NESTING
use mode_budget, only: Budget_store_init, Budget_store_end
USE MODE_MODELN_HANDLER
-USE MODI_BUDGET
USE MODI_TWO_WAY_n
IMPLICIT NONE
@@ -152,8 +151,22 @@ INTEGER :: JSV,JRR ! Loop index for scalar and moist variables
!
!-------------------------------------------------------------------------------
-if ( lbudget_u ) call Budget_store_init( tbudgets(NBUDGET_U), 'NEST', prus )
-
+if ( lbudget_u ) call Budget_store_init( tbudgets(NBUDGET_U ), 'NEST', prus (:, :, : ) )
+if ( lbudget_v ) call Budget_store_init( tbudgets(NBUDGET_V ), 'NEST', prvs (:, :, : ) )
+if ( lbudget_w ) call Budget_store_init( tbudgets(NBUDGET_W ), 'NEST', prws (:, :, : ) )
+if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'NEST', prths(:, :, : ) )
+if ( lbudget_rv ) call Budget_store_init( tbudgets(NBUDGET_RV), 'NEST', prrs (:, :, :, 1) )
+if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'NEST', prrs (:, :, :, 2) )
+if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'NEST', prrs (:, :, :, 3) )
+if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'NEST', prrs (:, :, :, 4) )
+if ( lbudget_rs ) call Budget_store_init( tbudgets(NBUDGET_RS), 'NEST', prrs (:, :, :, 5) )
+if ( lbudget_rg ) call Budget_store_init( tbudgets(NBUDGET_RG), 'NEST', prrs (:, :, :, 6) )
+if ( lbudget_rh ) call Budget_store_init( tbudgets(NBUDGET_RH), 'NEST', prrs (:, :, :, 7) )
+if ( lbudget_sv ) then
+ do jsv = 1, ksv
+ call Budget_store_init( tbudgets(jsv + NBUDGET_SV1 - 1), 'NEST', prsvs(:, :, :, jsv) )
+ end do
+end if
!
!* 1. CALL THE RIGHT TWO_WAY$n
! ------------------------
@@ -174,23 +187,22 @@ CALL GOTO_MODEL(KMI)
!* 2. BUDGET COMPUTATION
! ------------------
!
-if ( lbudget_u ) call Budget_store_end( tbudgets(NBUDGET_U), 'NEST', prus )
-
-IF (LBUDGET_V) CALL BUDGET (PRVS,NBUDGET_V,'NEST_BU_RV')
-IF (LBUDGET_W) CALL BUDGET (PRWS,NBUDGET_W,'NEST_BU_RW')
-IF (LBUDGET_TH) CALL BUDGET (PRTHS,NBUDGET_TH,'NEST_BU_RTH')
-DO JRR=1,KRR
- IF (JRR==1 .AND. LBUDGET_RV) CALL BUDGET (PRRS(:,:,:,JRR),NBUDGET_RV,'NEST_BU_RRV')
- IF (JRR==2 .AND. LBUDGET_RC) CALL BUDGET (PRRS(:,:,:,JRR),NBUDGET_RC,'NEST_BU_RRC')
- IF (JRR==3 .AND. LBUDGET_RR) CALL BUDGET (PRRS(:,:,:,JRR),NBUDGET_RR,'NEST_BU_RRR')
- IF (JRR==4 .AND. LBUDGET_RI) CALL BUDGET (PRRS(:,:,:,JRR),NBUDGET_RI,'NEST_BU_RRI')
- IF (JRR==5 .AND. LBUDGET_RS) CALL BUDGET (PRRS(:,:,:,JRR),NBUDGET_RS,'NEST_BU_RRS')
- IF (JRR==6 .AND. LBUDGET_RG) CALL BUDGET (PRRS(:,:,:,JRR),NBUDGET_RG,'NEST_BU_RRG')
- IF (JRR==7 .AND. LBUDGET_RH) CALL BUDGET (PRRS(:,:,:,JRR),NBUDGET_RH,'NEST_BU_RRH')
-ENDDO
-DO JSV=1,KSV
- IF (LBUDGET_SV) CALL BUDGET (PRSVS(:,:,:,JSV),NBUDGET_SV1-1+JSV,'NEST_BU_RSV')
-END DO
+if ( lbudget_u ) call Budget_store_end( tbudgets(NBUDGET_U ), 'NEST', prus (:, :, : ) )
+if ( lbudget_v ) call Budget_store_end( tbudgets(NBUDGET_V ), 'NEST', prvs (:, :, : ) )
+if ( lbudget_w ) call Budget_store_end( tbudgets(NBUDGET_W ), 'NEST', prws (:, :, : ) )
+if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'NEST', prths(:, :, : ) )
+if ( lbudget_rv ) call Budget_store_end( tbudgets(NBUDGET_RV), 'NEST', prrs (:, :, :, 1) )
+if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'NEST', prrs (:, :, :, 2) )
+if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'NEST', prrs (:, :, :, 3) )
+if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'NEST', prrs (:, :, :, 4) )
+if ( lbudget_rs ) call Budget_store_end( tbudgets(NBUDGET_RS), 'NEST', prrs (:, :, :, 5) )
+if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG), 'NEST', prrs (:, :, :, 6) )
+if ( lbudget_rh ) call Budget_store_end( tbudgets(NBUDGET_RH), 'NEST', prrs (:, :, :, 7) )
+if ( lbudget_sv ) then
+ do jsv = 1, ksv
+ call Budget_store_end( tbudgets(jsv + NBUDGET_SV1 - 1), 'NEST', prsvs(:, :, :, jsv) )
+ end do
+end if
!------------------------------------------------------------------------------
!
END SUBROUTINE TWO_WAY
diff --git a/src/MNH/viscosity.f90 b/src/MNH/viscosity.f90
index f1f1da39d944a51cdfbc9e3dd82fd91fe40b11be..e4c5d3ac5eea7f6bbdc7af3a2feabff8e757dcba 100644
--- a/src/MNH/viscosity.f90
+++ b/src/MNH/viscosity.f90
@@ -91,7 +91,7 @@ SUBROUTINE VISCOSITY(HLBCX, HLBCY, KRR, KSV, PNU, PPRANDTL, &
!! 01/18 (C.Lac) Add budgets
! P. Wautelet 20/05/2019: add name argument to ADDnFIELD_ll + new ADD4DFIELD_ll subroutine
! P. Wautelet 08/11/2019: corrected wrong budget name VISC_BU_RU -> VISC_BU_RTH
-! P. Wautelet 28/01/2020: use the new data structures and subroutines for budgets for U
+! P. Wautelet 02/2020: use the new data structures and subroutines for budgets
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -111,7 +111,6 @@ SUBROUTINE VISCOSITY(HLBCX, HLBCY, KRR, KSV, PNU, PPRANDTL, &
use mode_budget, only: Budget_store_init, Budget_store_end
USE MODE_ll
- USE MODI_BUDGET
USE MODI_SHUMAN
USE MODI_LAP_M
!
@@ -188,7 +187,22 @@ IIU=SIZE(PWT,1)
IJU=SIZE(PWT,2)
IKU=SIZE(PWT,3)
-if ( lbudget_u ) call Budget_store_init( tbudgets(NBUDGET_U), 'VISC', prus )
+if ( lbudget_u .and. ovisc_uvw ) call Budget_store_init( tbudgets(NBUDGET_U ), 'VISC', prus (:, :, :) )
+if ( lbudget_v .and. ovisc_uvw ) call Budget_store_init( tbudgets(NBUDGET_V ), 'VISC', prvs (:, :, :) )
+if ( lbudget_w .and. ovisc_uvw ) call Budget_store_init( tbudgets(NBUDGET_W ), 'VISC', prws (:, :, :) )
+if ( lbudget_th .and. ovisc_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'VISC', prths(:, :, :) )
+if ( lbudget_rv .and. ovisc_r ) call Budget_store_init( tbudgets(NBUDGET_RV), 'VISC', prrs (:, :, :, 1) )
+if ( lbudget_rc .and. ovisc_r ) call Budget_store_init( tbudgets(NBUDGET_RC), 'VISC', prrs (:, :, :, 2) )
+if ( lbudget_rr .and. ovisc_r ) call Budget_store_init( tbudgets(NBUDGET_RR), 'VISC', prrs (:, :, :, 3) )
+if ( lbudget_ri .and. ovisc_r ) call Budget_store_init( tbudgets(NBUDGET_RI), 'VISC', prrs (:, :, :, 4) )
+if ( lbudget_rs .and. ovisc_r ) call Budget_store_init( tbudgets(NBUDGET_RS), 'VISC', prrs (:, :, :, 5) )
+if ( lbudget_rg .and. ovisc_r ) call Budget_store_init( tbudgets(NBUDGET_RG), 'VISC', prrs (:, :, :, 6) )
+if ( lbudget_rh .and. ovisc_r ) call Budget_store_init( tbudgets(NBUDGET_RH), 'VISC', prrs (:, :, :, 7) )
+if ( lbudget_sv .and. ovisc_sv ) then
+ do ik = 1, ksv
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + ik), 'VISC', prsvs(:, :, :, ik) )
+ end do
+end if
!* 1. Viscous forcing for potential temperature
! -----------------------------------------
@@ -203,8 +217,6 @@ IF (OVISC_TH) THEN
!
END IF
!
-IF (LBUDGET_TH) CALL BUDGET (PRTHS,NBUDGET_TH,'VISC_BU_RTH')
-!
!-------------------------------------------------------------------------------
!
!* 2. Viscous forcing for moisture
@@ -221,14 +233,6 @@ IF (OVISC_R .AND. (SIZE(PRT,1) > 0)) THEN
!
END IF
!
-IF (LBUDGET_RV) CALL BUDGET (PRRS(:,:,:,1),NBUDGET_RV,'VISC_BU_RRV')
-IF (LBUDGET_RC) CALL BUDGET (PRRS(:,:,:,2),NBUDGET_RC,'VISC_BU_RRC')
-IF (LBUDGET_RR) CALL BUDGET (PRRS(:,:,:,3),NBUDGET_RR,'VISC_BU_RRR')
-IF (LBUDGET_RI) CALL BUDGET (PRRS(:,:,:,4),NBUDGET_RI,'VISC_BU_RRI')
-IF (LBUDGET_RS) CALL BUDGET (PRRS(:,:,:,5),NBUDGET_RS,'VISC_BU_RRS')
-IF (LBUDGET_RG) CALL BUDGET (PRRS(:,:,:,6),NBUDGET_RG,'VISC_BU_RRG')
-IF (LBUDGET_RH) CALL BUDGET (PRRS(:,:,:,7),NBUDGET_RH,'VISC_BU_RRH')
-!
!-------------------------------------------------------------------------------
!
!* 3. Viscous forcing for passive scalars
@@ -244,13 +248,6 @@ IF (OVISC_SV .AND. (SIZE(PSVT,1) > 0)) THEN
!
END IF
!
-IF (LBUDGET_SV) THEN
- DO IK = 1, KSV
- CALL BUDGET (PRSVS(:,:,:,IK), NBUDGET_SV1-1+IK, 'VISC_BU_RSV')
- END DO
-END IF
-!
-
!-------------------------------------------------------------------------------
!
!* 4. Viscous forcing for momentum
@@ -343,10 +340,22 @@ ENDIF
ENDIF
ENDIF
END IF
-!
-if ( lbudget_u ) call Budget_store_end( tbudgets(NBUDGET_U), 'VISC', prus )
-IF (LBUDGET_V) CALL BUDGET (PRVS,NBUDGET_V,'VISC_BU_RV')
-IF (LBUDGET_W) CALL BUDGET (PRWS,NBUDGET_V,'VISC_BU_RW')
-!
+if ( lbudget_u .and. ovisc_uvw ) call Budget_store_end( tbudgets(NBUDGET_U ), 'VISC', prus (:, :, :) )
+if ( lbudget_v .and. ovisc_uvw ) call Budget_store_end( tbudgets(NBUDGET_V ), 'VISC', prvs (:, :, :) )
+if ( lbudget_w .and. ovisc_uvw ) call Budget_store_end( tbudgets(NBUDGET_W ), 'VISC', prws (:, :, :) )
+if ( lbudget_th .and. ovisc_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'VISC', prths(:, :, :) )
+if ( lbudget_rv .and. ovisc_r ) call Budget_store_end( tbudgets(NBUDGET_RV), 'VISC', prrs (:, :, :, 1) )
+if ( lbudget_rc .and. ovisc_r ) call Budget_store_end( tbudgets(NBUDGET_RC), 'VISC', prrs (:, :, :, 2) )
+if ( lbudget_rr .and. ovisc_r ) call Budget_store_end( tbudgets(NBUDGET_RR), 'VISC', prrs (:, :, :, 3) )
+if ( lbudget_ri .and. ovisc_r ) call Budget_store_end( tbudgets(NBUDGET_RI), 'VISC', prrs (:, :, :, 4) )
+if ( lbudget_rs .and. ovisc_r ) call Budget_store_end( tbudgets(NBUDGET_RS), 'VISC', prrs (:, :, :, 5) )
+if ( lbudget_rg .and. ovisc_r ) call Budget_store_end( tbudgets(NBUDGET_RG), 'VISC', prrs (:, :, :, 6) )
+if ( lbudget_rh .and. ovisc_r ) call Budget_store_end( tbudgets(NBUDGET_RH), 'VISC', prrs (:, :, :, 7) )
+if ( lbudget_sv .and. ovisc_sv ) then
+ do ik = 1, ksv
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + ik), 'VISC', prsvs(:, :, :, ik) )
+ end do
+end if
+
END SUBROUTINE VISCOSITY