From 2dcef1a0a646ac2452e0bf3338199a949ad72665 Mon Sep 17 00:00:00 2001
From: Philippe WAUTELET <philippe.wautelet@aero.obs-mip.fr>
Date: Fri, 6 Mar 2020 15:25:54 +0100
Subject: [PATCH] Philippe 06/03/2020: budgets: use the new data structures and
subroutines for budgets Remarks: compilation OK, execution not yet functional
---
src/MNH/adv_forcingn.f90 | 18 +-
src/MNH/advection_metsv.f90 | 72 +-
src/MNH/advection_uvw.f90 | 13 +-
src/MNH/advection_uvw_cen.f90 | 14 +-
src/MNH/c2r2_adjust.f90 | 37 +-
src/MNH/ch_monitorn.f90 | 27 +-
src/MNH/drag_veg.f90 | 36 +-
src/MNH/dyn_sources.f90 | 57 +-
src/MNH/endstep.f90 | 98 +-
src/MNH/exchange.f90 | 61 +-
src/MNH/fast_terms.f90 | 32 +-
src/MNH/forcing.f90 | 56 +-
src/MNH/gravity_impl.f90 | 27 +-
src/MNH/ice_adjust.f90 | 35 +-
src/MNH/ice_adjust_elec.f90 | 57 +-
src/MNH/initial_guess.f90 | 87 +-
src/MNH/ion_attach_elec.f90 | 35 +-
src/MNH/khko_notadjust.f90 | 35 +-
src/MNH/lima.f90 | 530 +++++-----
src/MNH/lima_adjust.f90 | 79 +-
src/MNH/lima_cold.f90 | 50 +-
src/MNH/lima_cold_hom_nucl.f90 | 210 ++--
src/MNH/lima_cold_slow_processes.f90 | 164 ++-
src/MNH/lima_meyers.f90 | 110 +-
src/MNH/lima_meyers_nucleation.f90 | 4 +-
src/MNH/lima_mixed.f90 | 124 +--
src/MNH/lima_mixed_fast_processes.f90 | 607 ++++++-----
src/MNH/lima_mixed_slow_processes.f90 | 121 ++-
src/MNH/lima_nucleation_procs.f90 | 275 +++--
src/MNH/lima_phillips.f90 | 152 ++-
src/MNH/lima_phillips_ifn_nucleation.f90 | 2 -
src/MNH/lima_precip_scavenging.f90 | 45 +-
src/MNH/lima_warm.f90 | 133 ++-
src/MNH/lima_warm_coal.f90 | 129 +--
src/MNH/modeln.f90 | 6 +-
src/MNH/nudging.f90 | 21 +-
src/MNH/num_diff.f90 | 57 +-
src/MNH/phys_paramn.f90 | 196 ++--
src/MNH/pressure.f90 | 12 +-
src/MNH/pressurez.f90 | 11 +-
src/MNH/rain_c2r2_khko.f90 | 251 +++--
src/MNH/rain_ice.f90 | 128 +--
src/MNH/rain_ice_elec.f90 | 1216 +++++++++++-----------
src/MNH/rain_ice_fast_rg.f90 | 161 +--
src/MNH/rain_ice_fast_rh.f90 | 92 +-
src/MNH/rain_ice_fast_ri.f90 | 55 +-
src/MNH/rain_ice_fast_rs.f90 | 72 +-
src/MNH/rain_ice_nucleation.f90 | 24 +-
src/MNH/rain_ice_red.f90 | 544 +++++-----
src/MNH/rain_ice_sedimentation_split.f90 | 49 +-
src/MNH/rain_ice_sedimentation_stat.f90 | 48 +-
src/MNH/rain_ice_slow.f90 | 111 +-
src/MNH/rain_ice_warm.f90 | 64 +-
src/MNH/rel_forcingn.f90 | 18 +-
src/MNH/relax2fw_ion.f90 | 32 +-
src/MNH/relaxation.f90 | 62 +-
src/MNH/resolved_cloud.f90 | 120 ++-
src/MNH/resolved_elecn.f90 | 51 +-
src/MNH/shallow_mf_pack.f90 | 30 +-
src/MNH/slow_terms.f90 | 44 +-
src/MNH/tke_eps_sources.f90 | 68 +-
src/MNH/turb.f90 | 212 ++--
src/MNH/two_way.f90 | 54 +-
src/MNH/viscosity.f90 | 59 +-
64 files changed, 3703 insertions(+), 3697 deletions(-)
diff --git a/src/MNH/adv_forcingn.f90 b/src/MNH/adv_forcingn.f90
index 71b55df3e..4c41fa783 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 c57da30e6..ca9eb25e7 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 5e18671a4..596990fd7 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 f1b1d8eb8..cb828e744 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 124d83e2e..1be09d230 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 b81da5894..f7865f3f7 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 fbd159cf2..2ffe63782 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 3970a0c03..d2c15f0ff 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 e533c689b..4a7d01269 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 01634dd55..5587e5331 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 23532ed69..a64f5977a 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 bc26487f9..a5e307588 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 8c623c54a..f150e242b 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 0beb2e0ea..3d599521c 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 4114d7a2e..6d766496d 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 43eb8c20c..7cf04e71e 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 be198dae2..dfda780c2 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 6b1aa32df..3f6f1c8d8 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 2711c496a..d3589d32c 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 f460701f2..bf61da8e3 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 587d2712d..5f6267f22 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 3882ac276..c8d64a892 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 53cdf53a7..d0f7b3c8b 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 28c90601f..04a1a18de 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 bf77de464..7798bd5d4 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 9f1769c81..b2b7d1e2b 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 09ea55a1b..09c86c8a2 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 bf559a2b5..0c5570bd1 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 d7801f90a..a7b7c9849 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 3f654dc33..d16f09478 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 440a53f15..14733bb6d 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 71de50a5e..a456a17bd 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 e896e999a..d47b2f25e 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 ff32fb829..4ec69ac58 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 0fa0909ad..bd8925016 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 d65ad77ee..943a4f103 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 eb0f21630..df99a7930 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 70d3fb441..016a04fdb 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 def6e2370..b64d1d913 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 72e24f8ad..ba64b6d96 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 edf07222d..715a8cba5 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 b2ba41a71..47dd05e85 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 645869054..a80086f59 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 33a65180b..8f2bec61c 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 5b83463e8..3917217e5 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 67b9c2331..568c39de3 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 49d7cec95..d5e2a8e86 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 bcc4e79fd..97bfaf1f8 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 b8b44886d..ca6b946c3 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 349004ee8..370cc07ef 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 895e23656..68eff90a2 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 844d83016..13803b25d 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 15f61b570..e030d5ca7 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 e9c05ea10..47c25af9c 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 cae86dedf..df2dafc7e 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 e6c57710c..b75529537 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 f0257f5f0..7f920b09e 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 535a78327..a19e05f5c 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 33946f46e..e3fb2799f 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 62ffffc26..2b0c58658 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 f903b4e87..d945774a3 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 7f9877b56..026ede038 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 38d2e2857..bd6a98cdc 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 f1f1da39d..e4c5d3ac5 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
--
GitLab