diff --git a/src/MNH/rain_ice.f90 b/src/MNH/rain_ice.f90
index 2db97b874fe104915f2b3655a456b9e734f3a40d..e4a8df5640974a3979ddfccc62777b7cec4a7ee5 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.
@@ -786,8 +786,8 @@ IF( IMICRO >= 0 ) THEN
!
CALL RAIN_ICE_SLOW(GMICRO, ZINVTSTEP, ZRHODREF, &
ZRCT, ZRRT, ZRIT, ZRST, ZRGT, ZRHODJ, ZZT, ZPRES, &
- ZLSFACT, ZLVFACT, &
- ZSSI, PRHODJ, PTHS, PRVS, &
+ ZLSFACT, ZLVFACT, ZSSI, &
+ PRHODJ, PTHS, PRVS, PRCS, PRRS, PRIS, PRSS, PRGS, &
ZRVS, ZRCS, ZRRS, ZRIS, ZRSS, ZRGS, ZTHS, &
ZAI, ZCJ, ZKA, ZDV, ZLBDAS, ZLBDAG)
!
@@ -816,7 +816,7 @@ IF( IMICRO >= 0 ) THEN
CALL RAIN_ICE_WARM(GMICRO, IMICRO, I1, I2, I3, &
ZRHODREF, ZRVT, ZRCT, ZRRT, ZHLC_HCF, ZHLC_LCF, ZHLC_HRC, ZHLC_LRC, &
ZRHODJ, ZPRES, ZZT, ZLBDAR, ZLBDAR_RF, ZLVFACT, ZCJ, ZKA, ZDV, ZRF, ZCF, ZTHT, ZTHLT, &
- PRHODJ, PTHS, PRVS, ZRVS, ZRCS, ZRRS, ZTHS, ZUSW, PEVAP3D)
+ PRHODJ, PTHS, PRVS, PRCS, PRRS, ZRVS, ZRCS, ZRRS, ZTHS, ZUSW, PEVAP3D)
END IF
!
!-------------------------------------------------------------------------------
@@ -826,7 +826,7 @@ IF( IMICRO >= 0 ) THEN
! ----------------------------------------------
!
CALL RAIN_ICE_FAST_RS(PTSTEP, GMICRO, ZRHODREF, ZRVT, ZRCT, ZRRT, ZRST, ZRHODJ, ZPRES, ZZT, &
- ZLBDAR, ZLBDAS, ZLSFACT, ZLVFACT, ZCJ, ZKA, ZDV, PRHODJ, PTHS, &
+ ZLBDAR, ZLBDAS, ZLSFACT, ZLVFACT, ZCJ, ZKA, ZDV, PRHODJ, PTHS, PRCS, PRRS, PRSS, PRGS, &
ZRCS, ZRRS, ZRSS, ZRGS, ZTHS)
!
!-------------------------------------------------------------------------------
@@ -837,8 +837,9 @@ IF( IMICRO >= 0 ) THEN
!
CALL RAIN_ICE_FAST_RG(KRR, GMICRO, ZRHODREF, ZRVT, ZRCT, ZRRT, ZRIT, ZRST, ZRGT, ZCIT, &
ZRHODJ, ZPRES, ZZT, ZLBDAR, ZLBDAS, ZLBDAG, ZLSFACT, ZLVFACT, &
- ZCJ, ZKA, ZDV, PRHODJ, PTHS, ZRCS, ZRRS, ZRIS, ZRSS, ZRGS, ZRHS, ZTHS, &
- ZUSW, ZRDRYG, ZRWETG)
+ ZCJ, ZKA, ZDV, PRHODJ, PTHS, PRCS, PRRS, PRIS, PRSS, PRGS, &
+ ZRCS, ZRRS, ZRIS, ZRSS, ZRGS, ZRHS, ZTHS, &
+ ZUSW, ZRDRYG, ZRWETG, PRHS)
!
!-------------------------------------------------------------------------------
!
@@ -849,6 +850,7 @@ IF( IMICRO >= 0 ) THEN
IF ( KRR == 7 ) THEN
CALL RAIN_ICE_FAST_RH(GMICRO, ZRHODREF, ZRVT, ZRCT, ZRIT, ZRST, ZRGT, ZRHT, ZRHODJ, ZPRES, &
ZZT, ZLBDAS, ZLBDAG, ZLBDAH, ZLSFACT, ZLVFACT, ZCJ, ZKA, ZDV, PRHODJ, PTHS, &
+ PRCS, PRRS, PRIS, PRSS, PRGS, PRHS, &
ZRCS, ZRRS, ZRIS, ZRSS, ZRGS, ZRHS, ZTHS, ZUSW)
END IF
!
@@ -859,7 +861,7 @@ IF( IMICRO >= 0 ) THEN
! -------------------------------------------------------------
!
CALL RAIN_ICE_FAST_RI(GMICRO, ZRHODREF, ZRIT, ZRHODJ, ZZT, ZSSI, ZLSFACT, ZLVFACT, &
- ZAI, ZCJ, PRHODJ, PTHS, ZCIT, ZRCS, ZRIS, ZTHS)
+ ZAI, ZCJ, PRHODJ, PTHS, PRCS, PRIS, ZCIT, ZRCS, ZRIS, ZTHS)
!
!
!-------------------------------------------------------------------------------
diff --git a/src/MNH/rain_ice_elec.f90 b/src/MNH/rain_ice_elec.f90
index b2f0a40e55ccc534e882027cfc6cb8d48f7a2f60..3c290ec0e6c425283058b0f31a85443395e21b66 100644
--- a/src/MNH/rain_ice_elec.f90
+++ b/src/MNH/rain_ice_elec.f90
@@ -2526,17 +2526,17 @@ IMPLICIT NONE
IF (LBUDGET_TH) CALL BUDGET ( &
UNPACK(ZTHS(:),MASK=GMICRO(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:), &
4,'HON_BU_RTH')
- IF (LBUDGET_RC) CALL BUDGET ( &
- UNPACK(ZRCS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
+ IF (LBUDGET_RC) CALL BUDGET ( &
+ UNPACK(ZRCS(:),MASK=GMICRO(:,:,:),FIELD=PRCS)*PRHODJ(:,:,:), &
7,'HON_BU_RRC')
- IF (LBUDGET_RI) CALL BUDGET ( &
- UNPACK(ZRIS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
+ IF (LBUDGET_RI) CALL BUDGET ( &
+ UNPACK(ZRIS(:),MASK=GMICRO(:,:,:),FIELD=PRIS)*PRHODJ(:,:,:), &
9,'HON_BU_RRI')
-!
+
IF (LBUDGET_SV) THEN
- CALL BUDGET (UNPACK(ZQCS(:)*ZRHODJ(:), MASK=GMICRO(:,:,:), FIELD=0.0),&
+ CALL BUDGET (UNPACK(ZQCS(:), MASK=GMICRO(:,:,:), FIELD=PQCS)*PRHODJ(:,:,:), &
12+NSV_ELECBEG+1,'HON_BU_RSV')
- CALL BUDGET (UNPACK(ZQIS(:)*ZRHODJ(:), MASK=GMICRO(:,:,:), FIELD=0.0), &
+ CALL BUDGET (UNPACK(ZQIS(:), MASK=GMICRO(:,:,:), FIELD=PQIS)*PRHODJ(:,:,:), &
12+NSV_ELECBEG+3,'HON_BU_RSV')
END IF
!
@@ -2562,20 +2562,18 @@ IMPLICIT NONE
IF (LBUDGET_TH) CALL BUDGET ( &
UNPACK(ZTHS(:),MASK=GMICRO(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:), &
4,'SFR_BU_RTH')
- IF (LBUDGET_RR) CALL BUDGET ( &
- UNPACK(ZRRS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
+ IF (LBUDGET_RR) CALL BUDGET ( &
+ UNPACK(ZRRS(:),MASK=GMICRO(:,:,:),FIELD=PRRS)*PRHODJ(:,:,:), &
8,'SFR_BU_RRR')
- IF (LBUDGET_RG) CALL BUDGET ( &
- UNPACK(ZRGS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
+ IF (LBUDGET_RG) CALL BUDGET ( &
+ UNPACK(ZRGS(:),MASK=GMICRO(:,:,:),FIELD=PRGS)*PRHODJ(:,:,:), &
11,'SFR_BU_RRG')
-!
IF (LBUDGET_SV) THEN
- CALL BUDGET (UNPACK(ZQRS(:)*ZRHODJ(:), MASK=GMICRO(:,:,:), FIELD=0.0),&
+ CALL BUDGET (UNPACK(ZQRS(:), MASK=GMICRO(:,:,:), FIELD=PQRS)*PRHODJ(:,:,:), &
12+NSV_ELECBEG+2,'SFR_BU_RSV')
- CALL BUDGET (UNPACK(ZQGS(:)*ZRHODJ(:), MASK=GMICRO(:,:,:), FIELD=0.0), &
+ CALL BUDGET (UNPACK(ZQGS(:), MASK=GMICRO(:,:,:), FIELD=PQGS)*PRHODJ(:,:,:), &
12+NSV_ELECBEG+5,'SFR_BU_RSV')
END IF
-
!
!* 3.5.3 compute the deposition, aggregation and autoconversion sources
!
@@ -2620,8 +2618,8 @@ IMPLICIT NONE
IF (LBUDGET_RV) CALL BUDGET ( &
UNPACK(ZRVS(:),MASK=GMICRO(:,:,:),FIELD=PRVS)*PRHODJ(:,:,:), &
6,'DEPS_BU_RRV')
- IF (LBUDGET_RS) CALL BUDGET ( &
- UNPACK(ZRSS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
+ IF (LBUDGET_RS) CALL BUDGET ( &
+ UNPACK(ZRSS(:),MASK=GMICRO(:,:,:),FIELD=PRSS)*PRHODJ(:,:,:), &
10,'DEPS_BU_RRS')
!
IF (LBUDGET_SV) THEN
@@ -2629,7 +2627,7 @@ IMPLICIT NONE
*PRHODJ(:,:,:), 12+NSV_ELECBEG ,'DEPS_BU_RSV')
CALL BUDGET (UNPACK(ZQNIS(:), MASK=GMICRO(:,:,:), FIELD=PQNIS) &
*PRHODJ(:,:,:), 12+NSV_ELECEND ,'DEPS_BU_RSV')
- CALL BUDGET (UNPACK(ZQSS(:)*ZRHODJ(:), MASK=GMICRO(:,:,:), FIELD=0.0), &
+ CALL BUDGET (UNPACK(ZQSS(:), MASK=GMICRO(:,:,:), FIELD=PQSS)*PRHODJ(:,:,:), &
12+NSV_ELECBEG+4,'DEPS_BU_RSV')
END IF
!
@@ -2660,18 +2658,17 @@ IMPLICIT NONE
ZQIS(:) = ZQIS(:) - ZWQ1(:,3)
END WHERE
!
- IF (LBUDGET_RI) CALL BUDGET ( &
- UNPACK(ZRIS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
+ IF (LBUDGET_RI) CALL BUDGET ( &
+ UNPACK(ZRIS(:),MASK=GMICRO(:,:,:),FIELD=PRIS)*PRHODJ(:,:,:), &
9,'AGGS_BU_RRI')
- IF (LBUDGET_RS) CALL BUDGET ( &
- UNPACK(ZRSS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
+ IF (LBUDGET_RS) CALL BUDGET ( &
+ UNPACK(ZRSS(:),MASK=GMICRO(:,:,:),FIELD=PRSS)*PRHODJ(:,:,:), &
10,'AGGS_BU_RRS')
-!
IF (LBUDGET_SV) THEN
- CALL BUDGET (UNPACK(ZQIS(:)*ZRHODJ(:), MASK=GMICRO(:,:,:), FIELD=0.0), &
- 12+NSV_ELECBEG+3,'AGGS_BU_RSV')
- CALL BUDGET (UNPACK(ZQSS(:)*ZRHODJ(:), MASK=GMICRO(:,:,:), FIELD=0.0), &
- 12+NSV_ELECBEG+4,'AGGS_BU_RSV')
+ CALL BUDGET (UNPACK(ZQIS(:), MASK=GMICRO(:,:,:), FIELD=PQIS)*PRHODJ(:,:,:), &
+ 12+NSV_ELECBEG+3,'AGGS_BU_RSV')
+ CALL BUDGET (UNPACK(ZQSS(:), MASK=GMICRO(:,:,:), FIELD=PQSS)*PRHODJ(:,:,:), &
+ 12+NSV_ELECBEG+4,'AGGS_BU_RSV')
END IF
!
CALL ELEC_IAGGS_B() ! QIAGGS_boun
@@ -2681,10 +2678,10 @@ IMPLICIT NONE
XNI_IAGGS(:,:,:) = XNI_IAGGS(:,:,:) * PRHODREF(:,:,:) ! C/m3/s
!
IF (LBUDGET_SV) THEN
- CALL BUDGET (UNPACK(ZQIS(:)*ZRHODJ(:), MASK=GMICRO(:,:,:), FIELD=0.0), &
- 12+NSV_ELECBEG+3,'NIIS_BU_RSV')
- CALL BUDGET (UNPACK(ZQSS(:)*ZRHODJ(:), MASK=GMICRO(:,:,:), FIELD=0.0), &
- 12+NSV_ELECBEG+4,'NIIS_BU_RSV')
+ CALL BUDGET (UNPACK(ZQIS(:), MASK=GMICRO(:,:,:), FIELD=PQIS)*PRHODJ(:,:,:), &
+ 12+NSV_ELECBEG+3,'NIIS_BU_RSV')
+ CALL BUDGET (UNPACK(ZQSS(:), MASK=GMICRO(:,:,:), FIELD=PQSS)*PRHODJ(:,:,:), &
+ 12+NSV_ELECBEG+4,'NIIS_BU_RSV')
END IF
!
!* 3.5.3.5 compute the autoconversion of r_i for r_s production:
@@ -2710,18 +2707,17 @@ IMPLICIT NONE
END WHERE
!
DEALLOCATE(ZCRIAUTI)
- IF (LBUDGET_RI) CALL BUDGET ( &
- UNPACK(ZRIS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
+ IF (LBUDGET_RI) CALL BUDGET ( &
+ UNPACK(ZRIS(:),MASK=GMICRO(:,:,:),FIELD=PRIS)*PRHODJ(:,:,:), &
9,'AUTS_BU_RRI')
- IF (LBUDGET_RS) CALL BUDGET ( &
- UNPACK(ZRSS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
+ IF (LBUDGET_RS) CALL BUDGET ( &
+ UNPACK(ZRSS(:),MASK=GMICRO(:,:,:),FIELD=PRSS)*PRHODJ(:,:,:), &
10,'AUTS_BU_RRS')
-!
- IF (LBU_RSV) THEN
- CALL BUDGET (UNPACK(ZQIS(:)*ZRHODJ(:), MASK=GMICRO(:,:,:), FIELD=0.0), &
- 12+NSV_ELECBEG+3,'AUTS_BU_RSV')
- CALL BUDGET (UNPACK(ZQSS(:)*ZRHODJ(:), MASK=GMICRO(:,:,:), FIELD=0.0), &
- 12+NSV_ELECBEG+4,'AUTS_BU_RSV')
+ IF (LBUDGET_SV) THEN
+ CALL BUDGET (UNPACK(ZQIS(:), MASK=GMICRO(:,:,:), FIELD=PQIS)*PRHODJ(:,:,:), &
+ 12+NSV_ELECBEG+3,'AUTS_BU_RSV')
+ CALL BUDGET (UNPACK(ZQSS(:), MASK=GMICRO(:,:,:), FIELD=PQSS)*PRHODJ(:,:,:), &
+ 12+NSV_ELECBEG+4,'AUTS_BU_RSV')
END IF
!
!* 3.5.3.6 compute the deposition on r_g: RVDEPG & QVDEPG
@@ -2754,17 +2750,17 @@ IMPLICIT NONE
IF (LBUDGET_RV) CALL BUDGET ( &
UNPACK(ZRVS(:),MASK=GMICRO(:,:,:),FIELD=PRVS)*PRHODJ(:,:,:), &
6,'DEPG_BU_RRV')
- IF (LBUDGET_RG) CALL BUDGET ( &
- UNPACK(ZRGS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
+ IF (LBUDGET_RG) CALL BUDGET ( &
+ UNPACK(ZRGS(:),MASK=GMICRO(:,:,:),FIELD=PRGS)*PRHODJ(:,:,:), &
11,'DEPG_BU_RRG')
!
- IF (LBU_RSV) THEN
+ IF (LBUDGET_SV) THEN
CALL BUDGET (UNPACK(ZQPIS(:), MASK=GMICRO(:,:,:), FIELD=PQPIS) &
*PRHODJ(:,:,:), 12+NSV_ELECBEG ,'DEPG_BU_RSV')
CALL BUDGET (UNPACK(ZQNIS(:), MASK=GMICRO(:,:,:), FIELD=PQNIS) &
*PRHODJ(:,:,:), 12+NSV_ELECEND ,'DEPG_BU_RSV')
- CALL BUDGET (UNPACK(ZQGS(:)*ZRHODJ(:), MASK=GMICRO(:,:,:), FIELD=0.0), &
- 12+NSV_ELECBEG+5,'DEPG_BU_RSV')
+ CALL BUDGET (UNPACK(ZQGS(:), MASK=GMICRO(:,:,:), FIELD=PQGS)*PRHODJ(:,:,:), &
+ 12+NSV_ELECBEG+5,'DEPG_BU_RSV')
END IF
!
END SUBROUTINE RAIN_ICE_ELEC_SLOW
@@ -2831,19 +2827,18 @@ REAL :: ZCRIAUTC ! Critical cloud mixing ratio
ZQRS(:) = ZQRS(:) + ZWQ1(:,1)
END WHERE
!
- IF (LBUDGET_RC) CALL BUDGET ( &
- UNPACK(ZRCS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
- 7,'AUTO_BU_RRC')
- IF (LBUDGET_RR) CALL BUDGET ( &
- UNPACK(ZRRS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
+ IF (LBUDGET_RC) CALL BUDGET ( &
+ UNPACK(ZRCS(:),MASK=GMICRO(:,:,:),FIELD=PRCS)*PRHODJ(:,:,:), &
+ 7,'AUTO_BU_RRC')
+ IF (LBUDGET_RR) CALL BUDGET ( &
+ UNPACK(ZRRS(:),MASK=GMICRO(:,:,:),FIELD=PRRS)*PRHODJ(:,:,:), &
8,'AUTO_BU_RRR')
-!
- IF (LBUDGET_SV) THEN
- CALL BUDGET (UNPACK(ZQCS(:)*ZRHODJ(:), MASK=GMICRO(:,:,:), FIELD=0.0), &
- 12+NSV_ELECBEG+1,'AUTO_BU_RSV')
- CALL BUDGET (UNPACK(ZQRS(:)*ZRHODJ(:), MASK=GMICRO(:,:,:), FIELD=0.0), &
- 12+NSV_ELECBEG+2,'AUTO_BU_RSV')
- END IF
+ IF (LBUDGET_SV) THEN
+ CALL BUDGET (UNPACK(ZQCS(:), MASK=GMICRO(:,:,:), FIELD=PQCS)*PRHODJ(:,:,:), &
+ 12+NSV_ELECBEG+1,'AUTO_BU_RSV')
+ CALL BUDGET (UNPACK(ZQRS(:), MASK=GMICRO(:,:,:), FIELD=PQRS)*PRHODJ(:,:,:), &
+ 12+NSV_ELECBEG+2,'AUTO_BU_RSV')
+ END IF
!
!
!* 4.2 compute the accretion of r_c for r_r production: RCACCR & QCACCR
@@ -2865,18 +2860,17 @@ REAL :: ZCRIAUTC ! Critical cloud mixing ratio
ZQRS(:) = ZQRS(:) + ZWQ1(:,2)
ENDWHERE
!
- IF (LBUDGET_RC) CALL BUDGET ( &
- UNPACK(ZRCS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
- 7,'ACCR_BU_RRC')
- IF (LBUDGET_RR) CALL BUDGET ( &
- UNPACK(ZRRS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
- 8,'ACCR_BU_RRR')
-!
- IF (LBU_RSV) THEN
- CALL BUDGET (UNPACK(ZQCS(:)*ZRHODJ(:), MASK=GMICRO(:,:,:), FIELD=0.0), &
- 12+NSV_ELECBEG+1,'ACCR_BU_RSV')
- CALL BUDGET (UNPACK(ZQRS(:)*ZRHODJ(:), MASK=GMICRO(:,:,:), FIELD=0.0), &
- 12+NSV_ELECBEG+2,'ACCR_BU_RSV')
+ IF (LBUDGET_RC) CALL BUDGET ( &
+ UNPACK(ZRCS(:),MASK=GMICRO(:,:,:),FIELD=PRCS)*PRHODJ(:,:,:), &
+ 7,'ACCR_BU_RRC')
+ IF (LBUDGET_RR) CALL BUDGET ( &
+ UNPACK(ZRRS(:),MASK=GMICRO(:,:,:),FIELD=PRRS)*PRHODJ(:,:,:), &
+ 8,'ACCR_BU_RRR')
+ IF (LBUDGET_SV) THEN
+ CALL BUDGET (UNPACK(ZQCS(:), MASK=GMICRO(:,:,:), FIELD=PQCS)*PRHODJ(:,:,:), &
+ 12+NSV_ELECBEG+1,'ACCR_BU_RSV')
+ CALL BUDGET (UNPACK(ZQRS(:), MASK=GMICRO(:,:,:), FIELD=PQRS)*PRHODJ(:,:,:), &
+ 12+NSV_ELECBEG+2,'ACCR_BU_RSV')
END IF
!
!
@@ -2913,8 +2907,8 @@ REAL :: ZCRIAUTC ! Critical cloud mixing ratio
IF (LBUDGET_RV) CALL BUDGET ( &
UNPACK(ZRVS(:),MASK=GMICRO(:,:,:),FIELD=PRVS)*PRHODJ(:,:,:), &
6,'REVA_BU_RRV')
- IF (LBUDGET_RR) CALL BUDGET ( &
- UNPACK(ZRRS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
+ IF (LBUDGET_RR) CALL BUDGET ( &
+ UNPACK(ZRRS(:),MASK=GMICRO(:,:,:),FIELD=PRRS)*PRHODJ(:,:,:), &
8,'REVA_BU_RRR')
ZW(:,:,:)=PEVAP3D(:,:,:)
PEVAP3D(:,:,:)=UNPACK(ZZW(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:))
@@ -2924,8 +2918,8 @@ REAL :: ZCRIAUTC ! Critical cloud mixing ratio
*PRHODJ(:,:,:), 12+NSV_ELECBEG ,'REVA_BU_RSV')
CALL BUDGET (UNPACK(ZQNIS(:), MASK=GMICRO(:,:,:), FIELD=PQNIS) &
*PRHODJ(:,:,:), 12+NSV_ELECEND ,'REVA_BU_RSV')
- CALL BUDGET (UNPACK(ZQRS(:)*ZRHODJ(:), MASK=GMICRO(:,:,:), FIELD=0.0), &
- 12+NSV_ELECBEG+2,'REVA_BU_RSV')
+ CALL BUDGET (UNPACK(ZQRS(:), MASK=GMICRO(:,:,:), FIELD=PQRS)*PRHODJ(:,:,:), &
+ 12+NSV_ELECBEG+2,'REVA_BU_RSV')
END IF
!
END SUBROUTINE RAIN_ICE_ELEC_WARM
@@ -3063,24 +3057,22 @@ IMPLICIT NONE
IF (LBUDGET_TH) CALL BUDGET ( &
UNPACK(ZTHS(:),MASK=GMICRO(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:), &
4,'RIM_BU_RTH')
- IF (LBUDGET_RC) CALL BUDGET ( &
- UNPACK(ZRCS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
- 7,'RIM_BU_RRC')
- IF (LBUDGET_RS) CALL BUDGET ( &
- UNPACK(ZRSS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
- 10,'RIM_BU_RRS')
- IF (LBUDGET_RG) CALL BUDGET ( &
- UNPACK(ZRGS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
- 11,'RIM_BU_RRG')
-!
-!
+ IF (LBUDGET_RC) CALL BUDGET ( &
+ UNPACK(ZRCS(:),MASK=GMICRO(:,:,:),FIELD=PRCS)*PRHODJ(:,:,:), &
+ 7,'RIM_BU_RRC')
+ IF (LBUDGET_RS) CALL BUDGET ( &
+ UNPACK(ZRSS(:),MASK=GMICRO(:,:,:),FIELD=PRSS)*PRHODJ(:,:,:), &
+ 10,'RIM_BU_RRS')
+ IF (LBUDGET_RG) CALL BUDGET ( &
+ UNPACK(ZRGS(:),MASK=GMICRO(:,:,:),FIELD=PRGS)*PRHODJ(:,:,:), &
+ 11,'RIM_BU_RRG')
IF (LBUDGET_SV) THEN
- CALL BUDGET (UNPACK(ZQCS(:)*ZRHODJ(:), MASK=GMICRO(:,:,:), FIELD=0.0), &
- 12+NSV_ELECBEG+1,'RIM_BU_RSV')
- CALL BUDGET (UNPACK(ZQSS(:)*ZRHODJ(:), MASK=GMICRO(:,:,:), FIELD=0.0), &
- 12+NSV_ELECBEG+4,'RIM_BU_RSV')
- CALL BUDGET (UNPACK(ZQGS(:)*ZRHODJ(:), MASK=GMICRO(:,:,:), FIELD=0.0), &
- 12+NSV_ELECBEG+5,'RIM_BU_RSV')
+ CALL BUDGET (UNPACK(ZQCS(:), MASK=GMICRO(:,:,:), FIELD=PQCS)*PRHODJ(:,:,:), &
+ 12+NSV_ELECBEG+1,'RIM_BU_RSV')
+ CALL BUDGET (UNPACK(ZQSS(:), MASK=GMICRO(:,:,:), FIELD=PQSS)*PRHODJ(:,:,:), &
+ 12+NSV_ELECBEG+4,'RIM_BU_RSV')
+ CALL BUDGET (UNPACK(ZQGS(:), MASK=GMICRO(:,:,:), FIELD=PQGS)*PRHODJ(:,:,:), &
+ 12+NSV_ELECBEG+5,'RIM_BU_RSV')
END IF
!
DEALLOCATE(GRIM)
@@ -3241,23 +3233,22 @@ IMPLICIT NONE
IF (LBUDGET_TH) CALL BUDGET ( &
UNPACK(ZTHS(:),MASK=GMICRO(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:), &
4,'ACC_BU_RTH')
- IF (LBUDGET_RR) CALL BUDGET ( &
- UNPACK(ZRRS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
- 8,'ACC_BU_RRR')
- IF (LBUDGET_RS) CALL BUDGET ( &
- UNPACK(ZRSS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
- 10,'ACC_BU_RRS')
- IF (LBUDGET_RG) CALL BUDGET ( &
- UNPACK(ZRGS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
- 11,'ACC_BU_RRG')
-!
+ IF (LBUDGET_RR) CALL BUDGET ( &
+ UNPACK(ZRRS(:),MASK=GMICRO(:,:,:),FIELD=PRRS)*PRHODJ(:,:,:), &
+ 8,'ACC_BU_RRR')
+ IF (LBUDGET_RS) CALL BUDGET ( &
+ UNPACK(ZRSS(:),MASK=GMICRO(:,:,:),FIELD=PRSS)*PRHODJ(:,:,:), &
+ 10,'ACC_BU_RRS')
+ IF (LBUDGET_RG) CALL BUDGET ( &
+ UNPACK(ZRGS(:),MASK=GMICRO(:,:,:),FIELD=PRGS)*PRHODJ(:,:,:), &
+ 11,'ACC_BU_RRG')
IF (LBUDGET_SV) THEN
- CALL BUDGET (UNPACK(ZQRS(:)*ZRHODJ(:), MASK=GMICRO(:,:,:), FIELD=0.0), &
- 12+NSV_ELECBEG+2,'ACC_BU_RSV')
- CALL BUDGET (UNPACK(ZQSS(:)*ZRHODJ(:), MASK=GMICRO(:,:,:), FIELD=0.0), &
- 12+NSV_ELECBEG+4,'ACC_BU_RSV')
- CALL BUDGET (UNPACK(ZQGS(:)*ZRHODJ(:), MASK=GMICRO(:,:,:), FIELD=0.0), &
- 12+NSV_ELECBEG+5,'ACC_BU_RSV')
+ CALL BUDGET (UNPACK(ZQRS(:), MASK=GMICRO(:,:,:), FIELD=PQRS)*PRHODJ(:,:,:), &
+ 12+NSV_ELECBEG+2,'ACC_BU_RSV')
+ CALL BUDGET (UNPACK(ZQSS(:), MASK=GMICRO(:,:,:), FIELD=PQSS)*PRHODJ(:,:,:), &
+ 12+NSV_ELECBEG+4,'ACC_BU_RSV')
+ CALL BUDGET (UNPACK(ZQGS(:), MASK=GMICRO(:,:,:), FIELD=PQGS)*PRHODJ(:,:,:), &
+ 12+NSV_ELECBEG+5,'ACC_BU_RSV')
END IF
!
!* 5.3 Conversion-Melting of the aggregates: RSMLT & QSMLT
@@ -3294,18 +3285,17 @@ IMPLICIT NONE
ZQSS(:) = ZQSS(:) - ZWQ1(:,7)
ENDWHERE
!
- IF (LBUDGET_RS) CALL BUDGET ( &
- UNPACK(ZRSS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
+ IF (LBUDGET_RS) CALL BUDGET ( &
+ UNPACK(ZRSS(:),MASK=GMICRO(:,:,:),FIELD=PRSS)*PRHODJ(:,:,:), &
10,'CMEL_BU_RRS')
- IF (LBUDGET_RG) CALL BUDGET ( &
- UNPACK(ZRGS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
+ IF (LBUDGET_RG) CALL BUDGET ( &
+ UNPACK(ZRGS(:),MASK=GMICRO(:,:,:),FIELD=PRGS)*PRHODJ(:,:,:), &
11,'CMEL_BU_RRG')
-!
IF (LBUDGET_SV) THEN
- CALL BUDGET (UNPACK(ZQSS(:)*ZRHODJ(:), MASK=GMICRO(:,:,:), FIELD=0.0), &
- 12+NSV_ELECBEG+4,'CMEL_BU_RSV')
- CALL BUDGET (UNPACK(ZQGS(:)*ZRHODJ(:), MASK=GMICRO(:,:,:), FIELD=0.0), &
- 12+NSV_ELECBEG+5,'CMEL_BU_RSV')
+ CALL BUDGET (UNPACK(ZQSS(:), MASK=GMICRO(:,:,:), FIELD=PQSS)*PRHODJ(:,:,:), &
+ 12+NSV_ELECBEG+4,'CMEL_BU_RSV')
+ CALL BUDGET (UNPACK(ZQGS(:), MASK=GMICRO(:,:,:), FIELD=PQGS)*PRHODJ(:,:,:), &
+ 12+NSV_ELECBEG+5,'CMEL_BU_RSV')
END IF
!
END SUBROUTINE RAIN_ICE_ELEC_FAST_RS
@@ -3362,23 +3352,22 @@ IMPLICIT NONE
IF (LBUDGET_TH) CALL BUDGET ( &
UNPACK(ZTHS(:),MASK=GMICRO(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:), &
4,'CFRZ_BU_RTH')
- IF (LBUDGET_RR) CALL BUDGET ( &
- UNPACK(ZRRS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
+ IF (LBUDGET_RR) CALL BUDGET ( &
+ UNPACK(ZRRS(:),MASK=GMICRO(:,:,:),FIELD=PRRS)*PRHODJ(:,:,:), &
8,'CFRZ_BU_RRR')
- IF (LBUDGET_RI) CALL BUDGET ( &
- UNPACK(ZRIS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
+ IF (LBUDGET_RI) CALL BUDGET ( &
+ UNPACK(ZRIS(:),MASK=GMICRO(:,:,:),FIELD=PRIS)*PRHODJ(:,:,:), &
9,'CFRZ_BU_RRI')
- IF (LBUDGET_RG) CALL BUDGET ( &
- UNPACK(ZRGS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
+ IF (LBUDGET_RG) CALL BUDGET ( &
+ UNPACK(ZRGS(:),MASK=GMICRO(:,:,:),FIELD=PRGS)*PRHODJ(:,:,:), &
11,'CFRZ_BU_RRG')
-!
- IF (LBU_RSV) THEN
- CALL BUDGET (UNPACK(ZQRS(:)*ZRHODJ(:), MASK=GMICRO(:,:,:), FIELD=0.0), &
- 12+NSV_ELECBEG+2,'CFRZ_BU_RSV')
- CALL BUDGET (UNPACK(ZQIS(:)*ZRHODJ(:), MASK=GMICRO(:,:,:), FIELD=0.0), &
- 12+NSV_ELECBEG+3,'CFRZ_BU_RSV')
- CALL BUDGET (UNPACK(ZQGS(:)*ZRHODJ(:), MASK=GMICRO(:,:,:), FIELD=0.0), &
- 12+NSV_ELECBEG+5,'CFRZ_BU_RSV')
+ IF (LBUDGET_SV) THEN
+ CALL BUDGET (UNPACK(ZQRS(:), MASK=GMICRO(:,:,:), FIELD=PQRS)*PRHODJ(:,:,:), &
+ 12+NSV_ELECBEG+2,'CFRZ_BU_RSV')
+ CALL BUDGET (UNPACK(ZQIS(:), MASK=GMICRO(:,:,:), FIELD=PQIS)*PRHODJ(:,:,:), &
+ 12+NSV_ELECBEG+3,'CFRZ_BU_RSV')
+ CALL BUDGET (UNPACK(ZQGS(:), MASK=GMICRO(:,:,:), FIELD=PQGS)*PRHODJ(:,:,:), &
+ 12+NSV_ELECBEG+5,'CFRZ_BU_RSV')
END IF
!
!
@@ -3745,38 +3734,37 @@ IMPLICIT NONE
IF (LBUDGET_TH) CALL BUDGET ( &
UNPACK(ZTHS(:),MASK=GMICRO(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:), &
4,'WETG_BU_RTH')
- IF (LBUDGET_RC) CALL BUDGET ( &
- UNPACK(ZRCS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
+ IF (LBUDGET_RC) CALL BUDGET ( &
+ UNPACK(ZRCS(:),MASK=GMICRO(:,:,:),FIELD=PRCS)*PRHODJ(:,:,:), &
7,'WETG_BU_RRC')
- IF (LBUDGET_RR) CALL BUDGET ( &
- UNPACK(ZRRS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
+ IF (LBUDGET_RR) CALL BUDGET ( &
+ UNPACK(ZRRS(:),MASK=GMICRO(:,:,:),FIELD=PRRS)*PRHODJ(:,:,:), &
8,'WETG_BU_RRR')
- IF (LBUDGET_RI) CALL BUDGET ( &
- UNPACK(ZRIS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
+ IF (LBUDGET_RI) CALL BUDGET ( &
+ UNPACK(ZRIS(:),MASK=GMICRO(:,:,:),FIELD=PRIS)*PRHODJ(:,:,:), &
9,'WETG_BU_RRI')
- IF (LBUDGET_RS) CALL BUDGET ( &
- UNPACK(ZRSS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
+ IF (LBUDGET_RS) CALL BUDGET ( &
+ UNPACK(ZRSS(:),MASK=GMICRO(:,:,:),FIELD=PRSS)*PRHODJ(:,:,:), &
10,'WETG_BU_RRS')
- IF (LBUDGET_RG) CALL BUDGET ( &
- UNPACK(ZRGS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
+ IF (LBUDGET_RG) CALL BUDGET ( &
+ UNPACK(ZRGS(:),MASK=GMICRO(:,:,:),FIELD=PRGS)*PRHODJ(:,:,:), &
11,'WETG_BU_RRG')
IF ( KRR == 7 ) THEN
- IF (LBUDGET_RH) CALL BUDGET ( &
- UNPACK(ZRHS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
+ IF (LBUDGET_RH) CALL BUDGET ( &
+ UNPACK(ZRHS(:),MASK=GMICRO(:,:,:),FIELD=PRHS)*PRHODJ(:,:,:), &
12,'WETG_BU_RRH')
END IF
-!
- IF (LBU_RSV) THEN
- CALL BUDGET (UNPACK(ZQCS(:)*ZRHODJ(:), MASK=GMICRO(:,:,:), FIELD=0.0), &
- 12+NSV_ELECBEG+1,'WETG_BU_RSV')
- CALL BUDGET (UNPACK(ZQRS(:)*ZRHODJ(:), MASK=GMICRO(:,:,:), FIELD=0.0), &
- 12+NSV_ELECBEG+2,'WETG_BU_RSV')
- CALL BUDGET (UNPACK(ZQIS(:)*ZRHODJ(:), MASK=GMICRO(:,:,:), FIELD=0.0), &
- 12+NSV_ELECBEG+3,'WETG_BU_RSV')
- CALL BUDGET (UNPACK(ZQSS(:)*ZRHODJ(:), MASK=GMICRO(:,:,:), FIELD=0.0), &
- 12+NSV_ELECBEG+4,'WETG_BU_RSV')
- CALL BUDGET (UNPACK(ZQGS(:)*ZRHODJ(:), MASK=GMICRO(:,:,:), FIELD=0.0), &
- 12+NSV_ELECBEG+5,'WETG_BU_RSV')
+ IF (LBUDGET_SV) THEN
+ CALL BUDGET (UNPACK(ZQCS(:), MASK=GMICRO(:,:,:), FIELD=PQCS)*PRHODJ(:,:,:), &
+ 12+NSV_ELECBEG+1,'WETG_BU_RSV')
+ CALL BUDGET (UNPACK(ZQRS(:), MASK=GMICRO(:,:,:), FIELD=PQRS)*PRHODJ(:,:,:), &
+ 12+NSV_ELECBEG+2,'WETG_BU_RSV')
+ CALL BUDGET (UNPACK(ZQIS(:), MASK=GMICRO(:,:,:), FIELD=PQIS)*PRHODJ(:,:,:), &
+ 12+NSV_ELECBEG+3,'WETG_BU_RSV')
+ CALL BUDGET (UNPACK(ZQSS(:), MASK=GMICRO(:,:,:), FIELD=PQSS)*PRHODJ(:,:,:), &
+ 12+NSV_ELECBEG+4,'WETG_BU_RSV')
+ CALL BUDGET (UNPACK(ZQGS(:), MASK=GMICRO(:,:,:), FIELD=PQGS)*PRHODJ(:,:,:), &
+ 12+NSV_ELECBEG+5,'WETG_BU_RSV')
END IF
!
WHERE (ZRGT(:) > XRTMIN(6) .AND. ZZT(:) < XTT .AND. & ! Dry
@@ -3800,33 +3788,36 @@ IMPLICIT NONE
IF (LBUDGET_TH) CALL BUDGET ( &
UNPACK(ZTHS(:),MASK=GMICRO(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:), &
4,'DRYG_BU_RTH')
- IF (LBUDGET_RC) CALL BUDGET ( &
- UNPACK(ZRCS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
+ IF (LBUDGET_RC) CALL BUDGET ( &
+ UNPACK(ZRCS(:),MASK=GMICRO(:,:,:),FIELD=PRCS)*PRHODJ(:,:,:), &
7,'DRYG_BU_RRC')
- IF (LBUDGET_RR) CALL BUDGET ( &
- UNPACK(ZRRS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
+ IF (LBUDGET_RR) CALL BUDGET ( &
+ UNPACK(ZRRS(:),MASK=GMICRO(:,:,:),FIELD=PRRS)*PRHODJ(:,:,:), &
8,'DRYG_BU_RRR')
- IF (LBUDGET_RI) CALL BUDGET ( &
- UNPACK(ZRIS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
+ IF (LBUDGET_RI) CALL BUDGET ( &
+ UNPACK(ZRIS(:),MASK=GMICRO(:,:,:),FIELD=PRIS)*PRHODJ(:,:,:), &
9,'DRYG_BU_RRI')
- IF (LBUDGET_RS) CALL BUDGET ( &
- UNPACK(ZRSS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
+ IF (LBUDGET_RS) CALL BUDGET ( &
+ UNPACK(ZRSS(:),MASK=GMICRO(:,:,:),FIELD=PRSS)*PRHODJ(:,:,:), &
10,'DRYG_BU_RRS')
- IF (LBUDGET_RG) CALL BUDGET ( &
- UNPACK(ZRGS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
+ IF (LBUDGET_RG) CALL BUDGET ( &
+ UNPACK(ZRGS(:),MASK=GMICRO(:,:,:),FIELD=PRGS)*PRHODJ(:,:,:), &
11,'DRYG_BU_RRG')
-!
IF (LBUDGET_SV) THEN
- CALL BUDGET (UNPACK(ZQCS(:)*ZRHODJ(:), MASK=GMICRO(:,:,:), FIELD=0.0), &
- 12+NSV_ELECBEG+1,'DRYG_BU_RSV')
- CALL BUDGET (UNPACK(ZQRS(:)*ZRHODJ(:), MASK=GMICRO(:,:,:), FIELD=0.0), &
- 12+NSV_ELECBEG+2,'DRYG_BU_RSV')
- CALL BUDGET (UNPACK(ZQIS(:)*ZRHODJ(:), MASK=GMICRO(:,:,:), FIELD=0.0), &
- 12+NSV_ELECBEG+3,'DRYG_BU_RSV')
- CALL BUDGET (UNPACK(ZQSS(:)*ZRHODJ(:), MASK=GMICRO(:,:,:), FIELD=0.0), &
- 12+NSV_ELECBEG+4,'DRYG_BU_RSV')
- CALL BUDGET (UNPACK(ZQGS(:)*ZRHODJ(:), MASK=GMICRO(:,:,:), FIELD=0.0), &
- 12+NSV_ELECBEG+5,'DRYG_BU_RSV')
+ CALL BUDGET (UNPACK(ZQPIS(:), MASK=GMICRO(:,:,:), FIELD=PQPIS) &
+ *PRHODJ(:,:,:), 12+NSV_ELECBEG ,'DEPS_BU_RSV')
+ CALL BUDGET (UNPACK(ZQCS(:), MASK=GMICRO(:,:,:), FIELD=PQCS)*PRHODJ(:,:,:), &
+ 12+NSV_ELECBEG+1,'DRYG_BU_RSV')
+ CALL BUDGET (UNPACK(ZQRS(:), MASK=GMICRO(:,:,:), FIELD=PQRS)*PRHODJ(:,:,:), &
+ 12+NSV_ELECBEG+2,'DRYG_BU_RSV')
+ CALL BUDGET (UNPACK(ZQIS(:), MASK=GMICRO(:,:,:), FIELD=PQIS)*PRHODJ(:,:,:), &
+ 12+NSV_ELECBEG+3,'DRYG_BU_RSV')
+ CALL BUDGET (UNPACK(ZQSS(:), MASK=GMICRO(:,:,:), FIELD=PQSS)*PRHODJ(:,:,:), &
+ 12+NSV_ELECBEG+4,'DRYG_BU_RSV')
+ CALL BUDGET (UNPACK(ZQGS(:), MASK=GMICRO(:,:,:), FIELD=PQGS)*PRHODJ(:,:,:), &
+ 12+NSV_ELECBEG+5,'DRYG_BU_RSV')
+ CALL BUDGET (UNPACK(ZQNIS(:), MASK=GMICRO(:,:,:), FIELD=PQNIS) &
+ *PRHODJ(:,:,:), 12+NSV_ELECEND ,'DEPS_BU_RSV')
END IF
!
!
@@ -3845,10 +3836,10 @@ IMPLICIT NONE
END IF
!
IF (LBUDGET_SV) THEN
- CALL BUDGET (UNPACK(ZQCS(:)*ZRHODJ(:), MASK=GMICRO(:,:,:), FIELD=0.0), &
- 12+NSV_ELECBEG+1,'INCG_BU_RSV')
- CALL BUDGET (UNPACK(ZQGS(:)*ZRHODJ(:), MASK=GMICRO(:,:,:), FIELD=0.0), &
- 12+NSV_ELECBEG+5,'INCG_BU_RSV')
+ CALL BUDGET (UNPACK(ZQCS(:), MASK=GMICRO(:,:,:), FIELD=PQCS)*PRHODJ(:,:,:), &
+ 12+NSV_ELECBEG+1,'INCG_BU_RSV')
+ CALL BUDGET (UNPACK(ZQGS(:), MASK=GMICRO(:,:,:), FIELD=PQGS)*PRHODJ(:,:,:), &
+ 12+NSV_ELECBEG+5,'INCG_BU_RSV')
END IF
!
!
@@ -3886,19 +3877,18 @@ IMPLICIT NONE
IF (LBUDGET_TH) CALL BUDGET ( &
UNPACK(ZTHS(:),MASK=GMICRO(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:),&
4,'GMLT_BU_RTH')
- IF (LBUDGET_RR) CALL BUDGET ( &
- UNPACK(ZRRS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
- 8,'GMLT_BU_RRR')
- IF (LBUDGET_RG) CALL BUDGET ( &
- UNPACK(ZRGS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
- 11,'GMLT_BU_RRG')
-!
- IF (LBUDGET_SV) THEN
- CALL BUDGET (UNPACK(ZQRS(:)*ZRHODJ(:), MASK=GMICRO(:,:,:), FIELD=0.0), &
- 12+NSV_ELECBEG+2,'GMLT_BU_RSV')
- CALL BUDGET (UNPACK(ZQGS(:)*ZRHODJ(:), MASK=GMICRO(:,:,:), FIELD=0.0), &
- 12+NSV_ELECBEG+5,'GMLT_BU_RSV')
- END IF
+ IF (LBUDGET_RR) CALL BUDGET ( &
+ UNPACK(ZRRS(:),MASK=GMICRO(:,:,:),FIELD=PRRS)*PRHODJ(:,:,:), &
+ 8,'GMLT_BU_RRR')
+ IF (LBUDGET_RG) CALL BUDGET ( &
+ UNPACK(ZRGS(:),MASK=GMICRO(:,:,:),FIELD=PRGS)*PRHODJ(:,:,:), &
+ 11,'GMLT_BU_RRG')
+ IF (LBUDGET_SV) THEN
+ CALL BUDGET (UNPACK(ZQRS(:), MASK=GMICRO(:,:,:), FIELD=PQRS)*PRHODJ(:,:,:), &
+ 12+NSV_ELECBEG+2,'GMLT_BU_RSV')
+ CALL BUDGET (UNPACK(ZQGS(:), MASK=GMICRO(:,:,:), FIELD=PQGS)*PRHODJ(:,:,:), &
+ 12+NSV_ELECBEG+5,'GMLT_BU_RSV')
+ END IF
!
END SUBROUTINE RAIN_ICE_ELEC_FAST_RG
!
@@ -4127,23 +4117,23 @@ IMPLICIT NONE
IF (LBUDGET_TH) CALL BUDGET ( &
UNPACK(ZTHS(:),MASK=GMICRO(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:),&
4,'WETH_BU_RTH')
- IF (LBUDGET_RC) CALL BUDGET ( &
- UNPACK(ZRCS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
+ IF (LBUDGET_RC) CALL BUDGET ( &
+ UNPACK(ZRCS(:),MASK=GMICRO(:,:,:),FIELD=PRCS)*PRHODJ(:,:,:), &
7,'WETH_BU_RRC')
- IF (LBUDGET_RR) CALL BUDGET ( &
- UNPACK(ZRRS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
+ IF (LBUDGET_RR) CALL BUDGET ( &
+ UNPACK(ZRRS(:),MASK=GMICRO(:,:,:),FIELD=PRRS)*PRHODJ(:,:,:), &
8,'WETH_BU_RRR')
- IF (LBUDGET_RI) CALL BUDGET ( &
- UNPACK(ZRIS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
+ IF (LBUDGET_RI) CALL BUDGET ( &
+ UNPACK(ZRIS(:),MASK=GMICRO(:,:,:),FIELD=PRIS)*PRHODJ(:,:,:), &
9,'WETH_BU_RRI')
- IF (LBUDGET_RS) CALL BUDGET ( &
- UNPACK(ZRSS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
+ IF (LBUDGET_RS) CALL BUDGET ( &
+ UNPACK(ZRSS(:),MASK=GMICRO(:,:,:),FIELD=PRSS)*PRHODJ(:,:,:), &
10,'WETH_BU_RRS')
- IF (LBUDGET_RG) CALL BUDGET ( &
- UNPACK(ZRGS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
+ IF (LBUDGET_RG) CALL BUDGET ( &
+ UNPACK(ZRGS(:),MASK=GMICRO(:,:,:),FIELD=PRGS)*PRHODJ(:,:,:), &
11,'WETH_BU_RRG')
- IF (LBUDGET_RH) CALL BUDGET ( &
- UNPACK(ZRHS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
+ IF (LBUDGET_RH) CALL BUDGET ( &
+ UNPACK(ZRHS(:),MASK=GMICRO(:,:,:),FIELD=PRHS)*PRHODJ(:,:,:), &
12,'WETH_BU_RRH')
!
IF (IHAIL > 0) THEN
@@ -4186,11 +4176,11 @@ IMPLICIT NONE
IF (LBUDGET_TH) CALL BUDGET ( &
UNPACK(ZTHS(:),MASK=GMICRO(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:),&
4,'HMLT_BU_RTH')
- IF (LBUDGET_RR) CALL BUDGET ( &
- UNPACK(ZRRS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
+ IF (LBUDGET_RR) CALL BUDGET ( &
+ UNPACK(ZRRS(:),MASK=GMICRO(:,:,:),FIELD=PRRS)*PRHODJ(:,:,:), &
8,'HMLT_BU_RRR')
- IF (LBUDGET_RH) CALL BUDGET ( &
- UNPACK(ZRHS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
+ IF (LBUDGET_RH) CALL BUDGET ( &
+ UNPACK(ZRHS(:),MASK=GMICRO(:,:,:),FIELD=PRHS)*PRHODJ(:,:,:), &
12,'HMLT_BU_RRH')
!
END SUBROUTINE RAIN_ICE_ELEC_FAST_RH
@@ -4224,18 +4214,17 @@ IMPLICIT NONE
IF (LBUDGET_TH) CALL BUDGET ( &
UNPACK(ZTHS(:),MASK=GMICRO(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:), &
4,'IMLT_BU_RTH')
- IF (LBUDGET_RC) CALL BUDGET ( &
- UNPACK(ZRCS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
+ IF (LBUDGET_RC) CALL BUDGET ( &
+ UNPACK(ZRCS(:),MASK=GMICRO(:,:,:),FIELD=PRCS)*PRHODJ(:,:,:), &
7,'IMLT_BU_RRC')
- IF (LBUDGET_RI) CALL BUDGET ( &
- UNPACK(ZRIS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
+ IF (LBUDGET_RI) CALL BUDGET ( &
+ UNPACK(ZRIS(:),MASK=GMICRO(:,:,:),FIELD=PRIS)*PRHODJ(:,:,:), &
9,'IMLT_BU_RRI')
-!
IF (LBUDGET_SV) THEN
- CALL BUDGET (UNPACK(ZQCS(:)*ZRHODJ(:), MASK=GMICRO(:,:,:), FIELD=0.0), &
- 12+NSV_ELECBEG+1,'IMLT_BU_RSV')
- CALL BUDGET (UNPACK(ZQIS(:)*ZRHODJ(:), MASK=GMICRO(:,:,:), FIELD=0.0), &
- 12+NSV_ELECBEG+3,'IMLT_BU_RSV')
+ CALL BUDGET (UNPACK(ZQCS(:), MASK=GMICRO(:,:,:), FIELD=PQCS)*PRHODJ(:,:,:), &
+ 12+NSV_ELECBEG+1,'IMLT_BU_RSV')
+ CALL BUDGET (UNPACK(ZQIS(:), MASK=GMICRO(:,:,:), FIELD=PQIS)*PRHODJ(:,:,:), &
+ 12+NSV_ELECBEG+3,'IMLT_BU_RSV')
END IF
!
!* 7.2 Bergeron-Findeisen effect: RCBERI
@@ -4266,18 +4255,17 @@ IMPLICIT NONE
IF (LBUDGET_TH) CALL BUDGET ( &
UNPACK(ZTHS(:),MASK=GMICRO(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:), &
4,'BERFI_BU_RTH')
- IF (LBUDGET_RC) CALL BUDGET ( &
- UNPACK(ZRCS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
- 7,'BERFI_BU_RRC')
- IF (LBUDGET_RI) CALL BUDGET ( &
- UNPACK(ZRIS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
- 9,'BERFI_BU_RRI')
-!
+ IF (LBUDGET_RC) CALL BUDGET ( &
+ UNPACK(ZRCS(:),MASK=GMICRO(:,:,:),FIELD=PRCS)*PRHODJ(:,:,:), &
+ 7,'BERFI_BU_RRC')
+ IF (LBUDGET_RI) CALL BUDGET ( &
+ UNPACK(ZRIS(:),MASK=GMICRO(:,:,:),FIELD=PRIS)*PRHODJ(:,:,:), &
+ 9,'BERFI_BU_RRI')
IF (LBUDGET_SV) THEN
- CALL BUDGET (UNPACK(ZQCS(:)*ZRHODJ(:), MASK=GMICRO(:,:,:), FIELD=0.0), &
- 12+NSV_ELECBEG+1,'BERFI_BU_RSV')
- CALL BUDGET (UNPACK(ZQIS(:)*ZRHODJ(:), MASK=GMICRO(:,:,:), FIELD=0.0), &
- 12+NSV_ELECBEG+3,'BERFI_BU_RSV')
+ CALL BUDGET (UNPACK(ZQCS(:), MASK=GMICRO(:,:,:), FIELD=PQCS)*PRHODJ(:,:,:), &
+ 12+NSV_ELECBEG+1,'BERFI_BU_RSV')
+ CALL BUDGET (UNPACK(ZQIS(:), MASK=GMICRO(:,:,:), FIELD=PQIS)*PRHODJ(:,:,:), &
+ 12+NSV_ELECBEG+3,'BERFI_BU_RSV')
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 7c2b0aeb7a600ad27138e4e99475ae6029b53dd8..214e1f2bed24a26c0b2b30183e2eb98a612e32fe 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.
@@ -21,8 +21,9 @@ CONTAINS
SUBROUTINE RAIN_ICE_FAST_RG(KRR, OMICRO, PRHODREF, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, PCIT, &
PRHODJ, PPRES, PZT, PLBDAR, PLBDAS, PLBDAG, PLSFACT, PLVFACT, &
- PCJ, PKA, PDV, PRHODJ3D, PTHS3D, PRCS, PRRS, PRIS, PRSS, PRGS, PRHS, PTHS, &
- PUSW, PRDRYG, PRWETG)
+ PCJ, PKA, PDV, PRHODJ3D, PTHS3D, PRCS3D, PRRS3D, PRIS3D, PRSS3D, PRGS3D, &
+ PRCS, PRRS, PRIS, PRSS, PRGS, PRHS, PTHS, &
+ PUSW, PRDRYG, PRWETG, PRHS3D)
!
!* 0. DECLARATIONS
@@ -65,6 +66,11 @@ REAL, DIMENSION(:), intent(in) :: PKA ! Thermal conductivity of
REAL, DIMENSION(:), intent(in) :: PDV ! Diffusivity of water vapor in the air
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ3D ! Dry density * Jacobian
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHS3D ! Theta source
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCS3D ! Cloud vapor m.r. source
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRS3D ! Rain water m.r. source
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRIS3D ! Ice vapor m.r. source
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRSS3D ! Snow/aggregate m.r. source
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRGS3D ! Graupel m.r. source
REAL, DIMENSION(:), INTENT(INOUT) :: PRCS ! Cloud water m.r. source
REAL, DIMENSION(:), INTENT(INOUT) :: PRRS ! Rain water m.r. source
REAL, DIMENSION(:), INTENT(INOUT) :: PRIS ! Pristine ice m.r. source
@@ -75,6 +81,7 @@ REAL, DIMENSION(:), INTENT(INOUT) :: PTHS ! Theta source
REAL, DIMENSION(:), intent(inout) :: PUSW ! Undersaturation over water
REAL, DIMENSION(:), intent(out) :: PRDRYG ! Dry growth rate of the graupeln
REAL, DIMENSION(:), intent(out) :: PRWETG ! Wet growth rate of the graupeln
+REAL, DIMENSION(:,:,:), INTENT(IN), optional :: PRHS3D ! Hail m.r. source
!
!* 0.2 declaration of local variables
!
@@ -104,18 +111,18 @@ 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(:,:,:), &
+ IF (LBUDGET_TH) CALL BUDGET ( &
+ UNPACK(PTHS(:),MASK=OMICRO(:,:,:),FIELD=PTHS3D)*PRHODJ3D(:,:,:), &
4,'CFRZ_BU_RTH')
- IF (LBUDGET_RR) CALL BUDGET ( &
- UNPACK(PRRS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
- 8,'CFRZ_BU_RRR')
- IF (LBUDGET_RI) CALL BUDGET ( &
- UNPACK(PRIS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
- 9,'CFRZ_BU_RRI')
- IF (LBUDGET_RG) CALL BUDGET ( &
- UNPACK(PRGS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
- 11,'CFRZ_BU_RRG')
+ IF (LBUDGET_RR) CALL BUDGET ( &
+ UNPACK(PRRS(:),MASK=OMICRO(:,:,:),FIELD=PRRS3D)*PRHODJ3D(:,:,:), &
+ 8,'CFRZ_BU_RRR')
+ IF (LBUDGET_RI) CALL BUDGET ( &
+ UNPACK(PRIS(:),MASK=OMICRO(:,:,:),FIELD=PRIS3D)*PRHODJ3D(:,:,:), &
+ 9,'CFRZ_BU_RRI')
+ IF (LBUDGET_RG) CALL BUDGET ( &
+ UNPACK(PRGS(:),MASK=OMICRO(:,:,:),FIELD=PRGS3D)*PRHODJ3D(:,:,:), &
+ 11,'CFRZ_BU_RRG')
!
!* 6.2 compute the Dry growth case
!
@@ -344,30 +351,29 @@ REAL, DIMENSION(size(PRHODREF),7) :: ZZW1 ! Work arrays
! f(L_f*(RCWETG+RRWETG))
END WHERE
END IF
- IF (LBUDGET_TH) CALL BUDGET ( &
- UNPACK(PTHS(:),MASK=OMICRO(:,:,:),FIELD=PTHS3D)*PRHODJ3D(:,:,:), &
+ IF (LBUDGET_TH) CALL BUDGET ( &
+ UNPACK(PTHS(:),MASK=OMICRO(:,:,:),FIELD=PTHS3D)*PRHODJ3D(:,:,:), &
4,'WETG_BU_RTH')
- IF (LBUDGET_RC) CALL BUDGET ( &
- UNPACK(PRCS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
- 7,'WETG_BU_RRC')
- IF (LBUDGET_RR) CALL BUDGET ( &
- UNPACK(PRRS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
- 8,'WETG_BU_RRR')
- IF (LBUDGET_RI) CALL BUDGET ( &
- UNPACK(PRIS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
- 9,'WETG_BU_RRI')
- IF (LBUDGET_RS) CALL BUDGET ( &
- UNPACK(PRSS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
- 10,'WETG_BU_RRS')
- IF (LBUDGET_RG) CALL BUDGET ( &
- UNPACK(PRGS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
- 11,'WETG_BU_RRG')
+ IF (LBUDGET_RC) CALL BUDGET ( &
+ UNPACK(PRCS(:),MASK=OMICRO(:,:,:),FIELD=PRCS3D)*PRHODJ3D(:,:,:), &
+ 7,'WETG_BU_RRC')
+ IF (LBUDGET_RR) CALL BUDGET ( &
+ UNPACK(PRRS(:),MASK=OMICRO(:,:,:),FIELD=PRRS3D)*PRHODJ3D(:,:,:), &
+ 8,'WETG_BU_RRR')
+ IF (LBUDGET_RI) CALL BUDGET ( &
+ UNPACK(PRIS(:),MASK=OMICRO(:,:,:),FIELD=PRIS3D)*PRHODJ3D(:,:,:), &
+ 9,'WETG_BU_RRI')
+ IF (LBUDGET_RS) CALL BUDGET ( &
+ UNPACK(PRSS(:),MASK=OMICRO(:,:,:),FIELD=PRSS3D)*PRHODJ3D(:,:,:), &
+ 10,'WETG_BU_RRS')
+ IF (LBUDGET_RG) CALL BUDGET ( &
+ UNPACK(PRGS(:),MASK=OMICRO(:,:,:),FIELD=PRGS3D)*PRHODJ3D(:,:,:), &
+ 11,'WETG_BU_RRG')
IF ( KRR == 7 ) THEN
IF (LBUDGET_RH) CALL BUDGET ( &
- UNPACK(PRHS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
- 12,'WETG_BU_RRH')
+ UNPACK(PRHS(:),MASK=OMICRO(:,:,:),FIELD=PRHS3D)*PRHODJ3D(:,:,:), &
+ 12,'WETG_BU_RRH')
END IF
-
!
WHERE( PRGT(:)>XRTMIN(6) .AND. PZT(:)<XTT &
.AND. &
@@ -380,24 +386,24 @@ 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(:,:,:), &
+ IF (LBUDGET_TH) CALL BUDGET ( &
+ UNPACK(PTHS(:),MASK=OMICRO(:,:,:),FIELD=PTHS3D)*PRHODJ3D(:,:,:), &
4,'DRYG_BU_RTH')
- IF (LBUDGET_RC) CALL BUDGET ( &
- UNPACK(PRCS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
+ IF (LBUDGET_RC) CALL BUDGET ( &
+ UNPACK(PRCS(:),MASK=OMICRO(:,:,:),FIELD=PRCS3D)*PRHODJ3D(:,:,:), &
7,'DRYG_BU_RRC')
- IF (LBUDGET_RR) CALL BUDGET ( &
- UNPACK(PRRS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
- 8,'DRYG_BU_RRR')
- IF (LBUDGET_RI) CALL BUDGET ( &
- UNPACK(PRIS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
- 9,'DRYG_BU_RRI')
- IF (LBUDGET_RS) CALL BUDGET ( &
- UNPACK(PRSS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
- 10,'DRYG_BU_RRS')
- IF (LBUDGET_RG) CALL BUDGET ( &
- UNPACK(PRGS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
- 11,'DRYG_BU_RRG')
+ IF (LBUDGET_RR) CALL BUDGET ( &
+ UNPACK(PRRS(:),MASK=OMICRO(:,:,:),FIELD=PRRS3D)*PRHODJ3D(:,:,:), &
+ 8,'DRYG_BU_RRR')
+ IF (LBUDGET_RI) CALL BUDGET ( &
+ UNPACK(PRIS(:),MASK=OMICRO(:,:,:),FIELD=PRIS3D)*PRHODJ3D(:,:,:), &
+ 9,'DRYG_BU_RRI')
+ IF (LBUDGET_RS) CALL BUDGET ( &
+ UNPACK(PRSS(:),MASK=OMICRO(:,:,:),FIELD=PRSS3D)*PRHODJ3D(:,:,:), &
+ 10,'DRYG_BU_RRS')
+ IF (LBUDGET_RG) CALL BUDGET ( &
+ UNPACK(PRGS(:),MASK=OMICRO(:,:,:),FIELD=PRGS3D)*PRHODJ3D(:,:,:), &
+ 11,'DRYG_BU_RRG')
!
! WHERE ( PZT(:) > XTT ) ! RSWETG case only
! PRSS(:) = PRSS(:) - ZZW1(:,6)
@@ -424,15 +430,15 @@ 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(:,:,:), &
+ IF (LBUDGET_TH) CALL BUDGET ( &
+ UNPACK(PTHS(:),MASK=OMICRO(:,:,:),FIELD=PTHS3D)*PRHODJ3D(:,:,:), &
4,'GMLT_BU_RTH')
- IF (LBUDGET_RR) CALL BUDGET ( &
- UNPACK(PRRS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
- 8,'GMLT_BU_RRR')
- IF (LBUDGET_RG) CALL BUDGET ( &
- UNPACK(PRGS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
- 11,'GMLT_BU_RRG')
+ IF (LBUDGET_RR) CALL BUDGET ( &
+ UNPACK(PRRS(:),MASK=OMICRO(:,:,:),FIELD=PRRS3D)*PRHODJ3D(:,:,:), &
+ 8,'GMLT_BU_RRR')
+ IF (LBUDGET_RG) CALL BUDGET ( &
+ UNPACK(PRGS(:),MASK=OMICRO(:,:,:),FIELD=PRGS3D)*PRHODJ3D(:,:,:), &
+ 11,'GMLT_BU_RRG')
!
END SUBROUTINE RAIN_ICE_FAST_RG
diff --git a/src/MNH/rain_ice_fast_rh.f90 b/src/MNH/rain_ice_fast_rh.f90
index cedf7ceb49ac1a4c725839c600fd18d0fb74e4ce..975526b96baa13c234927d37b24d898ce0812b5a 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.
@@ -21,6 +21,7 @@ CONTAINS
SUBROUTINE RAIN_ICE_FAST_RH(OMICRO, PRHODREF, PRVT, PRCT, PRIT, PRST, PRGT, PRHT, PRHODJ, PPRES, &
PZT, PLBDAS, PLBDAG, PLBDAH, PLSFACT, PLVFACT, PCJ, PKA, PDV, PRHODJ3D, PTHS3D, &
+ PRCS3D, PRRS3D, PRIS3D, PRSS3D, PRGS3D, PRHS3D, &
PRCS, PRRS, PRIS, PRSS, PRGS, PRHS, PTHS, PUSW)
!
!* 0. DECLARATIONS
@@ -61,6 +62,12 @@ REAL, DIMENSION(:), intent(in) :: PKA ! Thermal conductivity of
REAL, DIMENSION(:), intent(in) :: PDV ! Diffusivity of water vapor in the air
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ3D ! Dry density * Jacobian
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHS3D ! Theta source
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCS3D ! Cloud vapor m.r. source
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRS3D ! Rain water m.r. source
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRIS3D ! Ice vapor m.r. source
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRSS3D ! Snow/aggregate m.r. source
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRGS3D ! Graupel m.r. source
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHS3D ! Hail m.r. source
REAL, DIMENSION(:), INTENT(INOUT) :: PRCS ! Cloud water m.r. source
REAL, DIMENSION(:), INTENT(INOUT) :: PRRS ! Rain water m.r. source
REAL, DIMENSION(:), INTENT(INOUT) :: PRIS ! Pristine ice m.r. source
@@ -300,27 +307,27 @@ REAL, DIMENSION(size(PRHODREF),6) :: ZZW1 ! Work arrays
END IF
END DO
END IF
- IF (LBUDGET_TH) CALL BUDGET ( &
- UNPACK(PTHS(:),MASK=OMICRO(:,:,:),FIELD=PTHS3D)*PRHODJ3D(:,:,:),&
+ IF (LBUDGET_TH) CALL BUDGET ( &
+ UNPACK(PTHS(:),MASK=OMICRO(:,:,:),FIELD=PTHS3D)*PRHODJ3D(:,:,:), &
4,'WETH_BU_RTH')
- IF (LBUDGET_RC) CALL BUDGET ( &
- UNPACK(PRCS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
- 7,'WETH_BU_RRC')
- IF (LBUDGET_RR) CALL BUDGET ( &
- UNPACK(PRRS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
- 8,'WETH_BU_RRR')
- IF (LBUDGET_RI) CALL BUDGET ( &
- UNPACK(PRIS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
- 9,'WETH_BU_RRI')
- IF (LBUDGET_RS) CALL BUDGET ( &
- UNPACK(PRSS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
- 10,'WETH_BU_RRS')
- IF (LBUDGET_RG) CALL BUDGET ( &
- UNPACK(PRGS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
- 11,'WETH_BU_RRG')
- IF (LBUDGET_RH) CALL BUDGET ( &
- UNPACK(PRHS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
- 12,'WETH_BU_RRH')
+ IF (LBUDGET_RC) CALL BUDGET ( &
+ UNPACK(PRCS(:),MASK=OMICRO(:,:,:),FIELD=PRCS3D)*PRHODJ3D(:,:,:), &
+ 7,'WETH_BU_RRC')
+ IF (LBUDGET_RR) CALL BUDGET ( &
+ UNPACK(PRRS(:),MASK=OMICRO(:,:,:),FIELD=PRRS3D)*PRHODJ3D(:,:,:), &
+ 8,'WETH_BU_RRR')
+ IF (LBUDGET_RI) CALL BUDGET ( &
+ UNPACK(PRIS(:),MASK=OMICRO(:,:,:),FIELD=PRIS3D)*PRHODJ3D(:,:,:), &
+ 9,'WETH_BU_RRI')
+ IF (LBUDGET_RS) CALL BUDGET ( &
+ UNPACK(PRSS(:),MASK=OMICRO(:,:,:),FIELD=PRSS3D)*PRHODJ3D(:,:,:), &
+ 10,'WETH_BU_RRS')
+ IF (LBUDGET_RG) CALL BUDGET ( &
+ UNPACK(PRGS(:),MASK=OMICRO(:,:,:),FIELD=PRGS3D)*PRHODJ3D(:,:,:), &
+ 11,'WETH_BU_RRG')
+ IF (LBUDGET_RH) CALL BUDGET ( &
+ UNPACK(PRHS(:),MASK=OMICRO(:,:,:),FIELD=PRHS3D)*PRHODJ3D(:,:,:), &
+ 12,'WETH_BU_RRH')
!
!
! ici LRECONVH et un flag pour autoriser une reconversion partielle de
@@ -375,15 +382,15 @@ REAL, DIMENSION(size(PRHODREF),6) :: ZZW1 ! Work arrays
END DO
END IF
- IF (LBUDGET_TH) CALL BUDGET ( &
- UNPACK(PTHS(:),MASK=OMICRO(:,:,:),FIELD=PTHS3D)*PRHODJ3D(:,:,:),&
+ IF (LBUDGET_TH) CALL BUDGET ( &
+ UNPACK(PTHS(:),MASK=OMICRO(:,:,:),FIELD=PTHS3D)*PRHODJ3D(:,:,:), &
4,'HMLT_BU_RTH')
- IF (LBUDGET_RR) CALL BUDGET ( &
- UNPACK(PRRS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
- 8,'HMLT_BU_RRR')
- IF (LBUDGET_RH) CALL BUDGET ( &
- UNPACK(PRHS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
- 12,'HMLT_BU_RRH')
+ IF (LBUDGET_RR) CALL BUDGET ( &
+ UNPACK(PRRS(:),MASK=OMICRO(:,:,:),FIELD=PRRS3D)*PRHODJ3D(:,:,:), &
+ 8,'HMLT_BU_RRR')
+ IF (LBUDGET_RH) CALL BUDGET ( &
+ UNPACK(PRHS(:),MASK=OMICRO(:,:,:),FIELD=PRHS3D)*PRHODJ3D(:,:,:), &
+ 12,'HMLT_BU_RRH')
!
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 782f79c9eaffbbb699c155fbb85e0872d27e23c7..09af9abd16a22ce7612e43a353f3867345e6b61d 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.
@@ -18,7 +18,7 @@ MODULE MODE_RAIN_ICE_FAST_RI
CONTAINS
SUBROUTINE RAIN_ICE_FAST_RI(OMICRO, PRHODREF, PRIT, PRHODJ, PZT, PSSI, PLSFACT, PLVFACT, &
- PAI, PCJ, PRHODJ3D, PTHS3D, PCIT, PRCS, PRIS, PTHS)
+ PAI, PCJ, PRHODJ3D, PTHS3D, PRCS3D, PRIS3D, PCIT, PRCS, PRIS, PTHS)
!
!* 0. DECLARATIONS
! ------------
@@ -46,6 +46,8 @@ REAL, DIMENSION(:), intent(in) :: PAI ! Thermodynamical function
REAL, DIMENSION(:), intent(in) :: PCJ ! Function to compute the ventilation coefficient
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ3D ! Dry density * Jacobian
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHS3D ! Theta source
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCS3D ! Cloud vapor m.r. source
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRIS3D ! Ice vapor m.r. source
REAL, DIMENSION(:), intent(inout) :: PCIT ! Pristine ice conc. at t
REAL, DIMENSION(:), INTENT(INOUT) :: PRCS ! Cloud water m.r. source
REAL, DIMENSION(:), INTENT(INOUT) :: PRIS ! Pristine ice m.r. source
@@ -64,14 +66,14 @@ REAL, DIMENSION(size(PRHODREF)) :: ZZW ! Work array
PRIS(:) = 0.0
PCIT(:) = 0.0
END WHERE
- IF (LBUDGET_TH) CALL BUDGET ( &
- UNPACK(PTHS(:),MASK=OMICRO(:,:,:),FIELD=PTHS3D)*PRHODJ3D(:,:,:), &
+ IF (LBUDGET_TH) CALL BUDGET ( &
+ UNPACK(PTHS(:),MASK=OMICRO(:,:,:),FIELD=PTHS3D)*PRHODJ3D(:,:,:), &
4,'IMLT_BU_RTH')
- IF (LBUDGET_RC) CALL BUDGET ( &
- UNPACK(PRCS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
+ IF (LBUDGET_RC) CALL BUDGET ( &
+ UNPACK(PRCS(:),MASK=OMICRO(:,:,:),FIELD=PRCS3D)*PRHODJ3D(:,:,:), &
7,'IMLT_BU_RRC')
- IF (LBUDGET_RI) CALL BUDGET ( &
- UNPACK(PRIS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
+ IF (LBUDGET_RI) CALL BUDGET ( &
+ UNPACK(PRIS(:),MASK=OMICRO(:,:,:),FIELD=PRIS3D)*PRHODJ3D(:,:,:), &
9,'IMLT_BU_RRI')
!
!* 7.2 Bergeron-Findeisen effect: RCBERI
@@ -84,14 +86,14 @@ 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(:,:,:), &
+ IF (LBUDGET_TH) CALL BUDGET ( &
+ UNPACK(PTHS(:),MASK=OMICRO(:,:,:),FIELD=PTHS3D)*PRHODJ3D(:,:,:), &
4,'BERFI_BU_RTH')
- IF (LBUDGET_RC) CALL BUDGET ( &
- UNPACK(PRCS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
+ IF (LBUDGET_RC) CALL BUDGET ( &
+ UNPACK(PRCS(:),MASK=OMICRO(:,:,:),FIELD=PRCS3D)*PRHODJ3D(:,:,:), &
7,'BERFI_BU_RRC')
- IF (LBUDGET_RI) CALL BUDGET ( &
- UNPACK(PRIS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
+ IF (LBUDGET_RI) CALL BUDGET ( &
+ UNPACK(PRIS(:),MASK=OMICRO(:,:,:),FIELD=PRIS3D)*PRHODJ3D(:,:,:), &
9,'BERFI_BU_RRI')
!
END SUBROUTINE RAIN_ICE_FAST_RI
diff --git a/src/MNH/rain_ice_fast_rs.f90 b/src/MNH/rain_ice_fast_rs.f90
index 5f5f9713eba6e28af53732ca458c168ad098f5fb..90e7b76071ca573e0c173edbac68a06ece20df27 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.
@@ -20,7 +20,7 @@ MODULE MODE_RAIN_ICE_FAST_RS
CONTAINS
SUBROUTINE RAIN_ICE_FAST_RS(PTSTEP, OMICRO, PRHODREF, PRVT, PRCT, PRRT, PRST, PRHODJ, PPRES, PZT, &
- PLBDAR, PLBDAS, PLSFACT, PLVFACT, PCJ, PKA, PDV, PRHODJ3D, PTHS3D, &
+ PLBDAR, PLBDAS, PLSFACT, PLVFACT, PCJ, PKA, PDV, PRHODJ3D, PTHS3D, PRCS3D, PRRS3D, PRSS3D, PRGS3D, &
PRCS, PRRS, PRSS, PRGS, PTHS)
!
!* 0. DECLARATIONS
@@ -61,6 +61,10 @@ REAL, DIMENSION(:), intent(in) :: PKA ! Thermal conductivity of
REAL, DIMENSION(:), intent(in) :: PDV ! Diffusivity of water vapor in the air
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ3D ! Dry density * Jacobian
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHS3D ! Theta source
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCS3D ! Cloud vapor m.r. source
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRS3D ! Rain water m.r. source
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRSS3D ! Snow/aggregate m.r. source
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRGS3D ! Graupel m.r. source
REAL, DIMENSION(:), INTENT(INOUT) :: PRCS ! Cloud water m.r. source
REAL, DIMENSION(:), INTENT(INOUT) :: PRRS ! Rain water m.r. source
REAL, DIMENSION(:), INTENT(INOUT) :: PRSS ! Snow/aggregate m.r. source
@@ -167,17 +171,17 @@ 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(:,:,:), &
+ IF (LBUDGET_TH) CALL BUDGET ( &
+ UNPACK(PTHS(:),MASK=OMICRO(:,:,:),FIELD=PTHS3D)*PRHODJ3D(:,:,:), &
4,'RIM_BU_RTH')
- IF (LBUDGET_RC) CALL BUDGET ( &
- UNPACK(PRCS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
+ IF (LBUDGET_RC) CALL BUDGET ( &
+ UNPACK(PRCS(:),MASK=OMICRO(:,:,:),FIELD=PRCS3D)*PRHODJ3D(:,:,:), &
7,'RIM_BU_RRC')
- IF (LBUDGET_RS) CALL BUDGET ( &
- UNPACK(PRSS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
+ IF (LBUDGET_RS) CALL BUDGET ( &
+ UNPACK(PRSS(:),MASK=OMICRO(:,:,:),FIELD=PRSS3D)*PRHODJ3D(:,:,:), &
10,'RIM_BU_RRS')
- IF (LBUDGET_RG) CALL BUDGET ( &
- UNPACK(PRGS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
+ IF (LBUDGET_RG) CALL BUDGET ( &
+ UNPACK(PRGS(:),MASK=OMICRO(:,:,:),FIELD=PRGS3D)*PRHODJ3D(:,:,:), &
11,'RIM_BU_RRG')
!
!* 5.2 rain accretion onto the aggregates
@@ -310,17 +314,17 @@ 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(:,:,:), &
+ IF (LBUDGET_TH) CALL BUDGET ( &
+ UNPACK(PTHS(:),MASK=OMICRO(:,:,:),FIELD=PTHS3D)*PRHODJ3D(:,:,:), &
4,'ACC_BU_RTH')
- IF (LBUDGET_RR) CALL BUDGET ( &
- UNPACK(PRRS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
+ IF (LBUDGET_RR) CALL BUDGET ( &
+ UNPACK(PRRS(:),MASK=OMICRO(:,:,:),FIELD=PRRS3D)*PRHODJ3D(:,:,:), &
8,'ACC_BU_RRR')
- IF (LBUDGET_RS) CALL BUDGET ( &
- UNPACK(PRSS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
+ IF (LBUDGET_RS) CALL BUDGET ( &
+ UNPACK(PRSS(:),MASK=OMICRO(:,:,:),FIELD=PRSS3D)*PRHODJ3D(:,:,:), &
10,'ACC_BU_RRS')
- IF (LBUDGET_RG) CALL BUDGET ( &
- UNPACK(PRGS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
+ IF (LBUDGET_RG) CALL BUDGET ( &
+ UNPACK(PRGS(:),MASK=OMICRO(:,:,:),FIELD=PRGS3D)*PRHODJ3D(:,:,:), &
11,'ACC_BU_RRG')
!
!* 5.3 Conversion-Melting of the aggregates
@@ -344,12 +348,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), &
- 10,'CMEL_BU_RRS')
- IF (LBUDGET_RG) CALL BUDGET ( &
- UNPACK(PRGS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
- 11,'CMEL_BU_RRG')
+ IF (LBUDGET_RS) CALL BUDGET ( &
+ UNPACK(PRSS(:),MASK=OMICRO(:,:,:),FIELD=PRSS3D)*PRHODJ3D(:,:,:), &
+ 10,'CMEL_BU_RRS')
+ IF (LBUDGET_RG) CALL BUDGET ( &
+ UNPACK(PRGS(:),MASK=OMICRO(:,:,:),FIELD=PRGS3D)*PRHODJ3D(:,:,:), &
+ 11,'CMEL_BU_RRG')
!
END SUBROUTINE RAIN_ICE_FAST_RS
diff --git a/src/MNH/rain_ice_slow.f90 b/src/MNH/rain_ice_slow.f90
index eb46ad5318796fa2e160df3f11f9714c914484c5..db5634523b76823dac5b911f2ad0365f07ec5a70 100644
--- a/src/MNH/rain_ice_slow.f90
+++ b/src/MNH/rain_ice_slow.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.
@@ -16,11 +16,11 @@ MODULE MODE_RAIN_ICE_SLOW
CONTAINS
-SUBROUTINE RAIN_ICE_SLOW(OMICRO, PINVTSTEP, PRHODREF, &
- PRCT, PRRT, PRIT, PRST, PRGT, PRHODJ, PZT, PPRES, &
- PLSFACT, PLVFACT, &
- PSSI, PRHODJ3D, PTHS3D, PRVS3D, &
- PRVS, PRCS, PRRS, PRIS, PRSS, PRGS, PTHS, &
+SUBROUTINE RAIN_ICE_SLOW(OMICRO, PINVTSTEP, PRHODREF, &
+ PRCT, PRRT, PRIT, PRST, PRGT, PRHODJ, PZT, PPRES, &
+ PLSFACT, PLVFACT, PSSI, &
+ PRHODJ3D, PTHS3D, PRVS3D, PRCS3D, PRRS3D, PRIS3D, PRSS3D, PRGS3D, &
+ PRVS, PRCS, PRRS, PRIS, PRSS, PRGS, PTHS, &
PAI, PCJ, PKA, PDV, PLBDAS, PLBDAG)
!
!* 0. DECLARATIONS
@@ -55,6 +55,11 @@ REAL, DIMENSION(:), intent(in) :: PSSI ! Supersaturation over ice
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ3D ! Dry density * Jacobian
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHS3D ! Theta source
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVS3D ! Water vapor m.r. source
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCS3D ! Cloud vapor m.r. source
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRS3D ! Rain water m.r. source
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRIS3D ! Ice vapor m.r. source
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRSS3D ! Snow/aggregate m.r. source
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRGS3D ! Graupel m.r. source
REAL, DIMENSION(:), INTENT(INOUT) :: PRVS ! Water vapor m.r. source
REAL, DIMENSION(:), INTENT(INOUT) :: PRCS ! Cloud water m.r. source
REAL, DIMENSION(:), INTENT(INOUT) :: PRRS ! Rain water m.r. source
@@ -89,14 +94,14 @@ REAL, DIMENSION(size(PRHODREF)) :: ZCRIAUTI ! Snow-to-ice autoconversion thres.
PTHS(:) = PTHS(:) + ZZW(:)*(PLSFACT(:)-PLVFACT(:)) ! f(L_f*(RCHONI))
ENDWHERE
!
- IF (LBUDGET_TH) CALL BUDGET ( &
- UNPACK(PTHS(:),MASK=OMICRO(:,:,:),FIELD=PTHS3D)*PRHODJ3D(:,:,:), &
+ IF (LBUDGET_TH) CALL BUDGET ( &
+ UNPACK(PTHS(:),MASK=OMICRO(:,:,:),FIELD=PTHS3D)*PRHODJ3D(:,:,:), &
4,'HON_BU_RTH')
- IF (LBUDGET_RC) CALL BUDGET ( &
- UNPACK(PRCS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
+ IF (LBUDGET_RC) CALL BUDGET ( &
+ UNPACK(PRCS(:),MASK=OMICRO(:,:,:),FIELD=PRCS3D)*PRHODJ3D(:,:,:), &
7,'HON_BU_RRC')
- IF (LBUDGET_RI) CALL BUDGET ( &
- UNPACK(PRIS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
+ IF (LBUDGET_RI) CALL BUDGET ( &
+ UNPACK(PRIS(:),MASK=OMICRO(:,:,:),FIELD=PRIS3D)*PRHODJ3D(:,:,:), &
9,'HON_BU_RRI')
!
!* 3.3 compute the spontaneous freezing source: RRHONG
@@ -109,14 +114,14 @@ REAL, DIMENSION(size(PRHODREF)) :: ZCRIAUTI ! Snow-to-ice autoconversion thres.
PTHS(:) = PTHS(:) + ZZW(:)*(PLSFACT(:)-PLVFACT(:)) ! f(L_f*(RRHONG))
ENDWHERE
!
- IF (LBUDGET_TH) CALL BUDGET ( &
- UNPACK(PTHS(:),MASK=OMICRO(:,:,:),FIELD=PTHS3D)*PRHODJ3D(:,:,:), &
+ IF (LBUDGET_TH) CALL BUDGET ( &
+ UNPACK(PTHS(:),MASK=OMICRO(:,:,:),FIELD=PTHS3D)*PRHODJ3D(:,:,:), &
4,'SFR_BU_RTH')
- IF (LBUDGET_RR) CALL BUDGET ( &
- UNPACK(PRRS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
+ IF (LBUDGET_RR) CALL BUDGET ( &
+ UNPACK(PRRS(:),MASK=OMICRO(:,:,:),FIELD=PRRS3D)*PRHODJ3D(:,:,:), &
8,'SFR_BU_RRR')
- IF (LBUDGET_RG) CALL BUDGET ( &
- UNPACK(PRGS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
+ IF (LBUDGET_RG) CALL BUDGET ( &
+ UNPACK(PRGS(:),MASK=OMICRO(:,:,:),FIELD=PRGS3D)*PRHODJ3D(:,:,:), &
11,'SFR_BU_RRG')
!
!* 3.4 compute the deposition, aggregation and autoconversion sources
@@ -160,14 +165,14 @@ 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(:,:,:), &
+ IF (LBUDGET_TH) CALL BUDGET ( &
+ UNPACK(PTHS(:),MASK=OMICRO(:,:,:),FIELD=PTHS3D)*PRHODJ3D(:,:,:), &
4,'DEPS_BU_RTH')
- IF (LBUDGET_RV) CALL BUDGET ( &
- UNPACK(PRVS(:),MASK=OMICRO(:,:,:),FIELD=PRVS3D)*PRHODJ3D(:,:,:), &
+ IF (LBUDGET_RV) CALL BUDGET ( &
+ UNPACK(PRVS(:),MASK=OMICRO(:,:,:),FIELD=PRVS3D)*PRHODJ3D(:,:,:), &
6,'DEPS_BU_RRV')
- IF (LBUDGET_RS) CALL BUDGET ( &
- UNPACK(PRSS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
+ IF (LBUDGET_RS) CALL BUDGET ( &
+ UNPACK(PRSS(:),MASK=OMICRO(:,:,:),FIELD=PRSS3D)*PRHODJ3D(:,:,:), &
10,'DEPS_BU_RRS')
!
!* 3.4.4 compute the aggregation on r_s: RIAGGS
@@ -181,11 +186,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), &
+ IF (LBUDGET_RI) CALL BUDGET ( &
+ UNPACK(PRIS(:),MASK=OMICRO(:,:,:),FIELD=PRIS3D)*PRHODJ3D(:,:,:), &
9,'AGGS_BU_RRI')
- IF (LBUDGET_RS) CALL BUDGET ( &
- UNPACK(PRSS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
+ IF (LBUDGET_RS) CALL BUDGET ( &
+ UNPACK(PRSS(:),MASK=OMICRO(:,:,:),FIELD=PRSS3D)*PRHODJ3D(:,:,:), &
10,'AGGS_BU_RRS')
!
!* 3.4.5 compute the autoconversion of r_i for r_s production: RIAUTS
@@ -199,11 +204,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), &
+ IF (LBUDGET_RI) CALL BUDGET ( &
+ UNPACK(PRIS(:),MASK=OMICRO(:,:,:),FIELD=PRIS3D)*PRHODJ3D(:,:,:), &
9,'AUTS_BU_RRI')
- IF (LBUDGET_RS) CALL BUDGET ( &
- UNPACK(PRSS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
+ IF (LBUDGET_RS) CALL BUDGET ( &
+ UNPACK(PRSS(:),MASK=OMICRO(:,:,:),FIELD=PRSS3D)*PRHODJ3D(:,:,:), &
10,'AUTS_BU_RRS')
!
!* 3.4.6 compute the deposition on r_g: RVDEPG
@@ -222,14 +227,14 @@ 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(:,:,:), &
+ IF (LBUDGET_TH) CALL BUDGET ( &
+ UNPACK(PTHS(:),MASK=OMICRO(:,:,:),FIELD=PTHS3D)*PRHODJ3D(:,:,:), &
4,'DEPG_BU_RTH')
- IF (LBUDGET_RV) CALL BUDGET ( &
- UNPACK(PRVS(:),MASK=OMICRO(:,:,:),FIELD=PRVS3D)*PRHODJ3D(:,:,:), &
+ IF (LBUDGET_RV) CALL BUDGET ( &
+ UNPACK(PRVS(:),MASK=OMICRO(:,:,:),FIELD=PRVS3D)*PRHODJ3D(:,:,:), &
6,'DEPG_BU_RRV')
- IF (LBUDGET_RG) CALL BUDGET ( &
- UNPACK(PRGS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
+ IF (LBUDGET_RG) CALL BUDGET ( &
+ UNPACK(PRGS(:),MASK=OMICRO(:,:,:),FIELD=PRGS3D)*PRHODJ3D(:,:,:), &
11,'DEPG_BU_RRG')
!
END SUBROUTINE RAIN_ICE_SLOW
diff --git a/src/MNH/rain_ice_warm.f90 b/src/MNH/rain_ice_warm.f90
index 54a8c315ce30eeab59a7a5fec15e733613710758..08ffb0e6fbbbd7f0456763be3bf4a7a5b72e4914 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.
@@ -20,7 +20,7 @@ CONTAINS
SUBROUTINE RAIN_ICE_WARM(OMICRO, KMICRO, K1, K2, K3, &
PRHODREF, PRVT, PRCT, PRRT, PHLC_HCF, PHLC_LCF, PHLC_HRC, PHLC_LRC, &
PRHODJ, PPRES, PZT, PLBDAR, PLBDAR_RF, PLVFACT, PCJ, PKA, PDV, PRF, PCF, PTHT, PTHLT, &
- PRHODJ3D, PTHS3D, PRVS3D, PRVS, PRCS, PRRS, PTHS, PUSW, PEVAP3D)
+ PRHODJ3D, PTHS3D, PRVS3D, PRCS3D, PRRS3D, PRVS, PRCS, PRRS, PTHS, PUSW, PEVAP3D)
!
!* 0. DECLARATIONS
! ------------
@@ -69,6 +69,8 @@ REAL, DIMENSION(:), intent(in) :: PTHLT ! Liquid potential tempera
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ3D ! Dry density * Jacobian
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHS3D ! Theta source
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVS3D ! Water vapor m.r. source
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCS3D ! Cloud vapor m.r. source
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRS3D ! Rain water m.r. source
REAL, DIMENSION(:), INTENT(INOUT) :: PRVS ! Water vapor m.r. source
REAL, DIMENSION(:), INTENT(INOUT) :: PRCS ! Cloud water m.r. source
REAL, DIMENSION(:), INTENT(INOUT) :: PRRS ! Rain water m.r. source
@@ -97,11 +99,11 @@ REAL, DIMENSION(size(PRHODREF)) :: ZZW4 ! Work array
PRRS(:) = PRRS(:) + ZZW(:)
END WHERE
!
- IF (LBUDGET_RC) CALL BUDGET ( &
- UNPACK(PRCS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
- 7,'AUTO_BU_RRC')
- IF (LBUDGET_RR) CALL BUDGET ( &
- UNPACK(PRRS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
+ IF (LBUDGET_RC) CALL BUDGET ( &
+ UNPACK(PRCS(:),MASK=OMICRO(:,:,:),FIELD=PRCS3D)*PRHODJ3D(:,:,:), &
+ 7,'AUTO_BU_RRC')
+ IF (LBUDGET_RR) CALL BUDGET ( &
+ UNPACK(PRRS(:),MASK=OMICRO(:,:,:),FIELD=PRRS3D)*PRHODJ3D(:,:,:), &
8,'AUTO_BU_RRR')
!
!* 4.3 compute the accretion of r_c for r_r production: RCACCR
@@ -151,12 +153,12 @@ REAL, DIMENSION(size(PRHODREF)) :: ZZW4 ! Work array
CALL PRINT_MSG(NVERB_FATAL,'GEN','RAIN_ICE_WARM','')
ENDIF
- IF (LBUDGET_RC) CALL BUDGET ( &
- UNPACK(PRCS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
+ IF (LBUDGET_RC) CALL BUDGET ( &
+ UNPACK(PRCS(:),MASK=OMICRO(:,:,:),FIELD=PRCS3D)*PRHODJ3D(:,:,:), &
7,'ACCR_BU_RRC')
- IF (LBUDGET_RR) CALL BUDGET ( &
- UNPACK(PRRS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
- 8,'ACCR_BU_RRR')
+ IF (LBUDGET_RR) CALL BUDGET ( &
+ UNPACK(PRRS(:),MASK=OMICRO(:,:,:),FIELD=PRRS3D)*PRHODJ3D(:,:,:), &
+ 8,'ACCR_BU_RRR')
!
!* 4.4 compute the evaporation of r_r: RREVAV
!
@@ -228,15 +230,15 @@ REAL, DIMENSION(size(PRHODREF)) :: ZZW4 ! Work array
CALL PRINT_MSG(NVERB_FATAL,'GEN','RAIN_ICE_WARM','')
END IF
- IF (LBUDGET_TH) CALL BUDGET ( &
- UNPACK(PTHS(:),MASK=OMICRO(:,:,:),FIELD=PTHS3D)*PRHODJ3D(:,:,:), &
+ IF (LBUDGET_TH) CALL BUDGET ( &
+ UNPACK(PTHS(:),MASK=OMICRO(:,:,:),FIELD=PTHS3D)*PRHODJ3D(:,:,:), &
4,'REVA_BU_RTH')
- IF (LBUDGET_RV) CALL BUDGET ( &
- UNPACK(PRVS(:),MASK=OMICRO(:,:,:),FIELD=PRVS3D)*PRHODJ3D(:,:,:), &
+ IF (LBUDGET_RV) CALL BUDGET ( &
+ UNPACK(PRVS(:),MASK=OMICRO(:,:,:),FIELD=PRVS3D)*PRHODJ3D(:,:,:), &
6,'REVA_BU_RRV')
- IF (LBUDGET_RR) CALL BUDGET ( &
- UNPACK(PRRS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
- 8,'REVA_BU_RRR')
+ IF (LBUDGET_RR) CALL BUDGET ( &
+ UNPACK(PRRS(:),MASK=OMICRO(:,:,:),FIELD=PRRS3D)*PRHODJ3D(:,:,:), &
+ 8,'REVA_BU_RRR')
DO JL = 1, KMICRO
PEVAP3D(K1(JL), K2(JL), K3(JL)) = ZZW( JL )