From f13f6af5a8b8316dcf2689439489e66a31fe0ae6 Mon Sep 17 00:00:00 2001
From: Quentin Rodier <quentin.rodier@meteo.fr>
Date: Fri, 21 May 2021 18:45:55 +0200
Subject: [PATCH] Sebastien R. 21/05/2021: update the Gaussian PDF in subgrid
condensation scheme + HighLow clouds
---
src/MNH/compute_mf_cloud.f90 | 2 +-
src/MNH/compute_mf_cloud_bigaus.f90 | 39 +-
src/MNH/condensation.f90 | 178 +++-
src/MNH/deallocate_model1.f90 | 8 +
src/MNH/default_desfmn.f90 | 6 +
src/MNH/ice4_compute_pdf.f90 | 137 ++-
src/MNH/ice4_fast_rg.f90 | 350 ++++----
src/MNH/ice4_fast_rh.f90 | 314 ++++---
src/MNH/ice4_fast_ri.f90 | 36 +-
src/MNH/ice4_fast_rs.f90 | 259 +++---
src/MNH/ice4_nucleation.f90 | 4 +-
src/MNH/ice4_nucleation_wrapper.f90 | 7 +-
src/MNH/ice4_rainfr_vert.f90 | 20 +-
src/MNH/ice4_rimltc.f90 | 35 +-
src/MNH/ice4_rrhong.f90 | 35 +-
src/MNH/ice4_rsrimcg_old.f90 | 14 +-
src/MNH/ice4_sedimentation_split.f90 | 8 +-
src/MNH/ice4_slow.f90 | 135 ++-
src/MNH/ice4_tendencies.f90 | 309 ++++---
src/MNH/ice4_warm.f90 | 126 ++-
src/MNH/ice_adjust.f90 | 124 ++-
src/MNH/ice_adjust_elec.f90 | 5 +-
src/MNH/ini_cst.f90 | 1 +
src/MNH/ini_modeln.f90 | 16 +
src/MNH/modd_cst.f90 | 1 +
src/MNH/modd_fieldn.f90 | 5 +
src/MNH/modd_getn.f90 | 4 +
src/MNH/modd_turbn.f90 | 15 +-
src/MNH/modeln.f90 | 4 +-
src/MNH/modn_turbn.f90 | 21 +-
src/MNH/radtr_satel.f90 | 7 +-
src/MNH/rain_ice.f90 | 6 +-
src/MNH/rain_ice_red.f90 | 1202 +++++++++++++++-----------
src/MNH/read_exsegn.f90 | 7 +-
src/MNH/resolved_cloud.f90 | 128 +--
35 files changed, 2181 insertions(+), 1387 deletions(-)
diff --git a/src/MNH/compute_mf_cloud.f90 b/src/MNH/compute_mf_cloud.f90
index 28ce08a6c..ac901dc3e 100644
--- a/src/MNH/compute_mf_cloud.f90
+++ b/src/MNH/compute_mf_cloud.f90
@@ -180,7 +180,7 @@ ELSEIF (HMF_CLOUD == 'STAT') THEN
ELSEIF (HMF_CLOUD == 'BIGA') THEN
!Statistical scheme using the bi-gaussian PDF proposed by E. Perraud.
CALL COMPUTE_MF_CLOUD_BIGAUS(KKA, KKB, KKE, KKU, KKL,&
- &PRC_UP, PRI_UP, PEMF, PDEPTH,&
+ &PEMF, PDEPTH,&
&PRT_UP, PTHV_UP, PFRAC_ICE_UP, PRSAT_UP,&
&PRTM, PTHM, PTHVM,&
&PDZZ, PZZ, PRHODREF,&
diff --git a/src/MNH/compute_mf_cloud_bigaus.f90 b/src/MNH/compute_mf_cloud_bigaus.f90
index 8d158567b..1ca60edd9 100644
--- a/src/MNH/compute_mf_cloud_bigaus.f90
+++ b/src/MNH/compute_mf_cloud_bigaus.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -9,7 +9,7 @@
INTERFACE
! #################################################################
SUBROUTINE COMPUTE_MF_CLOUD_BIGAUS(KKA, KKB, KKE, KKU, KKL,&
- PRC_UP, PRI_UP, PEMF, PDEPTH,&
+ PEMF, PDEPTH,&
PRT_UP, PTHV_UP, PFRAC_ICE_UP, PRSAT_UP,&
PRTM, PTHM, PTHVM,&
PDZZ, PZZ, PRHODREF,&
@@ -24,7 +24,7 @@ INTEGER, INTENT(IN) :: KKB ! near ground physical inde
INTEGER, INTENT(IN) :: KKE ! uppest atmosphere physical index
INTEGER, INTENT(IN) :: KKU ! uppest atmosphere array index
INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
-REAL, DIMENSION(:,:), INTENT(IN) :: PRC_UP,PRI_UP,PEMF ! updraft characteritics
+REAL, DIMENSION(:,:), INTENT(IN) :: PEMF ! updraft characteritics
REAL, DIMENSION(:), INTENT(IN) :: PDEPTH ! Deepness of cloud
REAL, DIMENSION(:,:), INTENT(IN) :: PTHV_UP, PRSAT_UP, PRT_UP ! updraft characteritics
REAL, DIMENSION(:,:), INTENT(IN) :: PFRAC_ICE_UP ! liquid/ice fraction in updraft
@@ -40,8 +40,8 @@ END INTERFACE
!
END MODULE MODI_COMPUTE_MF_CLOUD_BIGAUS
! ######spl
- SUBROUTINE COMPUTE_MF_CLOUD_BIGAUS(KKA, KKB, KKE, KKU,KKL,&
- PRC_UP, PRI_UP, PEMF, PDEPTH,&
+ SUBROUTINE COMPUTE_MF_CLOUD_BIGAUS(KKA, KKB, KKE, KKU, KKL,&
+ PEMF, PDEPTH,&
PRT_UP, PTHV_UP, PFRAC_ICE_UP, PRSAT_UP,&
PRTM, PTHM, PTHVM,&
PDZZ, PZZ, PRHODREF,&
@@ -83,6 +83,7 @@ END MODULE MODI_COMPUTE_MF_CLOUD_BIGAUS
!! -------------
!! Original 25 Aug 2011
!! S. Riette Jan 2012: support for both order of vertical levels
+!! S. Riette Jun 2019: remove unused PRC_UP and PRI_UP, use SIGN in ERFC computation
!! --------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -105,7 +106,7 @@ INTEGER, INTENT(IN) :: KKB ! near ground physical inde
INTEGER, INTENT(IN) :: KKE ! uppest atmosphere physical index
INTEGER, INTENT(IN) :: KKU ! uppest atmosphere array index
INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
-REAL, DIMENSION(:,:), INTENT(IN) :: PRC_UP,PRI_UP,PEMF ! updraft characteritics
+REAL, DIMENSION(:,:), INTENT(IN) :: PEMF ! updraft characteritics
REAL, DIMENSION(:), INTENT(IN) :: PDEPTH ! Deepness of cloud
REAL, DIMENSION(:,:), INTENT(IN) :: PTHV_UP, PRSAT_UP, PRT_UP ! updraft characteritics
REAL, DIMENSION(:,:), INTENT(IN) :: PFRAC_ICE_UP ! liquid/ice fraction in updraft
@@ -125,8 +126,7 @@ REAL, DIMENSION(SIZE(PTHM,1)) :: ZOMEGA_UP_M !
REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZW1 ! working array
INTEGER :: JK ! vertical loop control
REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZEMF_M, ZTHV_UP_M, & !
- & ZRSAT_UP_M, ZRC_UP_M,& ! Interpolation on mass points
- & ZRI_UP_M, ZRT_UP_M,& !
+ & ZRSAT_UP_M, ZRT_UP_M,& ! Interpolation on mass points
& ZFRAC_ICE_UP_M !
REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZCOND ! condensate
REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZA, ZGAM ! used for integration
@@ -146,8 +146,6 @@ ZGRAD_Z_RT(:,:)=MZF_MF(KKA,KKU,KKL, ZW1(:,:))
!Interpolation on mass points
ZTHV_UP_M(:,:) = MZF_MF(KKA,KKU,KKL, PTHV_UP(:,:))
ZRSAT_UP_M(:,:)= MZF_MF(KKA,KKU,KKL, PRSAT_UP(:,:))
-ZRC_UP_M(:,:) = MZF_MF(KKA,KKU,KKL, PRC_UP(:,:))
-ZRI_UP_M(:,:) = MZF_MF(KKA,KKU,KKL, PRI_UP(:,:))
ZRT_UP_M(:,:) = MZF_MF(KKA,KKU,KKL, PRT_UP(:,:))
ZEMF_M(:,:) = MZF_MF(KKA,KKU,KKL, PEMF(:,:))
ZFRAC_ICE_UP_M(:,:) = MZF_MF(KKA,KKU,KKL, PFRAC_ICE_UP(:,:))
@@ -194,25 +192,8 @@ ZSIGMF(:,:)=SQRT(MAX(ABS(ZSIGMF(:,:)), 1.E-40))
!Computation of ZA and ZGAM (=efrc(ZA)) coefficient
ZA(:,:)=(ZRSAT_UP_M(:,:)-ZRT_UP_M(:,:))/(sqrt(2.)*ZSIGMF(:,:))
-!erf computed by an incomplete gamma function approximation
-!DO JK=KKA,KKU,KKL
-! DO JI=1, SIZE(PCF_MF,1)
-! IF(ZA(JI,JK)>1E-20) THEN
-! ZGAM(JI,JK)=1-GAMMA_INC(0.5,ZA(JI,JK)**2)
-! ELSEIF(ZA(JI,JK)<-1E-20) THEN
-! ZGAM(JI,JK)=1+GAMMA_INC(0.5,ZA(JI,JK)**2)
-! ELSE
-! ZGAM(JI,JK)=1
-! ENDIF
-! ENDDO
-!ENDDO
-
-!alternative approximation of erf function (better for vectorisation)
-WHERE(ZA(:,:)>0)
- ZGAM(:,:)=1-SQRT(1-EXP(-4*ZA(:,:)**2/XPI))
-ELSEWHERE
- ZGAM(:,:)=1+SQRT(1-EXP(-4*ZA(:,:)**2/XPI))
-ENDWHERE
+!Approximation of erf function
+ZGAM(:,:)=1-SIGN(1., ZA(:,:))*SQRT(1-EXP(-4*ZA(:,:)**2/XPI))
!computation of cloud fraction
PCF_MF(:,:)=MAX( 0., MIN(1.,0.5*ZGAM(:,:) * ZALPHA_UP_M(:,:)))
diff --git a/src/MNH/condensation.f90 b/src/MNH/condensation.f90
index 7056f6e84..6eaafe5aa 100644
--- a/src/MNH/condensation.f90
+++ b/src/MNH/condensation.f90
@@ -8,10 +8,10 @@
!
INTERFACE
!
- SUBROUTINE CONDENSATION( KIU, KJU, KKU, KIB, KIE, KJB, KJE, KKB, KKE, KKL, &
- HFRAC_ICE, &
- PPABS, PZZ, PT, PRV, PRC, PRI, PRS, PRG, PSIGS, PMFCONV, PCLDFR, PSIGRC, OUSERI,&
- OSIGMAS, PSIGQSAT, PLV, PLS, PCPH)
+ SUBROUTINE CONDENSATION( KIU, KJU, KKU, KIB, KIE, KJB, KJE, KKB, KKE, KKL,&
+ HFRAC_ICE, HCONDENS, HLAMBDA3, &
+ PPABS, PZZ, PRHODREF, PT, PRV, PRC, PRI, PRS, PRG, PSIGS, PMFCONV, PCLDFR, PSIGRC, OUSERI,&
+ OSIGMAS, PSIGQSAT, PLV, PLS, PCPH, PHLC_HRC, PHLC_HCF, PHLI_HRI, PHLI_HCF)
!
INTEGER, INTENT(IN) :: KIU ! horizontal dimension in x
INTEGER, INTENT(IN) :: KJU ! horizontal dimension in y
@@ -23,9 +23,12 @@ INTEGER, INTENT(IN) :: KJE ! value of the last point
INTEGER, INTENT(IN) :: KKB ! value of the first point in z
INTEGER, INTENT(IN) :: KKE ! value of the last point in z
INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
-CHARACTER(len=1), INTENT(IN) :: HFRAC_ICE
+CHARACTER(len=1), INTENT(IN) :: HFRAC_ICE
+CHARACTER(len=80), INTENT(IN) :: HCONDENS
+CHARACTER(len=4), INTENT(IN) :: HLAMBDA3 ! formulation for lambda3 coeff
REAL, DIMENSION(KIU,KJU,KKU), INTENT(IN) :: PPABS ! pressure (Pa)
REAL, DIMENSION(KIU,KJU,KKU), INTENT(IN) :: PZZ ! height of model levels (m)
+REAL, DIMENSION(KIU,KJU,KKU), INTENT(IN) :: PRHODREF
REAL, DIMENSION(KIU,KJU,KKU), INTENT(INOUT) :: PT ! grid scale T (K)
REAL, DIMENSION(KIU,KJU,KKU), INTENT(INOUT) :: PRV ! grid scale water vapor mixing ratio (kg/kg)
LOGICAL, INTENT(IN) :: OUSERI ! logical switch to compute both
@@ -46,6 +49,11 @@ REAL, DIMENSION(KIU,KJU,KKU), INTENT(OUT) :: PSIGRC ! s r_c / sig_s^2
REAL, DIMENSION(KIU,KJU,KKU), OPTIONAL, INTENT(IN) :: PLV
REAL, DIMENSION(KIU,KJU,KKU), OPTIONAL, INTENT(IN) :: PLS
REAL, DIMENSION(KIU,KJU,KKU), OPTIONAL, INTENT(IN) :: PCPH
+REAL, DIMENSION(KIU,KJU,KKU), OPTIONAL, INTENT(OUT) :: PHLC_HRC !cloud water content in precipitating part
+REAL, DIMENSION(KIU,KJU,KKU), OPTIONAL, INTENT(OUT) :: PHLC_HCF !precipitating part
+REAL, DIMENSION(KIU,KJU,KKU), OPTIONAL, INTENT(OUT) :: PHLI_HRI !
+REAL, DIMENSION(KIU,KJU,KKU), OPTIONAL, INTENT(OUT) :: PHLI_HCF !
+
END SUBROUTINE CONDENSATION
!
END INTERFACE
@@ -53,9 +61,9 @@ END INTERFACE
END MODULE MODI_CONDENSATION
! ######spl
SUBROUTINE CONDENSATION( KIU, KJU, KKU, KIB, KIE, KJB, KJE, KKB, KKE, KKL, &
- HFRAC_ICE, &
- PPABS, PZZ, PT, PRV, PRC, PRI, PRS, PRG, PSIGS, PMFCONV, PCLDFR, PSIGRC, OUSERI,&
- OSIGMAS, PSIGQSAT, PLV, PLS, PCPH )
+ HFRAC_ICE, HCONDENS, HLAMBDA3, &
+ PPABS, PZZ, PRHODREF, PT, PRV, PRC, PRI, PRS, PRG, PSIGS, PMFCONV, PCLDFR, PSIGRC, OUSERI,&
+ OSIGMAS, PSIGQSAT, PLV, PLS, PCPH, PHLC_HRC, PHLC_HCF, PHLI_HRI, PHLI_HCF )
! ################################################################################
!
!!
@@ -126,6 +134,7 @@ END MODULE MODI_CONDENSATION
!
USE MODD_CST
USE MODD_PARAMETERS
+USE MODD_RAIN_ICE_PARAM, ONLY : XCRIAUTC, XCRIAUTI, XACRIAUTI, XBCRIAUTI
USE MODI_COMPUTE_FRAC_ICE
!
IMPLICIT NONE
@@ -143,13 +152,16 @@ INTEGER, INTENT(IN) :: KJE ! value of the last point
INTEGER, INTENT(IN) :: KKB ! value of the first point in z
INTEGER, INTENT(IN) :: KKE ! value of the last point in z
INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
-CHARACTER(len=1), INTENT(IN) :: HFRAC_ICE
+CHARACTER(len=1), INTENT(IN) :: HFRAC_ICE
+CHARACTER(len=80), INTENT(IN) :: HCONDENS
+CHARACTER(len=4), INTENT(IN) :: HLAMBDA3 ! formulation for lambda3 coeff
REAL, DIMENSION(KIU,KJU,KKU), INTENT(IN) :: PPABS ! pressure (Pa)
REAL, DIMENSION(KIU,KJU,KKU), INTENT(IN) :: PZZ ! height of model levels (m)
+REAL, DIMENSION(KIU,KJU,KKU), INTENT(IN) :: PRHODREF
REAL, DIMENSION(KIU,KJU,KKU), INTENT(INOUT) :: PT ! grid scale T (K)
REAL, DIMENSION(KIU,KJU,KKU), INTENT(INOUT) :: PRV ! grid scale water vapor mixing ratio (kg/kg)
LOGICAL, INTENT(IN) :: OUSERI ! logical switch to compute both
- ! liquid and solid condensate (OUSERI=.TRUE.)
+ ! liquid and solid condensate (OUSERI=.TRUE.)
! or only solid condensate (OUSERI=.FALSE.)
LOGICAL, INTENT(IN) :: OSIGMAS! use present global Sigma_s values
! or that from turbulence scheme
@@ -163,9 +175,13 @@ REAL, DIMENSION(KIU,KJU,KKU), INTENT(IN) :: PSIGS ! Sigma_s from turbulence
REAL, DIMENSION(:,:,:), INTENT(IN) :: PMFCONV! convective mass flux (kg /s m^2)
REAL, DIMENSION(KIU,KJU,KKU), INTENT(OUT) :: PCLDFR ! cloud fraction
REAL, DIMENSION(KIU,KJU,KKU), INTENT(OUT) :: PSIGRC ! s r_c / sig_s^2
-REAL, DIMENSION(KIU,KJU,KKU), OPTIONAL, INTENT(IN) :: PLV
-REAL, DIMENSION(KIU,KJU,KKU), OPTIONAL, INTENT(IN) :: PLS
-REAL, DIMENSION(KIU,KJU,KKU), OPTIONAL, INTENT(IN) :: PCPH
+REAL, DIMENSION(KIU,KJU,KKU), OPTIONAL, INTENT(IN) :: PLV ! Latent heat L_v
+REAL, DIMENSION(KIU,KJU,KKU), OPTIONAL, INTENT(IN) :: PLS ! Latent heat L_s
+REAL, DIMENSION(KIU,KJU,KKU), OPTIONAL, INTENT(IN) :: PCPH ! Specific heat C_ph
+REAL, DIMENSION(KIU,KJU,KKU), OPTIONAL, INTENT(OUT) :: PHLC_HRC
+REAL, DIMENSION(KIU,KJU,KKU), OPTIONAL, INTENT(OUT) :: PHLC_HCF ! cloud fraction
+REAL, DIMENSION(KIU,KJU,KKU), OPTIONAL, INTENT(OUT) :: PHLI_HRI
+REAL, DIMENSION(KIU,KJU,KKU), OPTIONAL, INTENT(OUT) :: PHLI_HCF
!
!
!* 0.2 Declarations of local variables :
@@ -174,13 +190,17 @@ INTEGER :: JI, JJ, JK, JKP, JKM, IKTB, IKTE ! loop index
REAL, DIMENSION(KIU,KJU,KKU) :: ZTLK, ZRT ! work arrays for T_l and total water mixing ratio
REAL, DIMENSION(KIU,KJU,KKU) :: ZL ! length scale
REAL, DIMENSION(KIU,KJU,KKU) :: ZFRAC ! Ice fraction
-INTEGER, DIMENSION(KIU,KJU) :: ITPL ! top levels of troposphere
+REAL, DIMENSION(KIU,KJU,KKU) :: ZCRIAUTI !
+INTEGER, DIMENSION(KIU,KJU) :: ITPL ! top levels of troposphere
REAL, DIMENSION(KIU,KJU) :: ZTMIN ! minimum Temp. related to ITPL
!
REAL, DIMENSION(KIU,KJU,KKU) :: ZLV, ZLS, ZCPD
-REAL :: ZTEMP, ZPV, ZQSL, ZPIV, ZQSI, ZCOND, ZLVS ! thermodynamics
-REAL :: ZLL, DZZ, ZZZ ! used for length scales
-REAL :: ZAH, ZA, ZB, ZSBAR, ZQ1, ZSIGMA, ZDRW, ZDTL, ZSIG_CONV ! related to computation of Sig_s
+REAL, DIMENSION(KIU,KJU,KKU) :: ZCOND
+REAL :: ZGCOND, ZSBAR, ZSBARC, ZQ1, ZAUTC, ZAUTI, ZGAUV, ZGAUC, ZGAUI, ZGAUTC, ZGAUTI ! Used for integration in Gaussian Probability Density Function
+REAL :: ZTEMP, ZPV, ZQSL, ZPIV, ZQSI, ZLVS ! thermodynamics
+REAL :: ZLL, DZZ, ZZZ ! used for length scales
+REAL :: ZAH, ZA, ZB, ZSIGMA, ZDRW, ZDTL, ZSIG_CONV ! related to computation of Sig_s
+REAL :: ZRCOLD, ZRIOLD
INTEGER :: INQ1
REAL :: ZINC
!
@@ -367,35 +387,105 @@ DO JK=IKTB,IKTE
! normalized saturation deficit
ZQ1 = ZSBAR/ZSIGMA
- ! cloud fraction
- PCLDFR(JI,JJ,JK) = MAX( 0., MIN(1.,0.5+0.36*ATAN(1.55*ZQ1)) )
+ IF(HCONDENS == 'GAUS')THEN
+ ! Gaussian Probability Density Function around ZQ1
+ ! Computation of ZG and ZGAM(=erf(ZG))
+ ZGCOND = -ZQ1/SQRT(2.)
- ! total condensate
- IF (ZQ1 > 0. .AND. ZQ1 <= 2 ) THEN
- ZCOND = MIN(EXP(-1.)+.66*ZQ1+.086*ZQ1**2, 2.) ! We use the MIN function for continuity
- ELSE IF (ZQ1 > 2.) THEN
- ZCOND = ZQ1
- ELSE
- ZCOND = EXP( 1.2*ZQ1-1. )
+ !Approximation of erf function for Gaussian distribution
+ ZGAUV = 1 - SIGN(1., ZGCOND) * SQRT(1-EXP(-4*ZGCOND**2/XPI))
+
+ !Computation Cloud Fraction
+ PCLDFR(JI,JJ,JK) = MAX( 0., MIN(1.,0.5*ZGAUV))
+
+ !Computation of condensate
+ ZCOND(JI,JJ,JK) = (EXP(-ZGCOND**2)-ZGCOND*SQRT(XPI)*ZGAUV)*ZSIGMA/SQRT(2.*XPI)
+ ZCOND(JI,JJ,JK) = MAX(ZCOND(JI,JJ,JK), 0.)
+
+ PSIGRC(JI,JJ,JK) = PCLDFR(JI,JJ,JK)
+
+ !Computation warm/cold Cloud Fraction and content in high water content part
+ IF(PRESENT(PHLC_HCF) .AND. PRESENT(PHLC_HRC))THEN
+ IF(1-ZFRAC(JI,JJ,JK) > 1.E-20)THEN
+ ZAUTC = (ZSBAR - XCRIAUTC/(PRHODREF(JI,JJ,JK)*(1-ZFRAC(JI,JJ,JK))))/ZSIGMA
+ ZGAUTC = -ZAUTC/SQRT(2.)
+ !Approximation of erf function for Gaussian distribution
+ ZGAUC = 1 - SIGN(1., ZGAUTC) * SQRT(1-EXP(-4*ZGAUTC**2/XPI))
+ PHLC_HCF(JI,JJ,JK) = MAX( 0., MIN(1.,0.5*ZGAUC))
+ PHLC_HRC(JI,JJ,JK) = (1-ZFRAC(JI,JJ,JK))*(EXP(-ZGAUTC**2)-ZGAUTC*SQRT(XPI)*ZGAUC)*ZSIGMA/SQRT(2.*XPI)
+ PHLC_HRC(JI,JJ,JK) = PHLC_HRC(JI,JJ,JK) + XCRIAUTC/PRHODREF(JI,JJ,JK) * PHLC_HCF(JI,JJ,JK)
+ PHLC_HRC(JI,JJ,JK) = MAX(PHLC_HRC(JI,JJ,JK), 0.)
+ ELSE
+ PHLC_HCF(JI,JJ,JK)=0.
+ PHLC_HRC(JI,JJ,JK)=0.
+ ENDIF
+ ENDIF
+
+ IF(PRESENT(PHLI_HCF) .AND. PRESENT(PHLI_HRI))THEN
+ IF(ZFRAC(JI,JJ,JK) > 1.E-20)THEN
+ ZCRIAUTI(JI,JJ,JK)=MIN(XCRIAUTI,10**(XACRIAUTI*(PT(JI,JJ,JK)-XTT)+XBCRIAUTI))
+ ZAUTI = (ZSBAR - ZCRIAUTI(JI,JJ,JK)/ZFRAC(JI,JJ,JK))/ZSIGMA
+ ZGAUTI = -ZAUTI/SQRT(2.)
+ !Approximation of erf function for Gaussian distribution
+ ZGAUI = 1 - SIGN(1., ZGAUTI) * SQRT(1-EXP(-4*ZGAUTI**2/XPI))
+ PHLI_HCF(JI,JJ,JK) = MAX( 0., MIN(1.,0.5*ZGAUI))
+ PHLI_HRI(JI,JJ,JK) = ZFRAC(JI,JJ,JK)*(EXP(-ZGAUTI**2)-ZGAUTI*SQRT(XPI)*ZGAUI)*ZSIGMA/SQRT(2.*XPI)
+ PHLI_HRI(JI,JJ,JK) = PHLI_HRI(JI,JJ,JK) + ZCRIAUTI(JI,JJ,JK)*PHLI_HCF(JI,JJ,JK)
+ PHLI_HRI(JI,JJ,JK) = MAX(PHLI_HRI(JI,JJ,JK), 0.)
+ ELSE
+ PHLI_HCF(JI,JJ,JK)=0.
+ PHLI_HRI(JI,JJ,JK)=0.
+ ENDIF
+ ENDIF
+
+ ELSEIF(HCONDENS == 'CB02')THEN
+ !Cloud fraction
+ PCLDFR(JI,JJ,JK) = MAX( 0., MIN(1.,0.5+0.36*ATAN(1.55*ZQ1)) )
+
+ !Total condensate
+ IF (ZQ1 > 0. .AND. ZQ1 <= 2) THEN
+ ZCOND(JI,JJ,JK) = MIN(EXP(-1.)+.66*ZQ1+.086*ZQ1**2, 2.) ! We use the MIN function for continuity
+ ELSE IF (ZQ1 > 2.) THEN
+ ZCOND(JI,JJ,JK) = ZQ1
+ ELSE
+ ZCOND(JI,JJ,JK) = EXP( 1.2*ZQ1-1. )
+ ENDIF
+ ZCOND(JI,JJ,JK) = ZCOND(JI,JJ,JK) * ZSIGMA
+
+ INQ1 = MIN( MAX(-22,FLOOR(MIN(100., MAX(-100., 2*ZQ1))) ), 10) !inner min/max prevents sigfpe when 2*zq1 does not fit into an int
+ ZINC = 2.*ZQ1 - INQ1
+
+ PSIGRC(JI,JJ,JK) = MIN(1.,(1.-ZINC)*ZSRC_1D(INQ1)+ZINC*ZSRC_1D(INQ1+1))
+
+ IF(PRESENT(PHLC_HCF) .AND. PRESENT(PHLC_HRC))THEN
+ PHLC_HCF(JI,JJ,JK)=0.
+ PHLC_HRC(JI,JJ,JK)=0.
+ ENDIF
+ IF(PRESENT(PHLI_HCF) .AND. PRESENT(PHLI_HRI))THEN
+ PHLI_HCF(JI,JJ,JK)=0.
+ PHLI_HRI(JI,JJ,JK)=0.
+ ENDIF
ENDIF
- ZCOND = ZCOND * ZSIGMA
- IF ( ZCOND < 1.E-12 ) THEN
- ZCOND = 0.
+ IF ( ZCOND(JI,JJ,JK) < 1.E-12 ) THEN
+ ZCOND(JI,JJ,JK) = 0.
PCLDFR(JI,JJ,JK) = 0.
ENDIF
IF (PCLDFR(JI,JJ,JK)==0.) THEN
- ZCOND=0.
+ ZCOND(JI,JJ,JK)=0.
ENDIF
- PT(JI,JJ,JK) = PT(JI,JJ,JK) + (((1.-ZFRAC(JI,JJ,JK))*ZCOND-PRC(JI,JJ,JK))*ZLV(JI,JJ,JK) + &
- &(ZFRAC(JI,JJ,JK) *ZCOND-PRI(JI,JJ,JK))*ZLS(JI,JJ,JK) ) &
+ ZRCOLD=PRC(JI,JJ,JK)
+ ZRIOLD=PRI(JI,JJ,JK)
+
+ PRC(JI,JJ,JK) = (1.-ZFRAC(JI,JJ,JK)) * ZCOND(JI,JJ,JK) ! liquid condensate
+ PRI(JI,JJ,JK) = ZFRAC(JI,JJ,JK) * ZCOND(JI,JJ,JK) ! solid condensate
+
+ PT(JI,JJ,JK) = PT(JI,JJ,JK) + ((PRC(JI,JJ,JK)-ZRCOLD)*ZLV(JI,JJ,JK) + &
+ &(PRI(JI,JJ,JK)-ZRIOLD)*ZLS(JI,JJ,JK) ) &
& /ZCPD(JI,JJ,JK)
- PRC(JI,JJ,JK) = (1.-ZFRAC(JI,JJ,JK)) * ZCOND ! liquid condensate
- PRI(JI,JJ,JK) = ZFRAC(JI,JJ,JK) * ZCOND ! solid condensate
PRV(JI,JJ,JK) = ZRT(JI,JJ,JK) - PRC(JI,JJ,JK) - PRI(JI,JJ,JK)
-
! s r_c/ sig_s^2
! PSIGRC(JI,JJ,JK) = PCLDFR(JI,JJ,JK) ! use simple Gaussian relation
!
@@ -403,15 +493,17 @@ DO JK=IKTB,IKTE
!
! PSIGRC(JI,JJ,JK) = 2.*PCLDFR(JI,JJ,JK) * MIN( 3. , MAX(1.,1.-ZQ1) )
! in the 3D case lambda_3 = 1.
-! INQ1 = MIN( MAX(-22,FLOOR(2*ZQ1) ), 10)
- INQ1 = MIN( MAX(-22,FLOOR(MIN(100.,MAX(-100.,2*ZQ1))) ), 10)
- !inner min/max prevent sigfpe when 2*zq1 does not fit into an int
- ZINC = 2.*ZQ1 - INQ1
-
- PSIGRC(JI,JJ,JK) = MIN(1.,(1.-ZINC)*ZSRC_1D(INQ1)+ZINC*ZSRC_1D(INQ1+1))
-
- PSIGRC(JI,JJ,JK) = PSIGRC(JI,JJ,JK)* MIN( 3. , MAX(1.,1.-ZQ1) )
+ IF(HLAMBDA3=='CB')THEN
+ PSIGRC(JI,JJ,JK) = PSIGRC(JI,JJ,JK)* MIN( 3. , MAX(1.,1.-ZQ1) )
+ ELSEIF(HLAMBDA3=='NONE') THEN
+ ELSE
+ WRITE(*,*) ' STOP'
+ WRITE(*,*) ' INVALID VALUE FOR HLAMBDA3:', HLAMBDA3
+ CALL ABORT
+ STOP
+ ENDIF
+
END DO
END DO
END DO
diff --git a/src/MNH/deallocate_model1.f90 b/src/MNH/deallocate_model1.f90
index 113521daf..3de1fbb81 100644
--- a/src/MNH/deallocate_model1.f90
+++ b/src/MNH/deallocate_model1.f90
@@ -68,6 +68,7 @@ END MODULE MODI_DEALLOCATE_MODEL1
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
!! 02/2019 C.Lac add rain fraction as an output field
! P. Wautelet 07/06/2019: bugfix: deallocate XLSRVM only if allocated
+! 04/2020 S. Riette, XHL* fields
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -185,6 +186,13 @@ IF ( ASSOCIATED(XSRCT) .AND. KCALL==3 ) THEN
DEALLOCATE(XSIGS)
END IF
!
+IF ( ASSOCIATED(XHLC_HRC) .AND. KCALL==3 ) THEN
+ DEALLOCATE(XHLC_HRC)
+ DEALLOCATE(XHLC_HCF)
+ DEALLOCATE(XHLI_HRI)
+ DEALLOCATE(XHLI_HCF)
+END IF
+!
IF ( ASSOCIATED(XCLDFR) .AND. KCALL==2 ) THEN
DEALLOCATE(XCLDFR)
END IF
diff --git a/src/MNH/default_desfmn.f90 b/src/MNH/default_desfmn.f90
index 6dd86e70f..67fcde53e 100644
--- a/src/MNH/default_desfmn.f90
+++ b/src/MNH/default_desfmn.f90
@@ -208,6 +208,8 @@ END MODULE MODI_DEFAULT_DESFM_n
!! 11/2019 C.Lac correction in the drag formula and application to building in addition to tree
! P. Wautelet 17/04/2020: move budgets switch values into modd_budget
! P. Wautelet 30/06/2020: add NNETURSV, NNEADVSV and NNECONSV variables
+! P-A Joulin 21/05/2021: add Wind turbines
+! S. Riette 21/05/2021: add options to PDF subgrid scheme
!
!-------------------------------------------------------------------------------
!
@@ -515,11 +517,15 @@ LTURB_FLX =.FALSE.
LTURB_DIAG=.FALSE.
LSUBG_COND=.FALSE.
CSUBG_AUCV='NONE'
+CSUBG_AUCV_RI='NONE'
LSIGMAS =.TRUE.
LSIG_CONV =.FALSE.
LRMC01 =.FALSE.
CTOM ='NONE'
VSIGQSAT = 0.02
+CCONDENS='CB02'
+CLAMBDA3='CB'
+CSUBG_MF_PDF='TRIANGLE'
!-------------------------------------------------------------------------------
!
!* 10b. SET DEFAULT VALUES FOR MODD_DRAGTREE :
diff --git a/src/MNH/ice4_compute_pdf.f90 b/src/MNH/ice4_compute_pdf.f90
index dc6a40759..a6fa358a8 100644
--- a/src/MNH/ice4_compute_pdf.f90
+++ b/src/MNH/ice4_compute_pdf.f90
@@ -4,16 +4,20 @@
!MNH_LIC for details. version 1.
MODULE MODI_ICE4_COMPUTE_PDF
INTERFACE
-SUBROUTINE ICE4_COMPUTE_PDF(KSIZE, HSUBG_AUCV, HSUBG_PR_PDF, &
- PRHODREF, PRCT, PCF, PSIGMA_RC,&
- PHLC_HCF, PHLC_LCF, PHLC_HRC, PHLC_LRC, PRF)
+SUBROUTINE ICE4_COMPUTE_PDF(KSIZE, HSUBG_AUCV_RC, HSUBG_AUCV_RI, HSUBG_PR_PDF, &
+ PRHODREF, PRCT, PRIT, PCF, PT, PSIGMA_RC,&
+ PHLC_HCF, PHLC_LCF, PHLC_HRC, PHLC_LRC, &
+ PHLI_HCF, PHLI_LCF, PHLI_HRI, PHLI_LRI, PRF)
IMPLICIT NONE
INTEGER, INTENT(IN) :: KSIZE
-CHARACTER(LEN=4), INTENT(IN) :: HSUBG_AUCV ! Kind of Subgrid autoconversion method
+CHARACTER(LEN=4), INTENT(IN) :: HSUBG_AUCV_RC ! Kind of Subgrid autoconversion method
+CHARACTER(LEN=80), INTENT(IN) :: HSUBG_AUCV_RI ! Kind of Subgrid autoconversion method
CHARACTER(LEN=80), INTENT(IN) :: HSUBG_PR_PDF ! pdf for subgrid precipitation
REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHODREF ! Reference density
REAL, DIMENSION(KSIZE), INTENT(IN) :: PRCT ! Cloud water m.r. at t
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PRIT ! Ice Crystal m.r. at t
REAL, DIMENSION(KSIZE), INTENT(IN) :: PCF ! Cloud fraction
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PT ! Temperature
REAL, DIMENSION(KSIZE), INTENT(IN) :: PSIGMA_RC ! Standard deviation of rc at time t
REAL, DIMENSION(KSIZE), INTENT(OUT) :: PHLC_HCF ! HLCLOUDS : fraction of High Cloud Fraction in grid
REAL, DIMENSION(KSIZE), INTENT(OUT) :: PHLC_LCF ! HLCLOUDS : fraction of Low Cloud Fraction in grid
@@ -21,13 +25,18 @@ REAL, DIMENSION(KSIZE), INTENT(OUT) :: PHLC_LCF ! HLCLOUDS : fraction of Low
REAL, DIMENSION(KSIZE), INTENT(OUT) :: PHLC_HRC ! HLCLOUDS : LWC that is High LWC in grid
REAL, DIMENSION(KSIZE), INTENT(OUT) :: PHLC_LRC ! HLCLOUDS : LWC that is Low LWC in grid
! note that PRC = PHLC_HRC + PHLC_LRC
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PHLI_HCF !
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PHLI_LCF
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PHLI_HRI !
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PHLI_LRI !
REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRF ! Rain fraction
END SUBROUTINE ICE4_COMPUTE_PDF
END INTERFACE
END MODULE MODI_ICE4_COMPUTE_PDF
-SUBROUTINE ICE4_COMPUTE_PDF(KSIZE, HSUBG_AUCV, HSUBG_PR_PDF, &
- PRHODREF, PRCT, PCF, PSIGMA_RC,&
- PHLC_HCF, PHLC_LCF, PHLC_HRC, PHLC_LRC, PRF)
+SUBROUTINE ICE4_COMPUTE_PDF(KSIZE, HSUBG_AUCV_RC, HSUBG_AUCV_RI, HSUBG_PR_PDF, &
+ PRHODREF, PRCT, PRIT, PCF, PT, PSIGMA_RC,&
+ PHLC_HCF, PHLC_LCF, PHLC_HRC, PHLC_LRC, &
+ PHLI_HCF, PHLI_LCF, PHLI_HRI, PHLI_LRI, PRF)
!!
!!** PURPOSE
!! -------
@@ -47,7 +56,8 @@ SUBROUTINE ICE4_COMPUTE_PDF(KSIZE, HSUBG_AUCV, HSUBG_PR_PDF, &
!
!
USE MODD_RAIN_ICE_DESCR, ONLY: XRTMIN
-USE MODD_RAIN_ICE_PARAM, ONLY: XCRIAUTC
+USE MODD_RAIN_ICE_PARAM, ONLY: XCRIAUTC,XBCRIAUTI,XACRIAUTI,XCRIAUTI
+USE MODD_CST, ONLY : XTT
!
USE MODE_MSG
!
@@ -56,11 +66,14 @@ IMPLICIT NONE
!* 0.1 Declarations of dummy arguments :
!
INTEGER, INTENT(IN) :: KSIZE
-CHARACTER(LEN=4), INTENT(IN) :: HSUBG_AUCV ! Kind of Subgrid autoconversion method
+CHARACTER(LEN=4), INTENT(IN) :: HSUBG_AUCV_RC ! Kind of Subgrid autoconversion method for cloud water
+CHARACTER(LEN=80), INTENT(IN) :: HSUBG_AUCV_RI ! Kind of Subgrid autoconversion method for cloud water
CHARACTER(LEN=80), INTENT(IN) :: HSUBG_PR_PDF ! pdf for subgrid precipitation
REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHODREF ! Reference density
REAL, DIMENSION(KSIZE), INTENT(IN) :: PRCT ! Cloud water m.r. at t
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PRIT ! Ice Crystal m.r. at t
REAL, DIMENSION(KSIZE), INTENT(IN) :: PCF ! Cloud fraction
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PT ! Temperature
REAL, DIMENSION(KSIZE), INTENT(IN) :: PSIGMA_RC ! Standard deviation of rc at time t
REAL, DIMENSION(KSIZE), INTENT(OUT) :: PHLC_HCF ! HLCLOUDS : fraction of High Cloud Fraction in grid
REAL, DIMENSION(KSIZE), INTENT(OUT) :: PHLC_LCF ! HLCLOUDS : fraction of Low Cloud Fraction in grid
@@ -68,72 +81,74 @@ REAL, DIMENSION(KSIZE), INTENT(OUT) :: PHLC_LCF ! HLCLOUDS : fraction of Low
REAL, DIMENSION(KSIZE), INTENT(OUT) :: PHLC_HRC ! HLCLOUDS : LWC that is High LWC in grid
REAL, DIMENSION(KSIZE), INTENT(OUT) :: PHLC_LRC ! HLCLOUDS : LWC that is Low LWC in grid
! note that PRC = PHLC_HRC + PHLC_LRC
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PHLI_HCF
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PHLI_LCF
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PHLI_HRI
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PHLI_LRI
REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRF ! Rain fraction
!
!* 0.2 declaration of local variables
!
-REAL, DIMENSION(SIZE(PRHODREF)) :: ZRCRAUTC, & !RC value to begin rain formation =XCRIAUTC/RHODREF
- ZHLC_RCMAX, & !HLCLOUDS : maximum value for RC in distribution
- ZHLC_LRCLOCAL, & !HLCLOUDS : LWC that is Low LWC local in LCF
- ZHLC_HRCLOCAL !HLCLOUDS : LWC that is High LWC local in HCF
+REAL, DIMENSION(KSIZE) :: ZRCRAUTC, & !RC value to begin rain formation =XCRIAUTC/RHODREF
+ ZCRIAUTI, & !RI value to begin snow formation
+ ZHLC_RCMAX, & !HLCLOUDS : maximum value for RC in distribution
+ ZHLC_LRCLOCAL, & !HLCLOUDS : LWC that is Low LWC local in LCF
+ ZHLC_HRCLOCAL, & !HLCLOUDS : LWC that is High LWC local in HCF
! note that ZRC/CF = ZHLC_HRCLOCAL+ ZHLC_LRCLOCAL
! = PHLC_HRC/HCF+ PHLC_LRC/LCF
+ ZSUMRC, ZSUMRI
REAL :: ZCOEFFRCM
!-------------------------------------------------------------------------------
!
!Cloud water split between high and low content part is done according to autoconversion option
ZRCRAUTC(:)=XCRIAUTC/PRHODREF(:) ! Autoconversion rc threshold
-IF(HSUBG_AUCV=='NONE') THEN
+IF(HSUBG_AUCV_RC=='NONE') THEN
!Cloud water is entirely in low or high part
WHERE(PRCT(:)>ZRCRAUTC(:))
PHLC_HCF(:)=1.
PHLC_LCF(:)=0.
PHLC_HRC(:)=PRCT(:)
PHLC_LRC(:)=0.
- PRF(:) =1.
ELSEWHERE(PRCT(:)>XRTMIN(2))
PHLC_HCF(:)=0.
PHLC_LCF(:)=1.
PHLC_HRC(:)=0.
PHLC_LRC(:)=PRCT(:)
- PRF(:) =0.
ELSEWHERE
PHLC_HCF(:)=0.
PHLC_LCF(:)=0.
PHLC_HRC(:)=0.
PHLC_LRC(:)=0.
- PRF(:) =0.
END WHERE
-ELSEIF(HSUBG_AUCV=='CLFR') THEN
+ELSEIF(HSUBG_AUCV_RC=='CLFR') THEN
!Cloud water is only in the cloudy part and entirely in low or high part
- WHERE(PCF(:) > 0. .AND. PRCT(:)>ZRCRAUTC(:)*PCF(:))
+ WHERE(PCF(:)>0. .AND. PRCT(:)>ZRCRAUTC(:)*PCF(:))
PHLC_HCF(:)=PCF(:)
PHLC_LCF(:)=0.
PHLC_HRC(:)=PRCT(:)
PHLC_LRC(:)=0.
- PRF(:) =PCF(:)
- ELSEWHERE(PCF(:) > 0. .AND. PRCT(:)>XRTMIN(2))
+ ELSEWHERE(PCF(:)>0. .AND. PRCT(:)>XRTMIN(2))
PHLC_HCF(:)=0.
PHLC_LCF(:)=PCF(:)
PHLC_HRC(:)=0.0
PHLC_LRC(:)=PRCT(:)
- PRF(:) =0.
- ELSEWHERE (PCF(:) > 0.)
- PHLC_HCF(:)=0.
- PHLC_LCF(:)=0.
- PHLC_HRC(:)=0.
- PHLC_LRC(:)=0.
- PRF(:) =0.
ELSEWHERE
PHLC_HCF(:)=0.
PHLC_LCF(:)=0.
PHLC_HRC(:)=0.
PHLC_LRC(:)=0.
- PRF(:) =0.
END WHERE
-
-ELSEIF(HSUBG_AUCV=='PDF ') THEN
+ELSEIF(HSUBG_AUCV_RC=='ADJU') THEN
+ ZSUMRC(:)=PHLC_LRC(:)+PHLC_HRC(:)
+ WHERE(ZSUMRC .GT. 0.)
+ PHLC_LRC(:)=PHLC_LRC(:)*PRCT(:)/ZSUMRC(:)
+ PHLC_HRC(:)=PHLC_HRC(:)*PRCT(:)/ZSUMRC(:)
+ ELSEWHERE
+ PHLC_LRC(:)=0.
+ PHLC_HRC(:)=0.
+ ENDWHERE
+ELSEIF(HSUBG_AUCV_RC=='PDF ') THEN
!Cloud water is split between high and low part according to a PDF
! 'HLCRECTPDF' : rectangular PDF form
! 'HLCTRIANGPDF' : triangular PDF form
@@ -147,7 +162,6 @@ ELSEIF(HSUBG_AUCV=='PDF ') THEN
PHLC_LCF(:)=0.
PHLC_HRC(:)=PRCT(:)
PHLC_LRC(:)=0.
- PRF(:) =1.
ELSEWHERE(PRCT(:)> (ZRCRAUTC(:)-PSIGMA_RC(:)) .AND. &
& PRCT(:)<=(ZRCRAUTC(:)+PSIGMA_RC(:)) )
PHLC_HCF(:)=(PRCT(:)+PSIGMA_RC(:)-ZRCRAUTC(:))/ &
@@ -157,19 +171,16 @@ ELSEIF(HSUBG_AUCV=='PDF ') THEN
&(PRCT(:)+PSIGMA_RC(:)+ZRCRAUTC(:))/ &
&(4.*PSIGMA_RC(:))
PHLC_LRC(:)=MAX(0., PRCT(:)-PHLC_HRC(:))
- PRF(:) =PHLC_HCF(:)
ELSEWHERE(PRCT(:)>XRTMIN(2) .AND. PCF(:)>0.)
PHLC_HCF(:)=0.
PHLC_LCF(:)=PCF(:)
PHLC_HRC(:)=0.
PHLC_LRC(:)=PRCT(:)
- PRF(:) =0.
ELSEWHERE
PHLC_HCF(:)=0.
PHLC_LCF(:)=0.
PHLC_HRC(:)=0.
PHLC_LRC(:)=0.
- PRF(:) =0.
END WHERE
! Turner (2011, 2012)
ELSEIF(HSUBG_PR_PDF=='HLCRECTPDF' .OR. HSUBG_PR_PDF=='HLCISOTRIPDF' .OR. &
@@ -248,7 +259,6 @@ ELSEIF(HSUBG_AUCV=='PDF ') THEN
PHLC_LRC(:)=0.
PHLC_HRC(:)=0.
END WHERE
- PRF(:)=PHLC_HCF(:) !Precipitation fraction
ELSE
CALL PRINT_MSG(NVERB_FATAL,'GEN','ICE4_COMPUTE_PDF','wrong HSUBG_PR_PDF case')
ENDIF
@@ -256,4 +266,59 @@ ELSE
CALL PRINT_MSG(NVERB_FATAL,'GEN','ICE4_COMPUTE_PDF','wrong HSUBG_AUCV case')
ENDIF
!
+!Ice water split between high and low content part is done according to autoconversion option
+ZCRIAUTI(:)=MIN(XCRIAUTI,10**(XACRIAUTI*(PT(:)-XTT)+XBCRIAUTI)) ! Autoconversion ri threshold
+IF(HSUBG_AUCV_RI=='NONE') THEN
+ !Cloud water is entirely in low or high part
+ WHERE(PRIT(:)>ZCRIAUTI(:))
+ PHLI_HCF(:)=1.
+ PHLI_LCF(:)=0.
+ PHLI_HRI(:)=PRIT(:)
+ PHLI_LRI(:)=0.
+ ELSEWHERE(PRIT(:)>XRTMIN(2))
+ PHLI_HCF(:)=0.
+ PHLI_LCF(:)=1.
+ PHLI_HRI(:)=0.
+ PHLI_LRI(:)=PRIT(:)
+ ELSEWHERE
+ PHLI_HCF(:)=0.
+ PHLI_LCF(:)=0.
+ PHLI_HRI(:)=0.
+ PHLI_LRI(:)=0.
+ END WHERE
+ELSEIF(HSUBG_AUCV_RI=='CLFR') THEN
+ !Cloud water is only in the cloudy part and entirely in low or high part
+ WHERE(PCF(:)>0. .AND. PRIT(:)>ZCRIAUTI(:)*PCF(:))
+ PHLI_HCF(:)=PCF(:)
+ PHLI_LCF(:)=0.
+ PHLI_HRI(:)=PRIT(:)
+ PHLI_LRI(:)=0.
+ ELSEWHERE(PCF(:)>0. .AND. PRIT(:)>XRTMIN(2))
+ PHLI_HCF(:)=0.
+ PHLI_LCF(:)=PCF(:)
+ PHLI_HRI(:)=0.0
+ PHLI_LRI(:)=PRIT(:)
+ ELSEWHERE
+ PHLI_HCF(:)=0.
+ PHLI_LCF(:)=0.
+ PHLI_HRI(:)=0.
+ PHLI_LRI(:)=0.
+ END WHERE
+ELSEIF(HSUBG_AUCV_RI=='ADJU') THEN
+ ZSUMRI(:)=PHLI_LRI(:)+PHLI_HRI(:)
+ WHERE(ZSUMRI .GT. 0.)
+ PHLI_LRI(:)=PHLI_LRI(:)*PRIT(:)/ZSUMRI(:)
+ PHLI_HRI(:)=PHLI_HRI(:)*PRIT(:)/ZSUMRI(:)
+ ELSEWHERE
+ PHLI_LRI(:)=0.
+ PHLI_HRI(:)=0.
+ ENDWHERE
+ELSE
+ !wrong HSUBG_AUCV_RI case
+ CALL ABORT
+ STOP 'wrong HSUBG_AUCV_RI case'
+ENDIF
+!
+PRF=MAX(PHLC_HCF,PHLI_HCF)
+!
END SUBROUTINE ICE4_COMPUTE_PDF
diff --git a/src/MNH/ice4_fast_rg.f90 b/src/MNH/ice4_fast_rg.f90
index 8a52f858e..053daf601 100644
--- a/src/MNH/ice4_fast_rg.f90
+++ b/src/MNH/ice4_fast_rg.f90
@@ -5,13 +5,13 @@
!-----------------------------------------------------------------
MODULE MODI_ICE4_FAST_RG
INTERFACE
-SUBROUTINE ICE4_FAST_RG(KSIZE, LDSOFT, LDCOMPUTE, KRR, &
+SUBROUTINE ICE4_FAST_RG(KSIZE, LDSOFT, PCOMPUTE, KRR, &
&PRHODREF, PLVFACT, PLSFACT, PPRES, &
&PDV, PKA, PCJ, PCIT, &
&PLBDAR, PLBDAS, PLBDAG, &
&PT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
&PRGSI, PRGSI_MR, &
- &LDWETG, &
+ &PWETG, &
&PRICFRRG, PRRCFRIG, PRICFRR, PRCWETG, PRIWETG, PRRWETG, PRSWETG, &
&PRCDRYG, PRIDRYG, PRRDRYG, PRSDRYG, PRWETGH, PRWETGH_MR, PRGMLTR, &
&PRG_TEND, &
@@ -19,7 +19,7 @@ SUBROUTINE ICE4_FAST_RG(KSIZE, LDSOFT, LDCOMPUTE, KRR, &
IMPLICIT NONE
INTEGER, INTENT(IN) :: KSIZE
LOGICAL, INTENT(IN) :: LDSOFT
-LOGICAL, DIMENSION(KSIZE), INTENT(IN) :: LDCOMPUTE
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PCOMPUTE
INTEGER, INTENT(IN) :: KRR ! Number of moist variable
REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHODREF ! Reference density
REAL, DIMENSION(KSIZE), INTENT(IN) :: PLVFACT
@@ -41,7 +41,7 @@ REAL, DIMENSION(KSIZE), INTENT(IN) :: PRST ! Snow/aggregate m.r. at
REAL, DIMENSION(KSIZE), INTENT(IN) :: PRGT ! Graupel m.r. at t
REAL, DIMENSION(KSIZE), INTENT(IN) :: PRGSI ! Graupel tendency by other processes
REAL, DIMENSION(KSIZE), INTENT(IN) :: PRGSI_MR ! Graupel mr change by other processes
-LOGICAL, DIMENSION(KSIZE), INTENT(OUT) :: LDWETG ! True where graupel grows in wet mode
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PWETG ! 1. where graupel grows in wet mode, 0. elsewhere
REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRICFRRG ! Rain contact freezing
REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRRCFRIG ! Rain contact freezing
REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRICFRR ! Rain contact freezing
@@ -56,7 +56,7 @@ REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRSDRYG ! Graupel dry growth
REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRWETGH ! Conversion of graupel into hail
REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRWETGH_MR ! Conversion of graupel into hail, mr change
REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRGMLTR ! Melting of the graupel
-REAL, DIMENSION(KSIZE, 6), INTENT(INOUT) :: PRG_TEND ! Individual tendencies
+REAL, DIMENSION(KSIZE, 8), INTENT(INOUT) :: PRG_TEND ! Individual tendencies
REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_TH
REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RC
REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RR
@@ -69,13 +69,13 @@ REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PB_RH
END SUBROUTINE ICE4_FAST_RG
END INTERFACE
END MODULE MODI_ICE4_FAST_RG
-SUBROUTINE ICE4_FAST_RG(KSIZE, LDSOFT, LDCOMPUTE, KRR, &
+SUBROUTINE ICE4_FAST_RG(KSIZE, LDSOFT, PCOMPUTE, KRR, &
&PRHODREF, PLVFACT, PLSFACT, PPRES, &
&PDV, PKA, PCJ, PCIT, &
&PLBDAR, PLBDAS, PLBDAG, &
&PT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
&PRGSI, PRGSI_MR, &
- &LDWETG, &
+ &PWETG, &
&PRICFRRG, PRRCFRIG, PRICFRR, PRCWETG, PRIWETG, PRRWETG, PRSWETG, &
&PRCDRYG, PRIDRYG, PRRDRYG, PRSDRYG, PRWETGH, PRWETGH_MR, PRGMLTR, &
&PRG_TEND, &
@@ -99,7 +99,8 @@ SUBROUTINE ICE4_FAST_RG(KSIZE, LDSOFT, LDCOMPUTE, KRR, &
!* 0. DECLARATIONS
! ------------
!
-USE MODD_CST, ONLY: XALPI,XALPW,XBETAI,XBETAW,XGAMW,XCI,XCL,XCPV,XESTT,XGAMI,XLMTT,XLVTT,XMD,XMV,XRV,XTT
+USE MODD_CST, ONLY: XALPI,XALPW,XBETAI,XBETAW,XGAMW,XCI,XCL,XCPV,XESTT,XGAMI,XLMTT,XLVTT,XMD,XMV,XRV,XTT, &
+ XEPSILO
USE MODD_PARAM_ICE, ONLY: LCRFLIMIT,LEVLIMIT,LNULLWETG,LWETGPOST
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, &
@@ -113,7 +114,7 @@ IMPLICIT NONE
!
INTEGER, INTENT(IN) :: KSIZE
LOGICAL, INTENT(IN) :: LDSOFT
-LOGICAL, DIMENSION(KSIZE), INTENT(IN) :: LDCOMPUTE
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PCOMPUTE
INTEGER, INTENT(IN) :: KRR ! Number of moist variable
REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHODREF ! Reference density
REAL, DIMENSION(KSIZE), INTENT(IN) :: PLVFACT
@@ -135,7 +136,7 @@ REAL, DIMENSION(KSIZE), INTENT(IN) :: PRST ! Snow/aggregate m.r. at
REAL, DIMENSION(KSIZE), INTENT(IN) :: PRGT ! Graupel m.r. at t
REAL, DIMENSION(KSIZE), INTENT(IN) :: PRGSI ! Graupel tendency by other processes
REAL, DIMENSION(KSIZE), INTENT(IN) :: PRGSI_MR ! Graupel mr change by other processes
-LOGICAL, DIMENSION(KSIZE), INTENT(OUT) :: LDWETG ! True where graupel grows in wet mode
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PWETG ! 1. where graupel grows in wet mode, 0. elsewhere
REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRICFRRG ! Rain contact freezing
REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRRCFRIG ! Rain contact freezing
REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRICFRR ! Rain contact freezing
@@ -150,7 +151,7 @@ REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRSDRYG ! Graupel dry growth
REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRWETGH ! Conversion of graupel into hail
REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRWETGH_MR ! Conversion of graupel into hail, mr change
REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRGMLTR ! Melting of the graupel
-REAL, DIMENSION(KSIZE, 6), INTENT(INOUT) :: PRG_TEND ! Individual tendencies
+REAL, DIMENSION(KSIZE, 8), INTENT(INOUT) :: PRG_TEND ! Individual tendencies
REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_TH
REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RC
REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RR
@@ -163,34 +164,39 @@ REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PB_RH
!
!* 0.2 declaration of local variables
!
-INTEGER, PARAMETER :: IRCDRYG=1, IRIDRYG=2, IRIWETG=3, IRSDRYG=4, IRSWETG=5, IRRDRYG=6
+INTEGER, PARAMETER :: IRCDRYG=1, IRIDRYG=2, IRIWETG=3, IRSDRYG=4, IRSWETG=5, IRRDRYG=6, &
+ & IFREEZ1=7, IFREEZ2=8
!
-LOGICAL, DIMENSION(SIZE(PRHODREF)) :: GDRY, LLDRYG, GMASK
+LOGICAL, DIMENSION(KSIZE) :: GDRY
+INTEGER, DIMENSION(KSIZE) :: I1
+REAL, DIMENSION(KSIZE) :: ZDRY, ZDRYG, ZMASK
INTEGER :: IGDRY
-REAL, DIMENSION(SIZE(PRHODREF)) :: ZVEC1, ZVEC2, ZVEC3
-INTEGER, DIMENSION(SIZE(PRHODREF)) :: I1
-INTEGER, DIMENSION(SIZE(PRHODREF)) :: IVEC1, IVEC2
-REAL, DIMENSION(SIZE(PRHODREF)) :: ZZW, &
+REAL, DIMENSION(KSIZE) :: ZVEC1, ZVEC2, ZVEC3
+INTEGER, DIMENSION(KSIZE) :: IVEC1, IVEC2
+REAL, DIMENSION(KSIZE) :: ZZW, &
ZRDRYG_INIT, & !Initial dry growth rate of the graupeln
ZRWETG_INIT !Initial wet growth rate of the graupeln
-INTEGER :: JJ
+INTEGER :: JJ, JL
!
!-------------------------------------------------------------------------------
!
!* 6.1 rain contact freezing
!
-GMASK(:)=PRIT(:)>XRTMIN(4) .AND. PRRT(:)>XRTMIN(3) .AND. LDCOMPUTE(:)
+DO JL=1, KSIZE
+ ZMASK(JL)=MAX(0., -SIGN(1., XRTMIN(4)-PRIT(JL))) * & ! WHERE(PRIT(:)>XRTMIN(4))
+ &MAX(0., -SIGN(1., XRTMIN(3)-PRRT(JL))) * & ! WHERE(PRRT(:)>XRTMIN(3))
+ &PCOMPUTE(JL)
+ENDDO
IF(LDSOFT) THEN
- WHERE(.NOT. GMASK(:))
- PRICFRRG(:)=0.
- PRRCFRIG(:)=0.
- PRICFRR(:)=0.
- ENDWHERE
+ DO JL=1, KSIZE
+ PRICFRRG(JL)=ZMASK(JL) * PRICFRRG(JL)
+ PRRCFRIG(JL)=ZMASK(JL) * PRRCFRIG(JL)
+ PRICFRR(JL)=ZMASK(JL) * PRICFRR(JL)
+ ENDDO
ELSE
PRICFRRG(:)=0.
PRRCFRIG(:)=0.
- PRICFRR(:)=0.
- WHERE(GMASK(:))
+ WHERE(ZMASK(:)==1.)
PRICFRRG(:) = XICFRR*PRIT(:) & ! RICFRRG
*PLBDAR(:)**XEXICFRR &
*PRHODREF(:)**(-XCEXVT)
@@ -198,50 +204,68 @@ ELSE
* PLBDAR(:)**XEXRCFRI &
* PRHODREF(:)**(-XCEXVT-1.)
END WHERE
- ZZW(:)=1.
+
IF(LCRFLIMIT) THEN
- WHERE(GMASK(:))
+ DO JL=1, KSIZE
!Comparison between heat to be released (to freeze rain) and heat sink (rain and ice temperature change)
!ZZW is the proportion of process that can take place
- ZZW(:) = MAX(0., MIN(1., (PRICFRRG(:)*XCI+PRRCFRIG(:)*XCL)*(XTT-PT(:)) / &
- MAX(1.E-20, XLVTT*PRRCFRIG(:))))
- ENDWHERE
+ ZZW(JL)=(1.-ZMASK(JL)) + & ! 1. outside of mask
+ ZMASK(JL) * MAX(0., MIN(1., (PRICFRRG(JL)*XCI+PRRCFRIG(JL)*XCL)*(XTT-PT(JL)) / &
+ MAX(1.E-20, XLVTT*PRRCFRIG(JL))))
+ ENDDO
+ ELSE
+ ZZW(:)=1.
ENDIF
- PRRCFRIG(:) = ZZW(:) * PRRCFRIG(:) !Part of rain that can be freezed
- PRICFRR(:) = (1-ZZW(:)) * PRICFRRG(:) !Part of collected pristine ice converted to rain
- PRICFRRG(:) = ZZW(:) * PRICFRRG(:) !Part of collected pristine ice that lead to graupel
+ DO JL=1, KSIZE
+ PRRCFRIG(JL) = ZZW(JL) * PRRCFRIG(JL) !Part of rain that can be freezed
+ PRICFRR(JL) = (1.-ZZW(JL)) * PRICFRRG(JL) !Part of collected pristine ice converted to rain
+ PRICFRRG(JL) = ZZW(JL) * PRICFRRG(JL) !Part of collected pristine ice that lead to graupel
+ ENDDO
ENDIF
-PA_RI(:) = PA_RI(:) - PRICFRRG(:) - PRICFRR(:)
-PA_RR(:) = PA_RR(:) - PRRCFRIG(:) + PRICFRR(:)
-PA_RG(:) = PA_RG(:) + PRICFRRG(:) + PRRCFRIG(:)
-PA_TH(:) = PA_TH(:) + (PRRCFRIG(:) - PRICFRR(:))*(PLSFACT(:)-PLVFACT(:))
+DO JL=1, KSIZE
+ PA_RI(JL) = PA_RI(JL) - PRICFRRG(JL) - PRICFRR(JL)
+ PA_RR(JL) = PA_RR(JL) - PRRCFRIG(JL) + PRICFRR(JL)
+ PA_RG(JL) = PA_RG(JL) + PRICFRRG(JL) + PRRCFRIG(JL)
+ PA_TH(JL) = PA_TH(JL) + (PRRCFRIG(JL) - PRICFRR(JL))*(PLSFACT(JL)-PLVFACT(JL))
+ENDDO
!
!
!* 6.3 compute the graupel growth
!
! Wet and dry collection of rc and ri on graupel
-GMASK(:)=PRGT(:)>XRTMIN(6) .AND. PRCT(:)>XRTMIN(2) .AND. LDCOMPUTE(:)
+DO JL=1, KSIZE
+ ZMASK(JL)=MAX(0., -SIGN(1., XRTMIN(6)-PRGT(JL))) * & ! WHERE(PRGT(:)>XRTMIN(6))
+ &MAX(0., -SIGN(1., XRTMIN(2)-PRCT(JL))) * & ! WHERE(PRCT(:)>XRTMIN(2))
+ &PCOMPUTE(JL)
+ENDDO
IF(LDSOFT) THEN
- WHERE(.NOT. GMASK(:))
- PRG_TEND(:, IRCDRYG)=0.
- END WHERE
+ DO JL=1, KSIZE
+ PRG_TEND(JL, IRCDRYG)=ZMASK(JL)*PRG_TEND(JL, IRCDRYG)
+ ENDDO
ELSE
- PRG_TEND(:, IRCDRYG)=0.
- WHERE(GMASK(:))
+ ZZW(:)=0.
+ WHERE(ZMASK(:)==1.)
ZZW(:)=PLBDAG(:)**(XCXG-XDG-2.) * PRHODREF(:)**(-XCEXVT)
- PRG_TEND(:, IRCDRYG)=XFCDRYG * PRCT(:) * ZZW(:)
END WHERE
+ DO JL=1, KSIZE
+ PRG_TEND(JL, IRCDRYG)=ZMASK(JL)*XFCDRYG * PRCT(JL) * ZZW(JL)
+ ENDDO
ENDIF
-GMASK(:)=PRGT(:)>XRTMIN(6) .AND. PRIT(:)>XRTMIN(4) .AND. LDCOMPUTE(:)
+
+DO JL=1, KSIZE
+ ZMASK(JL)=MAX(0., -SIGN(1., XRTMIN(6)-PRGT(JL))) * & ! WHERE(PRGT(:)>XRTMIN(6))
+ &MAX(0., -SIGN(1., XRTMIN(4)-PRIT(JL))) * & ! WHERE(PRIT(:)>XRTMIN(4))
+ &PCOMPUTE(JL)
+ENDDO
IF(LDSOFT) THEN
- WHERE(.NOT. GMASK(:))
- PRG_TEND(:, IRIDRYG)=0.
- PRG_TEND(:, IRIWETG)=0.
- END WHERE
+ DO JL=1, KSIZE
+ PRG_TEND(JL, IRIDRYG)=ZMASK(JL) * PRG_TEND(JL, IRIDRYG)
+ PRG_TEND(JL, IRIWETG)=ZMASK(JL) * PRG_TEND(JL, IRIWETG)
+ ENDDO
ELSE
PRG_TEND(:, IRIDRYG)=0.
PRG_TEND(:, IRIWETG)=0.
- WHERE(GMASK(:))
+ WHERE(ZMASK(:)==1.)
ZZW(:)=PLBDAG(:)**(XCXG-XDG-2.) * PRHODREF(:)**(-XCEXVT)
PRG_TEND(:, IRIDRYG)=XFIDRYG*EXP(XCOLEXIG*(PT(:)-XTT))*PRIT(:)*ZZW(:)
PRG_TEND(:, IRIWETG)=PRG_TEND(:, IRIDRYG) / (XCOLIG*EXP(XCOLEXIG*(PT(:)-XTT)))
@@ -251,7 +275,10 @@ ENDIF
! Wet and dry collection of rs on graupel (6.2.1)
IGDRY = 0
DO JJ = 1, SIZE(GDRY)
- IF (PRST(JJ)>XRTMIN(5) .AND. PRGT(JJ)>XRTMIN(6) .AND. LDCOMPUTE(JJ)) THEN
+ ZDRY(JJ)=MAX(0., -SIGN(1., XRTMIN(5)-PRST(JJ))) * & ! WHERE(PRST(:)>XRTMIN(5))
+ &MAX(0., -SIGN(1., XRTMIN(6)-PRGT(JJ))) * & ! WHERE(PRGT(:)>XRTMIN(6))
+ &PCOMPUTE(JJ)
+ IF (PRST(JJ)>XRTMIN(5) .AND. PRGT(JJ)>XRTMIN(6) .AND. PCOMPUTE(JJ)>0.) THEN
IGDRY = IGDRY + 1
I1(IGDRY) = JJ
GDRY(JJ) = .TRUE.
@@ -261,10 +288,10 @@ DO JJ = 1, SIZE(GDRY)
END DO
IF(LDSOFT) THEN
- WHERE(.NOT. GDRY(:))
- PRG_TEND(:, IRSDRYG)=0.
- PRG_TEND(:, IRSWETG)=0.
- END WHERE
+ DO JL=1, KSIZE
+ PRG_TEND(JL, IRSDRYG)=ZDRY(JL) * PRG_TEND(JL, IRSDRYG)
+ PRG_TEND(JL, IRSWETG)=ZDRY(JL) * PRG_TEND(JL, IRSWETG)
+ ENDDO
ELSE
PRG_TEND(:, IRSDRYG)=0.
PRG_TEND(:, IRSWETG)=0.
@@ -324,7 +351,10 @@ ENDIF
!
IGDRY = 0
DO JJ = 1, SIZE(GDRY)
- IF (PRRT(JJ)>XRTMIN(3) .AND. PRGT(JJ)>XRTMIN(6) .AND. LDCOMPUTE(JJ)) THEN
+ ZDRY(JJ)=MAX(0., -SIGN(1., XRTMIN(3)-PRRT(JJ))) * & ! WHERE(PRRT(:)>XRTMIN(3))
+ &MAX(0., -SIGN(1., XRTMIN(6)-PRGT(JJ))) * & ! WHERE(PRGT(:)>XRTMIN(6))
+ &PCOMPUTE(JJ)
+ IF (PRRT(JJ)>XRTMIN(3) .AND. PRGT(JJ)>XRTMIN(6) .AND. PCOMPUTE(JJ)>0.) THEN
IGDRY = IGDRY + 1
I1(IGDRY) = JJ
GDRY(JJ) = .TRUE.
@@ -334,9 +364,9 @@ DO JJ = 1, SIZE(GDRY)
END DO
IF(LDSOFT) THEN
- WHERE(.NOT. GDRY(:))
- PRG_TEND(:, IRRDRYG)=0.
- END WHERE
+ DO JL=1, KSIZE
+ PRG_TEND(JL, IRRDRYG)=ZDRY(JL) * PRG_TEND(JL, IRRDRYG)
+ ENDDO
ELSE
PRG_TEND(:, IRRDRYG)=0.
!
@@ -390,47 +420,77 @@ ELSE
ENDIF
ENDIF
-ZRDRYG_INIT(:)=PRG_TEND(:, IRCDRYG)+PRG_TEND(:, IRIDRYG)+PRG_TEND(:, IRSDRYG)+PRG_TEND(:, IRRDRYG)
+DO JL=1, KSIZE
+ ZRDRYG_INIT(JL)=PRG_TEND(JL, IRCDRYG)+PRG_TEND(JL, IRIDRYG)+ &
+ &PRG_TEND(JL, IRSDRYG)+PRG_TEND(JL, IRRDRYG)
+ENDDO
!Freezing rate
-ZRWETG_INIT(:)=0.
-GMASK(:)=PRGT(:)>XRTMIN(6) .AND. LDCOMPUTE(:)
-WHERE(GMASK(:))
- ZRWETG_INIT(:)=PRVT(:)*PPRES(:)/((XMV/XMD)+PRVT(:)) ! Vapor pressure
-END WHERE
-IF(LEVLIMIT) THEN
- WHERE(GMASK(:))
- ZRWETG_INIT(:)=MIN(ZRWETG_INIT(:), EXP(XALPI-XBETAI/PT(:)-XGAMI*ALOG(PT(:)))) ! min(ev, es_i(T))
+DO JL=1, KSIZE
+ ZMASK(JL)=MAX(0., -SIGN(1., XRTMIN(6)-PRGT(JL))) * & ! WHERE(PRGT(:)>XRTMIN(6))
+ &PCOMPUTE(JL)
+ENDDO
+IF(LDSOFT) THEN
+ DO JL=1, KSIZE
+ PRG_TEND(JL, IFREEZ1)=ZMASK(JL) * PRG_TEND(JL, IFREEZ1)
+ PRG_TEND(JL, IFREEZ2)=ZMASK(JL) * PRG_TEND(JL, IFREEZ2)
+ ENDDO
+ELSE
+ DO JL=1, KSIZE
+ PRG_TEND(JL, IFREEZ1)=ZMASK(JL) * PRVT(JL)*PPRES(JL)/(XEPSILO+PRVT(JL)) ! Vapor pressure
+ ENDDO
+ IF(LEVLIMIT) THEN
+ WHERE(ZMASK(:)==1.)
+ PRG_TEND(:, IFREEZ1)=MIN(PRG_TEND(:, IFREEZ1), EXP(XALPI-XBETAI/PT(:)-XGAMI*ALOG(PT(:)))) ! min(ev, es_i(T))
+ END WHERE
+ ENDIF
+ PRG_TEND(:, IFREEZ2)=0.
+ WHERE(ZMASK(:)==1.)
+ PRG_TEND(:, IFREEZ1)=PKA(:)*(XTT-PT(:)) + &
+ (PDV(:)*(XLVTT+(XCPV-XCL)*(PT(:)-XTT)) &
+ *(XESTT-PRG_TEND(:, IFREEZ1))/(XRV*PT(:)) )
+ PRG_TEND(:, IFREEZ1)=PRG_TEND(:, IFREEZ1)* ( X0DEPG* PLBDAG(:)**XEX0DEPG + &
+ X1DEPG*PCJ(:)*PLBDAG(:)**XEX1DEPG )/ &
+ ( PRHODREF(:)*(XLMTT-XCL*(XTT-PT(:))) )
+ PRG_TEND(:, IFREEZ2)=(PRHODREF(:)*(XLMTT+(XCI-XCL)*(XTT-PT(:))) ) / &
+ ( PRHODREF(:)*(XLMTT-XCL*(XTT-PT(:))) )
END WHERE
ENDIF
-WHERE(GMASK(:))
- ZRWETG_INIT(:)=PKA(:)*(XTT-PT(:)) + &
- (PDV(:)*(XLVTT+(XCPV-XCL)*(PT(:)-XTT)) &
- *(XESTT-ZRWETG_INIT(:))/(XRV*PT(:)) )
- ZRWETG_INIT(:)=MAX(0., &
- (ZRWETG_INIT(:) * ( X0DEPG* PLBDAG(:)**XEX0DEPG + &
- X1DEPG*PCJ(:)*PLBDAG(:)**XEX1DEPG ) + &
- (PRG_TEND(:, IRIWETG)+PRG_TEND(:, IRSWETG) ) * &
- (PRHODREF(:)*(XLMTT+(XCI-XCL)*(XTT-PT(:))) ) ) / &
- ( PRHODREF(:)*(XLMTT-XCL*(XTT-PT(:))) ) )
+DO JL=1, KSIZE
!We must agregate, at least, the cold species
- ZRWETG_INIT(:)=MAX(ZRWETG_INIT(:), PRG_TEND(:, IRIWETG)+PRG_TEND(:, IRSWETG))
-END WHERE
+ ZRWETG_INIT(JL)=ZMASK(JL) * MAX(PRG_TEND(JL, IRIWETG)+PRG_TEND(JL, IRSWETG), &
+ &MAX(0., PRG_TEND(JL, IFREEZ1) + &
+ &PRG_TEND(JL, IFREEZ2) * ( &
+ &PRG_TEND(JL, IRIWETG)+PRG_TEND(JL, IRSWETG) )))
+ENDDO
!Growth mode
-LDWETG(:)=GMASK(:) .AND. &
- &MAX(0., ZRDRYG_INIT(:)-PRG_TEND(:, IRIDRYG)-PRG_TEND(:, IRSDRYG))>= &
- &MAX(0., ZRWETG_INIT(:)-PRG_TEND(:, IRIWETG)-PRG_TEND(:, IRSWETG))
+DO JL=1, KSIZE
+ PWETG(JL) = ZMASK(JL) * & !
+ & MAX(0., SIGN(1., MAX(0., ZRDRYG_INIT(JL)-PRG_TEND(JL, IRIDRYG)-PRG_TEND(JL, IRSDRYG)) - &
+ &MAX(0., ZRWETG_INIT(JL)-PRG_TEND(JL, IRIWETG)-PRG_TEND(JL, IRSWETG))))
+ENDDO
IF(LNULLWETG) THEN
- LDWETG(:)=LDWETG(:) .AND. ZRDRYG_INIT(:)>0.
+ DO JL=1, KSIZE
+ PWETG(JL) = PWETG(JL) * MAX(0., -SIGN(1., -ZRDRYG_INIT(JL)))
+ ENDDO
ELSE
- LDWETG(:)=LDWETG(:) .AND. ZRWETG_INIT(:)>0.
+ DO JL=1, KSIZE
+ PWETG(JL) = PWETG(JL) * MAX(0., -SIGN(1., -ZRWETG_INIT(JL)))
+ ENDDO
ENDIF
-IF(.NOT. LWETGPOST) LDWETG(:)=LDWETG(:) .AND. PT(:)<XTT
-
-LLDRYG(:)=GMASK(:) .AND. PT(:)<XTT .AND. ZRDRYG_INIT(:)>0. .AND. &
- &MAX(0., ZRDRYG_INIT(:)-PRG_TEND(:, IRIDRYG)-PRG_TEND(:, IRSDRYG))<&
- &MAX(0., ZRWETG_INIT(:)-PRG_TEND(:, IRIWETG)-PRG_TEND(:, IRSWETG))
+IF(.NOT. LWETGPOST) THEN
+ DO JL=1, KSIZE
+ PWETG(JL) = PWETG(JL) * MAX(0., -SIGN(1., PT(JL)-XTT))
+ ENDDO
+ENDIF
+DO JL=1, KSIZE
+ ZDRYG(JL) = ZMASK(JL) * & !
+ & MAX(0., -SIGN(1., PT(JL)-XTT)) * & ! WHERE(PT(:)<XTT)
+ & MAX(0., -SIGN(1., 1.E-20-ZRDRYG_INIT(JL))) * & ! WHERE(ZRDRYG_INIT(:)>0.)
+ & MAX(0., -SIGN(1., MAX(0., ZRDRYG_INIT(JL)-PRG_TEND(JL, IRIDRYG)-PRG_TEND(JL, IRSDRYG)) - &
+ &MAX(0., ZRWETG_INIT(JL)-PRG_TEND(JL, IRIWETG)-PRG_TEND(JL, IRSWETG))))
+ENDDO
! Part of ZRWETG to be converted into hail
! Graupel can be produced by other processes instantaneously (inducing a mixing ratio change, PRGSI_MR) or
@@ -438,75 +498,70 @@ LLDRYG(:)=GMASK(:) .AND. PT(:)<XTT .AND. ZRDRYG_INIT(:)>0. .AND. &
PRWETGH(:)=0.
PRWETGH_MR(:)=0.
IF(KRR==7) THEN
- WHERE(LDWETG(:))
+ WHERE(PWETG(:)==1.)
!assume a linear percent of conversion of produced graupel into hail
PRWETGH(:)=(MAX(0., PRGSI(:)+PRICFRRG(:)+PRRCFRIG(:))+ZRWETG_INIT(:))*ZRDRYG_INIT(:)/(ZRWETG_INIT(:)+ZRDRYG_INIT(:))
PRWETGH_MR(:)=MAX(0., PRGSI_MR(:))*ZRDRYG_INIT(:)/(ZRWETG_INIT(:)+ZRDRYG_INIT(:))
END WHERE
ENDIF
-PRCWETG(:)=0.
-PRIWETG(:)=0.
-PRSWETG(:)=0.
-PRRWETG(:)=0.
-WHERE(LDWETG(:))
+DO JL=1, KSIZE
!Aggregated minus collected
- PRRWETG(:)=-(PRG_TEND(:, IRIWETG)+PRG_TEND(:, IRSWETG)+PRG_TEND(:, IRCDRYG)-ZRWETG_INIT(:))
- PRCWETG(:)=PRG_TEND(:, IRCDRYG)
- PRIWETG(:)=PRG_TEND(:, IRIWETG)
- PRSWETG(:)=PRG_TEND(:, IRSWETG)
-END WHERE
-PRCDRYG(:)=0.
-PRIDRYG(:)=0.
-PRRDRYG(:)=0.
-PRSDRYG(:)=0.
-WHERE(LLDRYG(:))
- PRCDRYG(:)=PRG_TEND(:, IRCDRYG)
- PRRDRYG(:)=PRG_TEND(:, IRRDRYG)
- PRIDRYG(:)=PRG_TEND(:, IRIDRYG)
- PRSDRYG(:)=PRG_TEND(:, IRSDRYG)
-END WHERE
-PA_RC(:) = PA_RC(:) - PRCWETG(:)
-PA_RI(:) = PA_RI(:) - PRIWETG(:)
-PA_RS(:) = PA_RS(:) - PRSWETG(:)
-PA_RG(:) = PA_RG(:) + PRCWETG(:) + PRIWETG(:) + PRSWETG(:) + PRRWETG(:)
-PA_RR(:) = PA_RR(:) - PRRWETG(:)
-PA_TH(:) = PA_TH(:) + (PRCWETG(:) + PRRWETG(:))*(PLSFACT(:)-PLVFACT(:))
-PA_RG(:) = PA_RG(:) - PRWETGH(:)
-PA_RH(:) = PA_RH(:) + PRWETGH(:)
-PB_RG(:) = PB_RG(:) - PRWETGH_MR(:)
-PB_RH(:) = PB_RH(:) + PRWETGH_MR(:)
-PA_RC(:) = PA_RC(:) - PRCDRYG(:)
-PA_RI(:) = PA_RI(:) - PRIDRYG(:)
-PA_RS(:) = PA_RS(:) - PRSDRYG(:)
-PA_RR(:) = PA_RR(:) - PRRDRYG(:)
-PA_RG(:) = PA_RG(:) + PRCDRYG(:) + PRIDRYG(:) + PRSDRYG(:) + PRRDRYG(:)
-PA_TH(:) = PA_TH(:) + (PRCDRYG(:)+PRRDRYG(:))*(PLSFACT(:)-PLVFACT(:))
+ PRRWETG(JL)=-PWETG(JL) * (PRG_TEND(JL, IRIWETG)+PRG_TEND(JL, IRSWETG)+&
+ &PRG_TEND(JL, IRCDRYG)-ZRWETG_INIT(JL))
+ PRCWETG(JL)=PWETG(JL) * PRG_TEND(JL, IRCDRYG)
+ PRIWETG(JL)=PWETG(JL) * PRG_TEND(JL, IRIWETG)
+ PRSWETG(JL)=PWETG(JL) * PRG_TEND(JL, IRSWETG)
+
+ PRCDRYG(JL)=ZDRYG(JL) * PRG_TEND(JL, IRCDRYG)
+ PRRDRYG(JL)=ZDRYG(JL) * PRG_TEND(JL, IRRDRYG)
+ PRIDRYG(JL)=ZDRYG(JL) * PRG_TEND(JL, IRIDRYG)
+ PRSDRYG(JL)=ZDRYG(JL) * PRG_TEND(JL, IRSDRYG)
+ PA_RC(JL) = PA_RC(JL) - PRCWETG(JL)
+ PA_RI(JL) = PA_RI(JL) - PRIWETG(JL)
+ PA_RS(JL) = PA_RS(JL) - PRSWETG(JL)
+ PA_RG(JL) = PA_RG(JL) + PRCWETG(JL) + PRIWETG(JL) + PRSWETG(JL) + PRRWETG(JL)
+ PA_RR(JL) = PA_RR(JL) - PRRWETG(JL)
+ PA_TH(JL) = PA_TH(JL) + (PRCWETG(JL) + PRRWETG(JL))*(PLSFACT(JL)-PLVFACT(JL))
+ PA_RG(JL) = PA_RG(JL) - PRWETGH(JL)
+ PA_RH(JL) = PA_RH(JL) + PRWETGH(JL)
+ PB_RG(JL) = PB_RG(JL) - PRWETGH_MR(JL)
+ PB_RH(JL) = PB_RH(JL) + PRWETGH_MR(JL)
+ PA_RC(JL) = PA_RC(JL) - PRCDRYG(JL)
+ PA_RI(JL) = PA_RI(JL) - PRIDRYG(JL)
+ PA_RS(JL) = PA_RS(JL) - PRSDRYG(JL)
+ PA_RR(JL) = PA_RR(JL) - PRRDRYG(JL)
+ PA_RG(JL) = PA_RG(JL) + PRCDRYG(JL) + PRIDRYG(JL) + PRSDRYG(JL) + PRRDRYG(JL)
+ PA_TH(JL) = PA_TH(JL) + (PRCDRYG(JL)+PRRDRYG(JL))*(PLSFACT(JL)-PLVFACT(JL))
+ENDDO
!
!* 6.5 Melting of the graupeln
!
-GMASK(:)=PRGT(:)>XRTMIN(6) .AND. PT(:)>XTT .AND. LDCOMPUTE(:)
+DO JL=1, KSIZE
+ ZMASK(JL)=MAX(0., -SIGN(1., XRTMIN(6)-PRGT(JL))) * & ! WHERE(PRGT(:)>XRTMIN(6))
+ &MAX(0., -SIGN(1., XTT-PT(JL))) * & ! WHERE(PT(:)>XTT)
+ &PCOMPUTE(JL)
+ENDDO
IF(LDSOFT) THEN
- WHERE(.NOT. GMASK(:))
- PRGMLTR(:) = 0.
- END WHERE
+ DO JL=1, KSIZE
+ PRGMLTR(JL)=ZMASK(JL) * PRGMLTR(JL)
+ ENDDO
ELSE
- PRGMLTR(:) = 0.
- WHERE(GMASK(:))
- PRGMLTR(:) = PRVT(:)*PPRES(:)/((XMV/XMD)+PRVT(:)) ! Vapor pressure
- END WHERE
+ DO JL=1, KSIZE
+ PRGMLTR(JL)=ZMASK(JL) * PRVT(JL)*PPRES(JL)/(XEPSILO+PRVT(JL)) ! Vapor pressure
+ ENDDO
IF(LEVLIMIT) THEN
- WHERE(GMASK(:))
+ WHERE(ZMASK(:)==1.)
PRGMLTR(:)=MIN(PRGMLTR(:), EXP(XALPW-XBETAW/PT(:)-XGAMW*ALOG(PT(:)))) ! min(ev, es_w(T))
END WHERE
ENDIF
- WHERE(GMASK(:))
- PRGMLTR(:) = PKA(:)*(XTT-PT(:)) + &
- ( PDV(:)*(XLVTT + ( XCPV - XCL ) * ( PT(:) - XTT )) &
- *(XESTT-PRGMLTR(:))/(XRV*PT(:)) )
- END WHERE
- WHERE(GMASK(:))
+ DO JL=1, KSIZE
+ PRGMLTR(JL)=ZMASK(JL) * (PKA(JL)*(XTT-PT(JL)) + &
+ ( PDV(JL)*(XLVTT + ( XCPV - XCL ) * ( PT(JL) - XTT )) &
+ *(XESTT-PRGMLTR(JL))/(XRV*PT(JL)) ))
+ ENDDO
+ WHERE(ZMASK(:)==1.)
!
! compute RGMLTR
!
@@ -518,9 +573,10 @@ ELSE
( PRHODREF(:)*XLMTT ) )
END WHERE
ENDIF
-PA_RR(:) = PA_RR(:) + PRGMLTR(:)
-PA_RG(:) = PA_RG(:) - PRGMLTR(:)
-PA_TH(:) = PA_TH(:) - PRGMLTR(:)*(PLSFACT(:)-PLVFACT(:))
-
+DO JL=1, KSIZE
+ PA_RR(JL) = PA_RR(JL) + PRGMLTR(JL)
+ PA_RG(JL) = PA_RG(JL) - PRGMLTR(JL)
+ PA_TH(JL) = PA_TH(JL) - PRGMLTR(JL)*(PLSFACT(JL)-PLVFACT(JL))
+ENDDO
!
END SUBROUTINE ICE4_FAST_RG
diff --git a/src/MNH/ice4_fast_rh.f90 b/src/MNH/ice4_fast_rh.f90
index 9678dceb1..c06b206dd 100644
--- a/src/MNH/ice4_fast_rh.f90
+++ b/src/MNH/ice4_fast_rh.f90
@@ -5,7 +5,7 @@
!-----------------------------------------------------------------
MODULE MODI_ICE4_FAST_RH
INTERFACE
-SUBROUTINE ICE4_FAST_RH(KSIZE, LDSOFT, LDCOMPUTE, LDWETG, &
+SUBROUTINE ICE4_FAST_RH(KSIZE, LDSOFT, PCOMPUTE, PWETG, &
&PRHODREF, PLVFACT, PLSFACT, PPRES, &
&PDV, PKA, PCJ, &
&PLBDAS, PLBDAG, PLBDAR, PLBDAH, &
@@ -17,8 +17,8 @@ SUBROUTINE ICE4_FAST_RH(KSIZE, LDSOFT, LDCOMPUTE, LDWETG, &
IMPLICIT NONE
INTEGER, INTENT(IN) :: KSIZE
LOGICAL, INTENT(IN) :: LDSOFT
-LOGICAL, DIMENSION(KSIZE), INTENT(IN) :: LDCOMPUTE
-LOGICAL, DIMENSION(KSIZE), INTENT(IN) :: LDWETG ! True where graupel grows in wet mode
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PCOMPUTE
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PWETG ! 1. where graupel grows in wet mode, 0. elsewhere
REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHODREF ! Reference density
REAL, DIMENSION(KSIZE), INTENT(IN) :: PLVFACT
REAL, DIMENSION(KSIZE), INTENT(IN) :: PLSFACT
@@ -50,7 +50,7 @@ REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRRDRYH ! Wet growth of hailston
REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRGDRYH ! Wet growth of hailstone
REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRDRYHG ! Conversion of hailstone into graupel
REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRHMLTR ! Melting of the hailstones
-REAL, DIMENSION(KSIZE, 8), INTENT(INOUT) :: PRH_TEND ! Individual tendencies
+REAL, DIMENSION(KSIZE, 10), INTENT(INOUT) :: PRH_TEND ! Individual tendencies
REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_TH
REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RC
REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RR
@@ -61,7 +61,7 @@ REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RH
END SUBROUTINE ICE4_FAST_RH
END INTERFACE
END MODULE MODI_ICE4_FAST_RH
-SUBROUTINE ICE4_FAST_RH(KSIZE, LDSOFT, LDCOMPUTE, LDWETG, &
+SUBROUTINE ICE4_FAST_RH(KSIZE, LDSOFT, PCOMPUTE, PWETG, &
&PRHODREF, PLVFACT, PLSFACT, PPRES, &
&PDV, PKA, PCJ, &
&PLBDAS, PLBDAG, PLBDAR, PLBDAH, &
@@ -89,7 +89,7 @@ SUBROUTINE ICE4_FAST_RH(KSIZE, LDSOFT, LDCOMPUTE, LDWETG, &
!* 0. DECLARATIONS
! ------------
!
-USE MODD_CST, ONLY: XALPI,XALPW,XBETAI,XBETAW,XGAMW,XCI,XCL,XCPV,XESTT,XGAMI,XLMTT,XLVTT,XMD,XMV,XRV,XTT
+USE MODD_CST, ONLY: XALPI,XALPW,XBETAI,XBETAW,XGAMW,XCI,XCL,XCPV,XESTT,XGAMI,XLMTT,XLVTT,XMD,XMV,XRV,XTT,XEPSILO
USE MODD_PARAM_ICE, ONLY: LCONVHG,LEVLIMIT,LNULLWETH,LWETHPOST
USE MODD_RAIN_ICE_DESCR, ONLY: XBG,XBS,XCEXVT,XCXG,XCXH,XCXS,XDH,XRTMIN
USE MODD_RAIN_ICE_PARAM, ONLY: NWETLBDAG,NWETLBDAH,NWETLBDAR,NWETLBDAS,X0DEPH,X1DEPH,XCOLEXGH,XCOLEXIH,XCOLGH,XCOLIH,XCOLEXSH, &
@@ -105,8 +105,8 @@ IMPLICIT NONE
!
INTEGER, INTENT(IN) :: KSIZE
LOGICAL, INTENT(IN) :: LDSOFT
-LOGICAL, DIMENSION(KSIZE), INTENT(IN) :: LDCOMPUTE
-LOGICAL, DIMENSION(KSIZE), INTENT(IN) :: LDWETG ! True where graupel grows in wet mode
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PCOMPUTE
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PWETG ! 1. where graupel grows in wet mode, 0. elsewhere
REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHODREF ! Reference density
REAL, DIMENSION(KSIZE), INTENT(IN) :: PLVFACT
REAL, DIMENSION(KSIZE), INTENT(IN) :: PLSFACT
@@ -138,7 +138,7 @@ REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRRDRYH ! Wet growth of hailston
REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRGDRYH ! Wet growth of hailstone
REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRDRYHG ! Conversion of hailstone into graupel
REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRHMLTR ! Melting of the hailstones
-REAL, DIMENSION(KSIZE, 8), INTENT(INOUT) :: PRH_TEND ! Individual tendencies
+REAL, DIMENSION(KSIZE, 10), INTENT(INOUT) :: PRH_TEND ! Individual tendencies
REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_TH
REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RC
REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RR
@@ -149,45 +149,55 @@ REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RH
!
!* 0.2 declaration of local variables
!
-INTEGER, PARAMETER :: IRCWETH=1, IRRWETH=2, IRIDRYH=3, IRIWETH=4, IRSDRYH=5, IRSWETH=6, IRGDRYH=7, IRGWETH=8
+INTEGER, PARAMETER :: IRCWETH=1, IRRWETH=2, IRIDRYH=3, IRIWETH=4, IRSDRYH=5, IRSWETH=6, IRGDRYH=7, IRGWETH=8, &
+ & IFREEZ1=9, IFREEZ2=10
!
-LOGICAL, DIMENSION(SIZE(PRHODREF)) :: GHAIL, GWET, GMASK, LLWETH, LLDRYH
+LOGICAL, DIMENSION(KSIZE) :: GWET
+REAL, DIMENSION(KSIZE) :: ZHAIL, ZWET, ZMASK, ZWETH, ZDRYH
INTEGER :: IHAIL, IGWET
-REAL, DIMENSION(SIZE(PRHODREF)) :: ZVEC1, ZVEC2, ZVEC3
-INTEGER, DIMENSION(SIZE(PRHODREF)) :: I1
-INTEGER, DIMENSION(SIZE(PRHODREF)) :: IVEC1, IVEC2
-REAL, DIMENSION(SIZE(PRHODREF)) :: ZZW, &
+INTEGER, DIMENSION(KSIZE) :: I1
+REAL, DIMENSION(KSIZE) :: ZVEC1, ZVEC2, ZVEC3
+INTEGER, DIMENSION(KSIZE) :: IVEC1, IVEC2
+REAL, DIMENSION(KSIZE) :: ZZW, &
ZRDRYH_INIT, ZRWETH_INIT, &
ZRDRYHG
-INTEGER :: JJ
+INTEGER :: JJ, JL
!
!-------------------------------------------------------------------------------
!
!
!* 7.2 compute the Wet and Dry growth of hail
!
-GMASK(:)=PRHT(:)>XRTMIN(7) .AND. PRCT(:)>XRTMIN(2) .AND. LDCOMPUTE(:)
+DO JL=1, KSIZE
+ ZMASK(JL)=MAX(0., -SIGN(1., XRTMIN(7)-PRHT(JL))) * & ! WHERE(PRHT(:)>XRTMIN(7))
+ &MAX(0., -SIGN(1., XRTMIN(2)-PRCT(JL))) * & ! WHERE(PRCT(:)>XRTMIN(2))
+ &PCOMPUTE(JL)
+ENDDO
IF(LDSOFT) THEN
- WHERE(.NOT. GMASK(:))
- PRH_TEND(:, IRCWETH)=0.
- END WHERE
+ DO JL=1, KSIZE
+ PRH_TEND(JL, IRCWETH)=ZMASK(JL) * PRH_TEND(JL, IRCWETH)
+ ENDDO
ELSE
PRH_TEND(:, IRCWETH)=0.
- WHERE(GMASK(:))
+ WHERE(ZMASK(:)==1.)
ZZW(:) = PLBDAH(:)**(XCXH-XDH-2.0) * PRHODREF(:)**(-XCEXVT)
PRH_TEND(:, IRCWETH)=XFWETH * PRCT(:) * ZZW(:) ! RCWETH
END WHERE
ENDIF
-GMASK(:)=PRHT(:)>XRTMIN(7) .AND. PRIT(:)>XRTMIN(4) .AND. LDCOMPUTE(:)
+DO JL=1, KSIZE
+ ZMASK(JL)=MAX(0., -SIGN(1., XRTMIN(7)-PRHT(JL))) * & ! WHERE(PRHT(:)>XRTMIN(7))
+ &MAX(0., -SIGN(1., XRTMIN(4)-PRIT(JL))) * & ! WHERE(PRIT(:)>XRTMIN(4))
+ &PCOMPUTE(JL)
+ENDDO
IF(LDSOFT) THEN
- WHERE(.NOT. GMASK(:))
- PRH_TEND(:, IRIWETH)=0.
- PRH_TEND(:, IRIDRYH)=0.
- END WHERE
+ DO JL=1, KSIZE
+ PRH_TEND(JL, IRIWETH)=ZMASK(JL) * PRH_TEND(JL, IRIWETH)
+ PRH_TEND(JL, IRIDRYH)=ZMASK(JL) * PRH_TEND(JL, IRIDRYH)
+ ENDDO
ELSE
PRH_TEND(:, IRIWETH)=0.
PRH_TEND(:, IRIDRYH)=0.
- WHERE(GMASK(:))
+ WHERE(ZMASK(:)==1.)
ZZW(:) = PLBDAH(:)**(XCXH-XDH-2.0) * PRHODREF(:)**(-XCEXVT)
PRH_TEND(:, IRIWETH)=XFWETH * PRIT(:) * ZZW(:) ! RIWETH
PRH_TEND(:, IRIDRYH)=PRH_TEND(:, IRIWETH)*(XCOLIH*EXP(XCOLEXIH*(PT(:)-XTT))) ! RIDRYH
@@ -199,7 +209,10 @@ ENDIF
!
IGWET = 0
DO JJ = 1, SIZE(GWET)
- IF (PRHT(JJ)>XRTMIN(7) .AND. PRST(JJ)>XRTMIN(5) .AND. LDCOMPUTE(JJ)) THEN
+ ZWET(JJ) = MAX(0., -SIGN(1., XRTMIN(7)-PRHT(JJ))) * & ! WHERE(PRHT(:)>XRTMIN(7))
+ &MAX(0., -SIGN(1., XRTMIN(5)-PRST(JJ))) * & ! WHERE(PRST(:)>XRTMIN(5))
+ &PCOMPUTE(JJ)
+ IF (PRHT(JJ)>XRTMIN(7) .AND. PRST(JJ)>XRTMIN(5) .AND. PCOMPUTE(JJ)>0.) THEN
IGWET = IGWET + 1
I1(IGWET) = JJ
GWET(JJ) = .TRUE.
@@ -209,10 +222,10 @@ DO JJ = 1, SIZE(GWET)
END DO
IF(LDSOFT) THEN
- WHERE(.NOT. GWET(:))
- PRH_TEND(:, IRSWETH)=0.
- PRH_TEND(:, IRSDRYH)=0.
- END WHERE
+ DO JL=1, KSIZE
+ PRH_TEND(JL, IRSWETH)=ZWET(JL) * PRH_TEND(JL, IRSWETH)
+ PRH_TEND(JL, IRSDRYH)=ZWET(JL) * PRH_TEND(JL, IRSDRYH)
+ ENDDO
ELSE
PRH_TEND(:, IRSWETH)=0.
PRH_TEND(:, IRSDRYH)=0.
@@ -271,7 +284,10 @@ ENDIF
!
IGWET = 0
DO JJ = 1, SIZE(GWET)
- IF (PRHT(JJ)>XRTMIN(7) .AND. PRGT(JJ)>XRTMIN(6) .AND. LDCOMPUTE(JJ)) THEN
+ ZWET(JJ)=MAX(0., -SIGN(1., XRTMIN(7)-PRHT(JJ))) * & ! WHERE(PRHT(:)>XRTMIN(7))
+ &MAX(0., -SIGN(1., XRTMIN(6)-PRGT(JJ))) * & ! WHERE(PRGT(:)>XRTMIN(6))
+ &PCOMPUTE(JJ)
+ IF (PRHT(JJ)>XRTMIN(7) .AND. PRGT(JJ)>XRTMIN(6) .AND. PCOMPUTE(JJ)>0.) THEN
IGWET = IGWET + 1
I1(IGWET) = JJ
GWET(JJ) = .TRUE.
@@ -281,10 +297,10 @@ DO JJ = 1, SIZE(GWET)
END DO
IF(LDSOFT) THEN
- WHERE(.NOT. GWET(:))
- PRH_TEND(:, IRGWETH)=0.
- PRH_TEND(:, IRGDRYH)=0.
- END WHERE
+ DO JL=1, KSIZE
+ PRH_TEND(JL, IRGWETH)=ZWET(JL) * PRH_TEND(JL, IRGWETH)
+ PRH_TEND(JL, IRGDRYH)=ZWET(JL) * PRH_TEND(JL, IRGDRYH)
+ ENDDO
ELSE
PRH_TEND(:, IRGWETH)=0.
PRH_TEND(:, IRGDRYH)=0.
@@ -337,7 +353,7 @@ ELSE
PRH_TEND(:, IRGDRYH)=PRH_TEND(:, IRGWETH)
END WHERE
!When graupel grows in wet mode, graupel is wet (!) and collection efficiency must remain the same
- WHERE(GWET(:) .AND. .NOT. LDWETG(:))
+ WHERE(GWET(:) .AND. .NOT. PWETG(:)==1.)
PRH_TEND(:, IRGDRYH)=PRH_TEND(:, IRGDRYH)*(XCOLGH*EXP(XCOLEXGH*(PT(:)-XTT)))
END WHERE
END IF
@@ -347,7 +363,10 @@ ENDIF
!
IGWET = 0
DO JJ = 1, SIZE(GWET)
- IF (PRHT(JJ)>XRTMIN(7) .AND. PRRT(JJ)>XRTMIN(3) .AND. LDCOMPUTE(JJ)) THEN
+ ZWET(JJ)=MAX(0., -SIGN(1., XRTMIN(7)-PRHT(JJ))) * & ! WHERE(PRHT(:)>XRTMIN(7))
+ &MAX(0., -SIGN(1., XRTMIN(3)-PRRT(JJ))) * & ! WHERE(PRRT(:)>XRTMIN(3))
+ &PCOMPUTE(JJ)
+ IF (PRHT(JJ)>XRTMIN(7) .AND. PRRT(JJ)>XRTMIN(3) .AND. PCOMPUTE(JJ)>0.) THEN
IGWET = IGWET + 1
I1(IGWET) = JJ
GWET(JJ) = .TRUE.
@@ -357,9 +376,9 @@ DO JJ = 1, SIZE(GWET)
END DO
IF(LDSOFT) THEN
- WHERE(.NOT. GWET(:))
- PRH_TEND(:, IRRWETH)=0.
- END WHERE
+ DO JL=1, KSIZE
+ PRH_TEND(JL, IRRWETH)=ZWET(JL) * PRH_TEND(JL, IRRWETH)
+ ENDDO
ELSE
PRH_TEND(:, IRRWETH)=0.
IF(IGWET>0)THEN
@@ -412,122 +431,147 @@ ELSE
ENDIF
ENDIF
!
-ZRDRYH_INIT(:)=PRH_TEND(:, IRCWETH)+PRH_TEND(:, IRIDRYH)+PRH_TEND(:, IRSDRYH)+PRH_TEND(:, IRRWETH)+PRH_TEND(:, IRGDRYH)
+DO JL=1, KSIZE
+ ZRDRYH_INIT(JL)=PRH_TEND(JL, IRCWETH)+PRH_TEND(JL, IRIDRYH)+ &
+ &PRH_TEND(JL, IRSDRYH)+PRH_TEND(JL, IRRWETH)+PRH_TEND(JL, IRGDRYH)
+ENDDO
!
!* 7.3 compute the Wet growth of hail
!
-GHAIL(:) = PRHT(:)>XRTMIN(7) .AND. LDCOMPUTE(:)
-ZRWETH_INIT(:)=0.
-WHERE(GHAIL(:))
- ZRWETH_INIT(:) = PRVT(:)*PPRES(:)/((XMV/XMD)+PRVT(:)) ! Vapor pressure
-END WHERE
-IF(LEVLIMIT) THEN
- WHERE(GHAIL(:))
- ZRWETH_INIT(:) = MIN(ZRWETH_INIT(:), EXP(XALPI-XBETAI/PT(:)-XGAMI*ALOG(PT(:)))) ! min(ev, es_i(T))
+DO JL=1, KSIZE
+ ZHAIL(JL)=MAX(0., -SIGN(1., XRTMIN(7)-PRHT(JL))) * & ! WHERE(PRHT(:)>XRTMIN(7))
+ &PCOMPUTE(JL)
+ENDDO
+IF(LDSOFT) THEN
+ DO JL=1, KSIZE
+ PRH_TEND(JL, IFREEZ1)=ZHAIL(JL) * PRH_TEND(JL, IFREEZ1)
+ PRH_TEND(JL, IFREEZ2)=ZHAIL(JL) * PRH_TEND(JL, IFREEZ2)
+ ENDDO
+ELSE
+ DO JL=1, KSIZE
+ PRH_TEND(JL, IFREEZ1)=PRVT(JL)*PPRES(JL)/(XEPSILO+PRVT(JL)) ! Vapor pressure
+ ENDDO
+ IF(LEVLIMIT) THEN
+ WHERE(ZHAIL(:)==1.)
+ PRH_TEND(:, IFREEZ1)=MIN(PRH_TEND(:, IFREEZ1), EXP(XALPI-XBETAI/PT(:)-XGAMI*ALOG(PT(:)))) ! min(ev, es_i(T))
+ END WHERE
+ ENDIF
+ PRH_TEND(:, IFREEZ2)=0.
+ WHERE(ZHAIL(:)==1.)
+ PRH_TEND(:, IFREEZ1)=PKA(:)*(XTT-PT(:)) + &
+ (PDV(:)*(XLVTT+(XCPV-XCL)*(PT(:)-XTT)) &
+ *(XESTT-PRH_TEND(:, IFREEZ1))/(XRV*PT(:)) )
+ PRH_TEND(:, IFREEZ1)=PRH_TEND(:, IFREEZ1)* ( X0DEPH* PLBDAH(:)**XEX0DEPH + &
+ X1DEPH*PCJ(:)*PLBDAH(:)**XEX1DEPH )/ &
+ ( PRHODREF(:)*(XLMTT-XCL*(XTT-PT(:))) )
+ PRH_TEND(:, IFREEZ2)=(PRHODREF(:)*(XLMTT+(XCI-XCL)*(XTT-PT(:))) ) / &
+ ( PRHODREF(:)*(XLMTT-XCL*(XTT-PT(:))) )
END WHERE
ENDIF
-WHERE(GHAIL(:))
- ZRWETH_INIT(:) = PKA(:)*(XTT-PT(:)) + &
- ( PDV(:)*(XLVTT + ( XCPV - XCL ) * ( PT(:) - XTT )) &
- *(XESTT-ZRWETH_INIT(:))/(XRV*PT(:)) )
- !
- ! compute RWETH
- !
- ZRWETH_INIT(:) = MAX(0., ( ZRWETH_INIT(:) * ( X0DEPH* PLBDAH(:)**XEX0DEPH + &
- X1DEPH*PCJ(:)*PLBDAH(:)**XEX1DEPH ) + &
- ( PRH_TEND(:, IRIWETH)+PRH_TEND(:, IRSWETH)+PRH_TEND(:, IRGWETH) ) * &
- ( PRHODREF(:)*(XLMTT+(XCI-XCL)*(XTT-PT(:))) ) ) / &
- ( PRHODREF(:)*(XLMTT-XCL*(XTT-PT(:))) ) )
- ZRWETH_INIT(:)=MAX(ZRWETH_INIT(:), PRH_TEND(:, IRIWETH)+PRH_TEND(:, IRSWETH)+PRH_TEND(:, IRGWETH))
-END WHERE
+DO JL=1, KSIZE
+ !We must agregate, at least, the cold species
+ ZRWETH_INIT(JL)=ZHAIL(JL) * MAX(PRH_TEND(JL, IRIWETH)+PRH_TEND(JL, IRSWETH)+PRH_TEND(JL, IRGWETH), &
+ &MAX(0., PRH_TEND(JL, IFREEZ1) + &
+ &PRH_TEND(JL, IFREEZ2) * ( &
+ &PRH_TEND(JL, IRIWETH)+PRH_TEND(JL, IRSWETH)+PRH_TEND(JL, IRGWETH) )))
+ENDDO
!
!* 7.4 Select Wet or Dry case
!
!Wet case
-LLWETH(:)=GHAIL(:) .AND. MAX(0., ZRDRYH_INIT(:)-PRH_TEND(:, IRIDRYH)-PRH_TEND(:, IRSDRYH)-PRH_TEND(:, IRGDRYH))>= &
- & MAX(0., ZRWETH_INIT(:)-PRH_TEND(:, IRIWETH)-PRH_TEND(:, IRSWETH)-PRH_TEND(:, IRGWETH))
+DO JL=1, KSIZE
+ ZWETH(JL) = ZHAIL(JL) * &
+ & MAX(0., SIGN(1., MAX(0., ZRDRYH_INIT(JL)-PRH_TEND(JL, IRIDRYH)-PRH_TEND(JL, IRSDRYH)-PRH_TEND(JL, IRGDRYH)) - &
+ &MAX(0., ZRWETH_INIT(JL)-PRH_TEND(JL, IRIWETH)-PRH_TEND(JL, IRSWETH)-PRH_TEND(JL, IRGWETH))))
+ENDDO
IF(LNULLWETH) THEN
- LLWETH(:)=LLWETH(:) .AND. ZRDRYH_INIT(:)>0.
+ DO JL=1, KSIZE
+ ZWETH(JL) = ZWETH(JL) * MAX(0., -SIGN(1., -ZRDRYH_INIT(JL))) ! WHERE(ZRDRYH_INIT(:)>0.)
+ ENDDO
ELSE
- LLWETH(:)=LLWETH(:) .AND. ZRWETH_INIT(:)>0.
+ DO JL=1, KSIZE
+ ZWETH(JL) = ZWETH(JL) * MAX(0., -SIGN(1., -ZRWETH_INIT(JL))) ! WHERE(ZRWETH_INIT(:)>0.)
+ ENDDO
ENDIF
-IF(.NOT. LWETHPOST) LLWETH(:)=LLWETH(:) .AND. PT(:)<XTT
-LLDRYH(:)=GHAIL(:) .AND. PT(:)<XTT .AND. ZRDRYH_INIT(:)>0. .AND. &
- & MAX(0., ZRDRYH_INIT(:)-PRH_TEND(:, IRIDRYH)-PRH_TEND(:, IRSDRYH))< &
- & MAX(0., ZRWETH_INIT(:)-PRH_TEND(:, IRIWETH)-PRH_TEND(:, IRSWETH))
+IF(.NOT. LWETHPOST) THEN
+ DO JL=1, KSIZE
+ ZWETH(JL) = ZWETH(JL) * MAX(0., -SIGN(1., PT(JL)-XTT)) ! WHERE(PT(:)<XTT)
+ ENDDO
+ENDIF
+DO JL=1, KSIZE
+ ZDRYH(JL) = ZHAIL(JL) * &
+ & MAX(0., -SIGN(1., PT(JL)-XTT)) * & ! WHERE(PT(:)<XTT)
+ & MAX(0., -SIGN(1., 1.E-20-ZRDRYH_INIT(JL))) * & !WHERE(ZRDRYH_INIT(:)>0.)
+ & MAX(0., -SIGN(1., MAX(0., ZRDRYH_INIT(JL)-PRH_TEND(JL, IRIDRYH)-PRH_TEND(JL, IRSDRYH)) - &
+ &MAX(0., ZRWETH_INIT(JL)-PRH_TEND(JL, IRIWETH)-PRH_TEND(JL, IRSWETH))))
+ENDDO
!
-PRCWETH(:)=0.
-PRIWETH(:)=0.
-PRSWETH(:)=0.
-PRGWETH(:)=0.
-PRRWETH(:)=0.
-WHERE (LLWETH(:))
- PRCWETH(:) = PRH_TEND(:, IRCWETH)
- PRIWETH(:) = PRH_TEND(:, IRIWETH)
- PRSWETH(:) = PRH_TEND(:, IRSWETH)
- PRGWETH(:) = PRH_TEND(:, IRGWETH)
- !Collected minus aggregated
- PRRWETH(:) = ZRWETH_INIT(:) - PRH_TEND(:, IRIWETH) - PRH_TEND(:, IRSWETH) - PRH_TEND(:, IRGWETH) - PRH_TEND(:, IRCWETH)
-END WHERE
-
-PRCDRYH(:) = 0.
-PRIDRYH(:) = 0.
-PRSDRYH(:) = 0.
-PRRDRYH(:) = 0.
-PRGDRYH(:) = 0.
-PRDRYHG(:) = 0.
ZRDRYHG(:)=0.
IF(LCONVHG)THEN
- WHERE(LLDRYH(:))
+ WHERE(ZDRYH(:)==1.)
ZRDRYHG(:)=ZRDRYH_INIT(:)*ZRWETH_INIT(:)/(ZRDRYH_INIT(:)+ZRWETH_INIT(:))
END WHERE
ENDIF
-WHERE(LLDRYH(:)) ! Dry
- PRCDRYH(:) = PRH_TEND(:, IRCWETH)
- PRIDRYH(:) = PRH_TEND(:, IRIDRYH)
- PRSDRYH(:) = PRH_TEND(:, IRSDRYH)
- PRRDRYH(:) = PRH_TEND(:, IRRWETH)
- PRGDRYH(:) = PRH_TEND(:, IRGDRYH)
- PRDRYHG(:) = ZRDRYHG(:)
-END WHERE
-PA_RC(:) = PA_RC(:) - PRCWETH(:)
-PA_RI(:) = PA_RI(:) - PRIWETH(:)
-PA_RS(:) = PA_RS(:) - PRSWETH(:)
-PA_RG(:) = PA_RG(:) - PRGWETH(:)
-PA_RH(:) = PA_RH(:) + PRCWETH(:)+PRIWETH(:)+PRSWETH(:)+PRGWETH(:)+PRRWETH
-PA_RR(:) = PA_RR(:) - PRRWETH(:)
-PA_TH(:) = PA_TH(:) + (PRRWETH(:)+PRCWETH(:))*(PLSFACT(:)-PLVFACT(:))
-PA_RC(:) = PA_RC(:) - PRCDRYH(:)
-PA_RI(:) = PA_RI(:) - PRIDRYH(:)
-PA_RS(:) = PA_RS(:) - PRSDRYH(:)
-PA_RR(:) = PA_RR(:) - PRRDRYH(:)
-PA_RG(:) = PA_RG(:) - PRGDRYH(:) + PRDRYHG(:)
-PA_RH(:) = PA_RH(:) + PRCDRYH(:)+PRIDRYH(:)+PRSDRYH(:)+PRRDRYH(:)+PRGDRYH(:) - PRDRYHG(:)
-PA_TH(:) = PA_TH(:) + (PRCDRYH(:)+PRRDRYH(:))*(PLSFACT(:)-PLVFACT(:))
+DO JL=1, KSIZE
+ PRCWETH(JL) = ZWETH(JL) * PRH_TEND(JL, IRCWETH)
+ PRIWETH(JL) = ZWETH(JL) * PRH_TEND(JL, IRIWETH)
+ PRSWETH(JL) = ZWETH(JL) * PRH_TEND(JL, IRSWETH)
+ PRGWETH(JL) = ZWETH(JL) * PRH_TEND(JL, IRGWETH)
+ !Collected minus aggregated
+ PRRWETH(JL) = ZWETH(JL) * (ZRWETH_INIT(JL) - PRH_TEND(JL, IRIWETH) - &
+ PRH_TEND(JL, IRSWETH) - PRH_TEND(JL, IRGWETH) - &
+ PRH_TEND(JL, IRCWETH))
+
+ PRCDRYH(JL) = ZDRYH(JL) * PRH_TEND(JL, IRCWETH)
+ PRIDRYH(JL) = ZDRYH(JL) * PRH_TEND(JL, IRIDRYH)
+ PRSDRYH(JL) = ZDRYH(JL) * PRH_TEND(JL, IRSDRYH)
+ PRRDRYH(JL) = ZDRYH(JL) * PRH_TEND(JL, IRRWETH)
+ PRGDRYH(JL) = ZDRYH(JL) * PRH_TEND(JL, IRGDRYH)
+ PRDRYHG(JL) = ZDRYH(JL) * ZRDRYHG(JL)
+
+ PA_RC(JL) = PA_RC(JL) - PRCWETH(JL)
+ PA_RI(JL) = PA_RI(JL) - PRIWETH(JL)
+ PA_RS(JL) = PA_RS(JL) - PRSWETH(JL)
+ PA_RG(JL) = PA_RG(JL) - PRGWETH(JL)
+ PA_RH(JL) = PA_RH(JL) + PRCWETH(JL)+PRIWETH(JL)+PRSWETH(JL)+PRGWETH(JL)+PRRWETH(JL)
+ PA_RR(JL) = PA_RR(JL) - PRRWETH(JL)
+ PA_TH(JL) = PA_TH(JL) + (PRRWETH(JL)+PRCWETH(JL))*(PLSFACT(JL)-PLVFACT(JL))
+ PA_RC(JL) = PA_RC(JL) - PRCDRYH(JL)
+ PA_RI(JL) = PA_RI(JL) - PRIDRYH(JL)
+ PA_RS(JL) = PA_RS(JL) - PRSDRYH(JL)
+ PA_RR(JL) = PA_RR(JL) - PRRDRYH(JL)
+ PA_RG(JL) = PA_RG(JL) - PRGDRYH(JL) + PRDRYHG(JL)
+ PA_RH(JL) = PA_RH(JL) + PRCDRYH(JL)+PRIDRYH(JL)+PRSDRYH(JL)+&
+ &PRRDRYH(JL)+PRGDRYH(JL) - PRDRYHG(JL)
+ PA_TH(JL) = PA_TH(JL) + (PRCDRYH(JL)+PRRDRYH(JL))*(PLSFACT(JL)-PLVFACT(JL))
+ENDDO
!
!* 7.5 Melting of the hailstones
!
-GMASK(:)=PRHT(:)>XRTMIN(7) .AND. PT(:)>XTT .AND. LDCOMPUTE(:)
+DO JL=1, KSIZE
+ ZMASK(JL)=MAX(0., -SIGN(1., XRTMIN(7)-PRHT(JL))) * & ! WHERE(PRHT(:)>XRTMIN(7))
+ &MAX(0., -SIGN(1., XTT-PT(JL))) * & ! WHERE(PT(:)>XTT)
+ &PCOMPUTE(JL)
+ENDDO
IF(LDSOFT) THEN
- WHERE(.NOT. GMASK(:))
- PRHMLTR(:) = 0.
- END WHERE
+ DO JL=1, KSIZE
+ PRHMLTR(JL)=ZMASK(JL)*PRHMLTR(JL)
+ ENDDO
ELSE
- PRHMLTR(:) = 0.0
- WHERE(GMASK(:))
- PRHMLTR(:) = PRVT(:)*PPRES(:)/((XMV/XMD)+PRVT(:)) ! Vapor pressure
- END WHERE
+ DO JL=1, KSIZE
+ PRHMLTR(JL) = ZMASK(JL)* PRVT(JL)*PPRES(JL)/(XEPSILO+PRVT(JL)) ! Vapor pressure
+ ENDDO
IF(LEVLIMIT) THEN
- WHERE(GMASK(:))
+ WHERE(ZMASK(:)==1.)
PRHMLTR(:)=MIN(PRHMLTR(:), EXP(XALPW-XBETAW/PT(:)-XGAMW*ALOG(PT(:)))) ! min(ev, es_w(T))
END WHERE
ENDIF
- WHERE(GMASK(:))
- PRHMLTR(:) = PKA(:)*(XTT-PT(:)) + &
- ( PDV(:)*(XLVTT + ( XCPV - XCL ) * ( PT(:) - XTT )) &
- *(XESTT-PRHMLTR(:))/(XRV*PT(:)) )
- END WHERE
- WHERE(GMASK(:))
+ DO JL=1, KSIZE
+ PRHMLTR(JL) = ZMASK(JL)* (PKA(JL)*(XTT-PT(JL)) + &
+ ( PDV(JL)*(XLVTT + ( XCPV - XCL ) * ( PT(JL) - XTT )) &
+ *(XESTT-PRHMLTR(JL))/(XRV*PT(JL)) ))
+ ENDDO
+ WHERE(ZMASK(:)==1.)
!
! compute RHMLTR
!
@@ -539,9 +583,11 @@ ELSE
( PRHODREF(:)*XLMTT ) )
END WHERE
END IF
-PA_RR(:) = PA_RR(:) + PRHMLTR(:)
-PA_RH(:) = PA_RH(:) - PRHMLTR(:)
-PA_TH(:) = PA_TH(:) - PRHMLTR(:)*(PLSFACT(:)-PLVFACT(:))
+DO JL=1, KSIZE
+ PA_RR(JL) = PA_RR(JL) + PRHMLTR(JL)
+ PA_RH(JL) = PA_RH(JL) - PRHMLTR(JL)
+ PA_TH(JL) = PA_TH(JL) - PRHMLTR(JL)*(PLSFACT(JL)-PLVFACT(JL))
+ENDDO
!
!
END SUBROUTINE ICE4_FAST_RH
diff --git a/src/MNH/ice4_fast_ri.f90 b/src/MNH/ice4_fast_ri.f90
index 1a067377a..469b6cf3d 100644
--- a/src/MNH/ice4_fast_ri.f90
+++ b/src/MNH/ice4_fast_ri.f90
@@ -5,7 +5,7 @@
!-------------------------------------------------------------------------------
MODULE MODI_ICE4_FAST_RI
INTERFACE
-SUBROUTINE ICE4_FAST_RI(KSIZE, LDSOFT, LDCOMPUTE, &
+SUBROUTINE ICE4_FAST_RI(KSIZE, LDSOFT, PCOMPUTE, &
&PRHODREF, PLVFACT, PLSFACT, &
&PAI, PCJ, PCIT, &
&PSSI, &
@@ -25,7 +25,7 @@ IMPLICIT NONE
!
INTEGER, INTENT(IN) :: KSIZE
LOGICAL, INTENT(IN) :: LDSOFT
-LOGICAL, DIMENSION(KSIZE), INTENT(IN) :: LDCOMPUTE
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PCOMPUTE
REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHODREF ! Reference density
REAL, DIMENSION(KSIZE), INTENT(IN) :: PLVFACT
REAL, DIMENSION(KSIZE), INTENT(IN) :: PLSFACT
@@ -42,7 +42,7 @@ REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RI
END SUBROUTINE ICE4_FAST_RI
END INTERFACE
END MODULE MODI_ICE4_FAST_RI
-SUBROUTINE ICE4_FAST_RI(KSIZE, LDSOFT, LDCOMPUTE, &
+SUBROUTINE ICE4_FAST_RI(KSIZE, LDSOFT, PCOMPUTE, &
&PRHODREF, PLVFACT, PLSFACT, &
&PAI, PCJ, PCIT, &
&PSSI, &
@@ -74,7 +74,7 @@ IMPLICIT NONE
!
INTEGER, INTENT(IN) :: KSIZE
LOGICAL, INTENT(IN) :: LDSOFT
-LOGICAL, DIMENSION(KSIZE), INTENT(IN) :: LDCOMPUTE
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PCOMPUTE
REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHODREF ! Reference density
REAL, DIMENSION(KSIZE), INTENT(IN) :: PLVFACT
REAL, DIMENSION(KSIZE), INTENT(IN) :: PLSFACT
@@ -91,7 +91,8 @@ REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RI
!
!* 0.2 declaration of local variables
!
-LOGICAL, DIMENSION(SIZE(PRHODREF)) :: GMASK
+REAL, DIMENSION(KSIZE) :: ZMASK
+INTEGER :: JL
!
!-------------------------------------------------------------------------------
!
@@ -99,23 +100,30 @@ LOGICAL, DIMENSION(SIZE(PRHODREF)) :: GMASK
!
!* 7.2 Bergeron-Findeisen effect: RCBERI
!
-GMASK(:)=PSSI(:)>0. .AND. PRCT(:)>XRTMIN(2) .AND. PRIT(:)>XRTMIN(4) .AND. &
- &PCIT(:)>0. .AND. LDCOMPUTE(:)
+DO JL=1, KSIZE
+ ZMASK(JL)=MAX(0., -SIGN(1., -PSSI(JL))) * & ! PSSI(:)>0.
+ &MAX(0., -SIGN(1., XRTMIN(2)-PRCT(JL))) * & ! PRCT(:)>XRTMIN(2)
+ &MAX(0., -SIGN(1., XRTMIN(4)-PRIT(JL))) * & ! PRIT(:)>XRTMIN(4)
+ &MAX(0., -SIGN(1., 1.E-20-PCIT(JL))) * & ! PCIT(:)>0.
+ &PCOMPUTE(JL)
+ENDDO
IF(LDSOFT) THEN
- WHERE(.NOT. GMASK(:))
- PRCBERI(:) = 0.
- END WHERE
+ DO JL=1, KSIZE
+ PRCBERI(JL) = PRCBERI(JL) * ZMASK(JL)
+ ENDDO
ELSE
PRCBERI(:) = 0.
- WHERE(GMASK(:))
+ WHERE(ZMASK(:)==1.)
PRCBERI(:) = MIN(1.E8, XLBI*(PRHODREF(:)*PRIT(:)/PCIT(:))**XLBEXI) ! Lbda_i
PRCBERI(:) = ( PSSI(:) / (PRHODREF(:)*PAI(:)) ) * PCIT(:) * &
( X0DEPI/PRCBERI(:) + X2DEPI*PCJ(:)*PCJ(:)/PRCBERI(:)**(XDI+2.0) )
END WHERE
ENDIF
-PA_RC(:) = PA_RC(:) - PRCBERI(:)
-PA_RI(:) = PA_RI(:) + PRCBERI(:)
-PA_TH(:) = PA_TH(:) + PRCBERI(:)*(PLSFACT(:)-PLVFACT(:))
+DO JL=1, KSIZE
+ PA_RC(JL) = PA_RC(JL) - PRCBERI(JL)
+ PA_RI(JL) = PA_RI(JL) + PRCBERI(JL)
+ PA_TH(JL) = PA_TH(JL) + PRCBERI(JL)*(PLSFACT(JL)-PLVFACT(JL))
+ENDDO
!
!
END SUBROUTINE ICE4_FAST_RI
diff --git a/src/MNH/ice4_fast_rs.f90 b/src/MNH/ice4_fast_rs.f90
index b4cf9bd3b..83f8e6ccf 100644
--- a/src/MNH/ice4_fast_rs.f90
+++ b/src/MNH/ice4_fast_rs.f90
@@ -5,7 +5,7 @@
!-----------------------------------------------------------------
MODULE MODI_ICE4_FAST_RS
INTERFACE
-SUBROUTINE ICE4_FAST_RS(KSIZE, LDSOFT, LDCOMPUTE, &
+SUBROUTINE ICE4_FAST_RS(KSIZE, LDSOFT, PCOMPUTE, &
&PRHODREF, PLVFACT, PLSFACT, PPRES, &
&PDV, PKA, PCJ, &
&PLBDAR, PLBDAS, &
@@ -19,7 +19,7 @@ SUBROUTINE ICE4_FAST_RS(KSIZE, LDSOFT, LDCOMPUTE, &
IMPLICIT NONE
INTEGER, INTENT(IN) :: KSIZE
LOGICAL, INTENT(IN) :: LDSOFT
-LOGICAL, DIMENSION(KSIZE), INTENT(IN) :: LDCOMPUTE
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PCOMPUTE
REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHODREF ! Reference density
REAL, DIMENSION(KSIZE), INTENT(IN) :: PLVFACT
REAL, DIMENSION(KSIZE), INTENT(IN) :: PLSFACT
@@ -43,7 +43,7 @@ REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRRACCSG ! Rain accretion onto th
REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRSACCRG ! Rain accretion onto the aggregates
REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRSMLTG ! Conversion-Melting of the aggregates
REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRCMLTSR ! Cloud droplet collection onto aggregates by positive temperature
-REAL, DIMENSION(KSIZE, 6), INTENT(INOUT) :: PRS_TEND ! Individual tendencies
+REAL, DIMENSION(KSIZE, 8), INTENT(INOUT) :: PRS_TEND ! Individual tendencies
REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_TH
REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RC
REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RR
@@ -52,7 +52,7 @@ REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RG
END SUBROUTINE ICE4_FAST_RS
END INTERFACE
END MODULE MODI_ICE4_FAST_RS
-SUBROUTINE ICE4_FAST_RS(KSIZE, LDSOFT, LDCOMPUTE, &
+SUBROUTINE ICE4_FAST_RS(KSIZE, LDSOFT, PCOMPUTE, &
&PRHODREF, PLVFACT, PLSFACT, PPRES, &
&PDV, PKA, PCJ, &
&PLBDAR, PLBDAS, &
@@ -82,7 +82,8 @@ SUBROUTINE ICE4_FAST_RS(KSIZE, LDSOFT, LDCOMPUTE, &
!* 0. DECLARATIONS
! ------------
!
-USE MODD_CST, ONLY: XALPI,XALPW,XBETAI,XBETAW,XCI,XCL,XCPV,XESTT,XGAMI,XGAMW,XLMTT,XLVTT,XMD,XMV,XRV,XTT
+USE MODD_CST, ONLY: XALPI,XALPW,XBETAI,XBETAW,XCI,XCL,XCPV,XESTT,XGAMI,XGAMW,XLMTT,XLVTT,XMD,XMV,XRV,XTT, &
+ XEPSILO
USE MODD_PARAM_ICE, ONLY: LEVLIMIT, CSNOWRIMING
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, &
@@ -97,7 +98,7 @@ IMPLICIT NONE
!
INTEGER, INTENT(IN) :: KSIZE
LOGICAL, INTENT(IN) :: LDSOFT
-LOGICAL, DIMENSION(KSIZE), INTENT(IN) :: LDCOMPUTE
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PCOMPUTE
REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHODREF ! Reference density
REAL, DIMENSION(KSIZE), INTENT(IN) :: PLVFACT
REAL, DIMENSION(KSIZE), INTENT(IN) :: PLSFACT
@@ -121,7 +122,7 @@ REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRRACCSG ! Rain accretion onto th
REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRSACCRG ! Rain accretion onto the aggregates
REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRSMLTG ! Conversion-Melting of the aggregates
REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRCMLTSR ! Cloud droplet collection onto aggregates by positive temperature
-REAL, DIMENSION(KSIZE, 6), INTENT(INOUT) :: PRS_TEND ! Individual tendencies
+REAL, DIMENSION(KSIZE, 8), INTENT(INOUT) :: PRS_TEND ! Individual tendencies
REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_TH
REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RC
REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RR
@@ -130,50 +131,68 @@ REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RG
!
!* 0.2 declaration of local variables
!
-INTEGER, PARAMETER :: IRCRIMS=1, IRCRIMSS=2, IRSRIMCG=3, IRRACCS=4, IRRACCSS=5, IRSACCRG=6
+INTEGER, PARAMETER :: IRCRIMS=1, IRCRIMSS=2, IRSRIMCG=3, IRRACCS=4, IRRACCSS=5, IRSACCRG=6, &
+ & IFREEZ1=7, IFREEZ2=8
!
-LOGICAL, DIMENSION(SIZE(PRHODREF)) :: GRIM, GACC, GMASK
+REAL, DIMENSION(KSIZE) :: ZRIM, ZACC, ZMASK
+LOGICAL, DIMENSION(KSIZE) :: GRIM, GACC
INTEGER :: IGRIM, IGACC
-REAL, DIMENSION(SIZE(PRHODREF)) :: ZVEC1, ZVEC2, ZVEC3
-INTEGER, DIMENSION(SIZE(PRHODREF)) :: I1
-INTEGER, DIMENSION(SIZE(PRHODREF)) :: IVEC1, IVEC2
-REAL, DIMENSION(SIZE(PRHODREF)) :: ZZW, ZZW2, ZZW6, ZFREEZ_RATE
-INTEGER :: JJ
+INTEGER, DIMENSION(KSIZE) :: I1
+REAL, DIMENSION(KSIZE) :: ZVEC1, ZVEC2, ZVEC3
+INTEGER, DIMENSION(KSIZE) :: IVEC1, IVEC2
+REAL, DIMENSION(KSIZE) :: ZZW, ZZW2, ZZW6, ZFREEZ_RATE
+INTEGER :: JJ, JL
!-------------------------------------------------------------------------------
!
!
!* 5.0 maximum freezing rate
!
-ZFREEZ_RATE(:)=0.
-GMASK(:)=PRST(:)>XRTMIN(5) .AND. LDCOMPUTE(:)
-WHERE(GMASK(:))
- ZFREEZ_RATE(:)=PRVT(:)*PPRES(:)/((XMV/XMD)+PRVT(:)) ! Vapor pressure
-END WHERE
-IF(LEVLIMIT) THEN
- WHERE(GMASK(:))
- ZFREEZ_RATE(:)=MIN(ZFREEZ_RATE(:), EXP(XALPI-XBETAI/PT(:)-XGAMI*ALOG(PT(:)))) ! min(ev, es_i(T))
+DO JL=1, KSIZE
+ ZMASK(JL)=MAX(0., -SIGN(1., XRTMIN(5)-PRST(JL))) * & ! WHERE(PRST(:)>XRTMIN(5))
+ &PCOMPUTE(JL)
+ENDDO
+IF(LDSOFT) THEN
+ DO JL=1, KSIZE
+ PRS_TEND(JL, IFREEZ1)=ZMASK(JL) * PRS_TEND(JL, IFREEZ1)
+ PRS_TEND(JL, IFREEZ2)=ZMASK(JL) * PRS_TEND(JL, IFREEZ2)
+ ENDDO
+ELSE
+ DO JL=1, KSIZE
+ PRS_TEND(JL, IFREEZ1)=ZMASK(JL) * PRVT(JL)*PPRES(JL)/(XEPSILO+PRVT(JL)) ! Vapor pressure
+ ENDDO
+ IF(LEVLIMIT) THEN
+ WHERE(ZMASK(:)==1.)
+ PRS_TEND(:, IFREEZ1)=MIN(PRS_TEND(:, IFREEZ1), EXP(XALPI-XBETAI/PT(:)-XGAMI*ALOG(PT(:)))) ! min(ev, es_i(T))
+ END WHERE
+ ENDIF
+ PRS_TEND(:, IFREEZ2)=0.
+ WHERE(ZMASK(:)==1.)
+ PRS_TEND(:, IFREEZ1)=PKA(:)*(XTT-PT(:)) + &
+ (PDV(:)*(XLVTT+(XCPV-XCL)*(PT(:)-XTT)) &
+ *(XESTT-PRS_TEND(:, IFREEZ1))/(XRV*PT(:)) )
+ PRS_TEND(:, IFREEZ1)=PRS_TEND(:, IFREEZ1)* ( X0DEPS* PLBDAS(:)**XEX0DEPS + &
+ X1DEPS*PCJ(:)*PLBDAS(:)**XEX1DEPS )/ &
+ ( PRHODREF(:)*(XLMTT-XCL*(XTT-PT(:))) )
+ PRS_TEND(:, IFREEZ2)=(PRHODREF(:)*(XLMTT+(XCI-XCL)*(XTT-PT(:))) ) / &
+ ( PRHODREF(:)*(XLMTT-XCL*(XTT-PT(:))) )
END WHERE
ENDIF
-WHERE(GMASK(:))
- ZFREEZ_RATE(:)=PKA(:)*(XTT-PT(:)) + &
- (PDV(:)*(XLVTT+(XCPV-XCL)*(PT(:)-XTT)) &
- *(XESTT-ZFREEZ_RATE(:))/(XRV*PT(:)) )
- ZFREEZ_RATE(:)=MAX(0., &
- (ZFREEZ_RATE(:) * ( X0DEPS* PLBDAS(:)**XEX0DEPS + &
- X1DEPS*PCJ(:)*PLBDAS(:)**XEX1DEPS ) + &
- PRIAGGS(:) * &
- (PRHODREF(:)*(XLMTT+(XCI-XCL)*(XTT-PT(:))) ) ) / &
- ( PRHODREF(:)*(XLMTT-XCL*(XTT-PT(:))) ) )
+DO JL=1, KSIZE
!We must agregate, at least, the cold species
!And we are only interested by the freezing rate of liquid species
- ZFREEZ_RATE(:)=MAX(ZFREEZ_RATE(:)-PRIAGGS(:), 0.)
-END WHERE
+ ZFREEZ_RATE(JL)=ZMASK(JL) * MAX(0., MAX(0., PRS_TEND(JL, IFREEZ1) + &
+ &PRS_TEND(JL, IFREEZ2) * PRIAGGS(JL)) - &
+ PRIAGGS(JL))
+ENDDO
!
!* 5.1 cloud droplet riming of the aggregates
!
IGRIM = 0
DO JJ = 1, SIZE(GRIM)
- IF (PRCT(JJ)>XRTMIN(2) .AND. PRST(JJ)>XRTMIN(5) .AND. LDCOMPUTE(JJ)) THEN
+ ZRIM(JJ)=MAX(0., -SIGN(1., XRTMIN(2)-PRCT(JJ))) * & !WHERE(PRCT(:)>XRTMIN(2))
+ &MAX(0., -SIGN(1., XRTMIN(5)-PRST(JJ))) * & !WHERE(PRST(:)>XRTMIN(5))
+ &PCOMPUTE(JJ)
+ IF (PRCT(JJ)>XRTMIN(2) .AND. PRST(JJ)>XRTMIN(5) .AND. PCOMPUTE(JJ)>0.) THEN
IGRIM = IGRIM + 1
I1(IGRIM) = JJ
GRIM(JJ) = .TRUE.
@@ -184,11 +203,11 @@ END DO
!
! Collection of cloud droplets by snow: this rate is used for riming (T<0) and for conversion/melting (T>0)
IF(LDSOFT) THEN
- WHERE(.NOT. GRIM(:))
- PRS_TEND(:, IRCRIMS)=0.
- PRS_TEND(:, IRCRIMSS)=0.
- PRS_TEND(:, IRSRIMCG)=0.
- END WHERE
+ DO JL=1, KSIZE
+ PRS_TEND(JL, IRCRIMS)=ZRIM(JL) * PRS_TEND(JL, IRCRIMS)
+ PRS_TEND(JL, IRCRIMSS)=ZRIM(JL) * PRS_TEND(JL, IRCRIMSS)
+ PRS_TEND(JL, IRSRIMCG)=ZRIM(JL) * PRS_TEND(JL, IRSRIMCG)
+ ENDDO
ELSE
PRS_TEND(:, IRCRIMS)=0.
PRS_TEND(:, IRCRIMSS)=0.
@@ -272,35 +291,37 @@ ELSE
ENDIF
ENDIF
!
-GRIM(:) = GRIM(:) .AND. PT(:)<XTT ! More restrictive GRIM mask to be used for riming by negative temperature only
-PRCRIMSS(:)=0.
-PRCRIMSG(:)=0.
-PRSRIMCG(:)=0.
-WHERE(GRIM(:))
- PRCRIMSS(:) = MIN(ZFREEZ_RATE(:), PRS_TEND(:, IRCRIMSS))
- ZFREEZ_RATE(:) = MAX(0., ZFREEZ_RATE(:)-PRCRIMSS(:))
- ZZW(:) = MIN(1., ZFREEZ_RATE(:) / MAX(1.E-20, PRS_TEND(:, IRCRIMS) - PRCRIMSS(:))) ! proportion we are able to freeze
- PRCRIMSG(:) = ZZW(:) * MAX(0., PRS_TEND(:, IRCRIMS) - PRCRIMSS(:)) ! RCRIMSG
- ZFREEZ_RATE(:) = MAX(0., ZFREEZ_RATE(:)-PRCRIMSG(:))
- PRSRIMCG(:) = ZZW(:) * PRS_TEND(:, IRSRIMCG)
-END WHERE
-WHERE(PRCRIMSG(:)<=0.)
- PRCRIMSG(:)=0.
- PRSRIMCG(:)=0.
-END WHERE
-PA_RC(:) = PA_RC(:) - PRCRIMSS(:)
-PA_RS(:) = PA_RS(:) + PRCRIMSS(:)
-PA_TH(:) = PA_TH(:) + PRCRIMSS(:)*(PLSFACT(:)-PLVFACT(:))
-PA_RC(:) = PA_RC(:) - PRCRIMSG(:)
-PA_RS(:) = PA_RS(:) - PRSRIMCG(:)
-PA_RG(:) = PA_RG(:) + PRCRIMSG(:)+PRSRIMCG(:)
-PA_TH(:) = PA_TH(:) + PRCRIMSG(:)*(PLSFACT(:)-PLVFACT(:))
+DO JL=1, KSIZE
+ ! More restrictive RIM mask to be used for riming by negative temperature only
+ ZRIM(JL)=ZRIM(JL) * &
+ &MAX(0., -SIGN(1., PT(JL)-XTT)) ! WHERE(PT(:)<XTT)
+ PRCRIMSS(JL)=ZRIM(JL)*MIN(ZFREEZ_RATE(JL), PRS_TEND(JL, IRCRIMSS))
+ ZFREEZ_RATE(JL)=MAX(0., ZFREEZ_RATE(JL)-PRCRIMSS(JL))
+ ZZW(JL) = MIN(1., ZFREEZ_RATE(JL) / MAX(1.E-20, PRS_TEND(JL, IRCRIMS) - PRCRIMSS(JL))) ! proportion we are able to freeze
+ PRCRIMSG(JL) = ZRIM(JL) * ZZW(JL) * MAX(0., PRS_TEND(JL, IRCRIMS) - PRCRIMSS(JL)) ! RCRIMSG
+ ZFREEZ_RATE(JL)=MAX(0., ZFREEZ_RATE(JL)-PRCRIMSG(JL))
+ PRSRIMCG(JL) = ZRIM(JL) * ZZW(JL) * PRS_TEND(JL, IRSRIMCG)
+
+ PRSRIMCG(JL) = PRSRIMCG(JL) * MAX(0., -SIGN(1., -PRCRIMSG(JL)))
+ PRCRIMSG(JL)=MAX(0., PRCRIMSG(JL))
+
+ PA_RC(JL) = PA_RC(JL) - PRCRIMSS(JL)
+ PA_RS(JL) = PA_RS(JL) + PRCRIMSS(JL)
+ PA_TH(JL) = PA_TH(JL) + PRCRIMSS(JL)*(PLSFACT(JL)-PLVFACT(JL))
+ PA_RC(JL) = PA_RC(JL) - PRCRIMSG(JL)
+ PA_RS(JL) = PA_RS(JL) - PRSRIMCG(JL)
+ PA_RG(JL) = PA_RG(JL) + PRCRIMSG(JL)+PRSRIMCG(JL)
+ PA_TH(JL) = PA_TH(JL) + PRCRIMSG(JL)*(PLSFACT(JL)-PLVFACT(JL))
+ENDDO
!
!* 5.2 rain accretion onto the aggregates
!
IGACC = 0
DO JJ = 1, SIZE(GACC)
- IF (PRRT(JJ)>XRTMIN(3) .AND. PRST(JJ)>XRTMIN(5) .AND. LDCOMPUTE(JJ)) THEN
+ ZACC(JJ)=MAX(0., -SIGN(1., XRTMIN(3)-PRRT(JJ))) * & !WHERE(PRRT(:)>XRTMIN(3))
+ &MAX(0., -SIGN(1., XRTMIN(5)-PRST(JJ))) * & !WHERE(PRST(:)>XRTMIN(5))
+ &PCOMPUTE(JJ)
+ IF (PRRT(JJ)>XRTMIN(3) .AND. PRST(JJ)>XRTMIN(5) .AND. PCOMPUTE(JJ)>0.) THEN
IGACC = IGACC + 1
I1(IGACC) = JJ
GACC(JJ) = .TRUE.
@@ -310,11 +331,11 @@ DO JJ = 1, SIZE(GACC)
END DO
IF(LDSOFT) THEN
- WHERE(.NOT. GACC(:))
- PRS_TEND(:, IRRACCS)=0.
- PRS_TEND(:, IRRACCSS)=0.
- PRS_TEND(:, IRSACCRG)=0.
- END WHERE
+ DO JL=1, KSIZE
+ PRS_TEND(JL, IRRACCS)=ZACC(JL) * PRS_TEND(JL, IRRACCS)
+ PRS_TEND(JL, IRRACCSS)=ZACC(JL) * PRS_TEND(JL, IRRACCSS)
+ PRS_TEND(JL, IRSACCRG)=ZACC(JL) * PRS_TEND(JL, IRSACCRG)
+ ENDDO
ELSE
PRS_TEND(:, IRRACCS)=0.
PRS_TEND(:, IRRACCSS)=0.
@@ -417,54 +438,60 @@ ELSE
ENDIF
ENDIF
!
-GACC(:) = GACC(:) .AND. PT(:)<XTT ! More restrictive GACC mask to be used for accretion by negative temperature only
-PRRACCSS(:)=0.
-PRRACCSG(:)=0.
-PRSACCRG(:)=0.
-WHERE(GACC(:))
- PRRACCSS(:) = MIN(ZFREEZ_RATE(:), PRS_TEND(:, IRRACCSS))
- ZFREEZ_RATE(:) = MAX(0., ZFREEZ_RATE(:)-PRRACCSS(:))
- ZZW(:) = MIN(1., ZFREEZ_RATE(:) / MAX(1.E-20, PRS_TEND(:, IRRACCS)-PRRACCSS(:))) ! proportion we are able to freeze
- PRRACCSG(:)=ZZW(:) * MAX(0., PRS_TEND(:, IRRACCS)-PRRACCSS(:))
- ZFREEZ_RATE(:) = MAX(0., ZFREEZ_RATE(:)-PRRACCSG(:))
- PRSACCRG(:)=ZZW(:) * PRS_TEND(:, IRSACCRG)
-END WHERE
-WHERE(PRRACCSG(:)<=0.)
- PRRACCSG(:)=0.
- PRSACCRG(:)=0.
-END WHERE
-PA_RR(:) = PA_RR(:) - PRRACCSS(:)
-PA_RS(:) = PA_RS(:) + PRRACCSS(:)
-PA_TH(:) = PA_TH(:) + PRRACCSS(:)*(PLSFACT(:)-PLVFACT(:))
-PA_RR(:) = PA_RR(:) - PRRACCSG(:)
-PA_RS(:) = PA_RS(:) - PRSACCRG(:)
-PA_RG(:) = PA_RG(:) + PRRACCSG(:)+PRSACCRG(:)
-PA_TH(:) = PA_TH(:) + PRRACCSG(:)*(PLSFACT(:)-PLVFACT(:))
+DO JL=1, KSIZE
+ ! More restrictive ACC mask to be used for accretion by negative temperature only
+ ZACC(JL) = ZACC(JL) * &
+ &MAX(0., -SIGN(1., PT(JL)-XTT)) ! WHERE(PT(:)<XTT)
+ PRRACCSS(JL)=ZACC(JL)*MIN(ZFREEZ_RATE(JL), PRS_TEND(JL, IRRACCSS))
+ ZFREEZ_RATE(JL)=MAX(0., ZFREEZ_RATE(JL)-PRRACCSS(JL))
+ ZZW(JL) = MIN(1., ZFREEZ_RATE(JL) / MAX(1.E-20, PRS_TEND(JL, IRRACCS)-PRRACCSS(JL))) ! proportion we are able to freeze
+ PRRACCSG(JL)=ZACC(JL)*ZZW(JL) * MAX(0., PRS_TEND(JL, IRRACCS)-PRRACCSS(JL))
+ ZFREEZ_RATE(JL) = MAX(0., ZFREEZ_RATE(JL)-PRRACCSG(JL))
+ PRSACCRG(JL)=ZACC(JL)*ZZW(JL) * PRS_TEND(JL, IRSACCRG)
+
+ PRSACCRG(JL) = PRSACCRG(JL) * MAX(0., -SIGN(1., -PRRACCSG(JL)))
+ PRRACCSG(JL)=MAX(0., PRRACCSG(JL))
+
+ PA_RR(JL) = PA_RR(JL) - PRRACCSS(JL)
+ PA_RS(JL) = PA_RS(JL) + PRRACCSS(JL)
+ PA_TH(JL) = PA_TH(JL) + PRRACCSS(JL)*(PLSFACT(JL)-PLVFACT(JL))
+ PA_RR(JL) = PA_RR(JL) - PRRACCSG(JL)
+ PA_RS(JL) = PA_RS(JL) - PRSACCRG(JL)
+ PA_RG(JL) = PA_RG(JL) + PRRACCSG(JL)+PRSACCRG(JL)
+ PA_TH(JL) = PA_TH(JL) + PRRACCSG(JL)*(PLSFACT(JL)-PLVFACT(JL))
+ENDDO
!
!
!* 5.3 Conversion-Melting of the aggregates
!
-GMASK(:)=PRST(:)>XRTMIN(5) .AND. PT(:)>XTT .AND. LDCOMPUTE(:)
+DO JL=1, KSIZE
+ ZMASK(JL)=MAX(0., -SIGN(1., XRTMIN(5)-PRST(JL))) * & ! WHERE(PRST(:)>XRTMIN(5))
+ &MAX(0., -SIGN(1., XTT-PT(JL))) * & ! WHERE(PT(:)>XTT)
+ &PCOMPUTE(JL)
+ENDDO
IF(LDSOFT) THEN
- WHERE(.NOT. GMASK(:))
- PRSMLTG(:) = 0.
- PRCMLTSR(:) = 0.
- END WHERE
+ DO JL=1, KSIZE
+ PRSMLTG(JL)=ZMASK(JL)*PRSMLTG(JL)
+ PRCMLTSR(JL)=ZMASK(JL)*PRCMLTSR(JL)
+ ENDDO
ELSE
- PRSMLTG(:) = 0.
- PRCMLTSR(:) = 0.
- WHERE(GMASK(:))
- PRSMLTG(:) = PRVT(:)*PPRES(:)/((XMV/XMD)+PRVT(:)) ! Vapor pressure
- END WHERE
+ DO JL=1, KSIZE
+ PRSMLTG(JL)=ZMASK(JL)*PRVT(JL)*PPRES(JL)/(XEPSILO+PRVT(JL)) ! Vapor pressure
+ ENDDO
IF(LEVLIMIT) THEN
- WHERE(GMASK(:))
+ WHERE(ZMASK(:)==1.)
PRSMLTG(:)=MIN(PRSMLTG(:), EXP(XALPW-XBETAW/PT(:)-XGAMW*ALOG(PT(:)))) ! min(ev, es_w(T))
END WHERE
ENDIF
- WHERE(GMASK(:))
- PRSMLTG(:) = PKA(:)*(XTT-PT(:)) + &
- ( PDV(:)*(XLVTT + ( XCPV - XCL ) * ( PT(:) - XTT )) &
- *(XESTT-PRSMLTG(:))/(XRV*PT(:)) )
+ DO JL=1, KSIZE
+ PRSMLTG(JL)=ZMASK(JL)*( &
+ & PKA(JL)*(XTT-PT(JL)) + &
+ & ( PDV(JL)*(XLVTT + ( XCPV - XCL ) * ( PT(JL) - XTT )) &
+ & *(XESTT-PRSMLTG(JL))/(XRV*PT(JL)) ) &
+ &)
+ ENDDO
+ PRCMLTSR(:) = 0.
+ WHERE(ZMASK(:)==1.)
!
! compute RSMLT
!
@@ -474,21 +501,21 @@ ELSE
( PRS_TEND(:, IRCRIMS) + PRS_TEND(:, IRRACCS) ) * &
( PRHODREF(:)*XCL*(XTT-PT(:))) ) / &
( PRHODREF(:)*XLMTT ) )
- !
- ! note that RSCVMG = RSMLT*XFSCVMG but no heat is exchanged (at the rate RSMLT)
- ! because the graupeln produced by this process are still icy!!!
- !
! When T < XTT, rc is collected by snow (riming) to produce snow and graupel
! When T > XTT, if riming was still enabled, rc would produce snow and graupel with snow becomming graupel (conversion/melting) and graupel becomming rain (melting)
- ! To insure consistency when crossint T=XTT, rc collected with T>XTT must be transformed in rain.
+ ! To insure consistency when crossing T=XTT, rc collected with T>XTT must be transformed in rain.
! rc cannot produce iced species with a positive temperature but is still collected with a good efficiency by snow
PRCMLTSR(:) = PRS_TEND(:, IRCRIMS) ! both species are liquid, no heat is exchanged
END WHERE
ENDIF
-PA_RS(:) = PA_RS(:) - PRSMLTG(:)
-PA_RG(:) = PA_RG(:) + PRSMLTG(:)
-PA_RC(:) = PA_RC(:) - PRCMLTSR(:)
-PA_RR(:) = PA_RR(:) + PRCMLTSR(:)
+DO JL=1, KSIZE
+ ! note that RSCVMG = RSMLT*XFSCVMG but no heat is exchanged (at the rate RSMLT)
+ ! because the graupeln produced by this process are still icy!!!
+ PA_RS(JL) = PA_RS(JL) - PRSMLTG(JL)
+ PA_RG(JL) = PA_RG(JL) + PRSMLTG(JL)
+ PA_RC(JL) = PA_RC(JL) - PRCMLTSR(JL)
+ PA_RR(JL) = PA_RR(JL) + PRCMLTSR(JL)
+ENDDO
!
END SUBROUTINE ICE4_FAST_RS
diff --git a/src/MNH/ice4_nucleation.f90 b/src/MNH/ice4_nucleation.f90
index 549736b05..9eadc1d29 100644
--- a/src/MNH/ice4_nucleation.f90
+++ b/src/MNH/ice4_nucleation.f90
@@ -48,7 +48,7 @@ SUBROUTINE ICE4_NUCLEATION(KSIZE, ODSOFT, ODCOMPUTE, &
!* 0. DECLARATIONS
! ------------
!
-USE MODD_CST, ONLY: XALPI,XALPW,XBETAI,XBETAW,XGAMI,XGAMW,XMD,XMV,XTT
+USE MODD_CST, ONLY: XALPI,XALPW,XBETAI,XBETAW,XGAMI,XGAMW,XMD,XMV,XTT,XEPSILO
USE MODD_PARAM_ICE, ONLY: LFEEDBACKT
USE MODD_RAIN_ICE_PARAM, ONLY: XALPHA1,XALPHA2,XBETA1,XBETA2,XMNU0,XNU10,XNU20
USE MODD_RAIN_ICE_DESCR, ONLY: XRTMIN
@@ -99,7 +99,7 @@ IF(.NOT. ODSOFT) THEN
END WHERE
WHERE(GNEGT(:))
ZZW(:)=MIN(PPABST(:)/2., ZZW(:)) ! safety limitation
- ZSSI(:)=PRVT(:)*(PPABST(:)-ZZW(:)) / ((XMV/XMD)*ZZW(:)) - 1.0
+ ZSSI(:)=PRVT(:)*(PPABST(:)-ZZW(:)) / (XEPSILO*ZZW(:)) - 1.0
! Supersaturation over ice
ZUSW(:)=MIN(PPABST(:)/2., ZUSW(:)) ! safety limitation
ZUSW(:)=(ZUSW(:)/ZZW(:))*((PPABST(:)-ZZW(:))/(PPABST(:)-ZUSW(:))) - 1.0
diff --git a/src/MNH/ice4_nucleation_wrapper.f90 b/src/MNH/ice4_nucleation_wrapper.f90
index 6bd37bd55..37b8fb8b6 100644
--- a/src/MNH/ice4_nucleation_wrapper.f90
+++ b/src/MNH/ice4_nucleation_wrapper.f90
@@ -112,10 +112,6 @@ ALLOCATE(ZB_TH(INEGT))
ALLOCATE(ZB_RV(INEGT))
ALLOCATE(ZB_RI(INEGT))
!
-ZB_TH(:) = 0.
-ZB_RV(:) = 0.
-ZB_RI(:) = 0.
-!
IF(INEGT>0) INEGT_TMP=COUNTJV(GNEGT(:,:,:), I1(:), I2(:), I3(:))
!
PRVHENI_MR(:,:,:)=0.
@@ -132,6 +128,9 @@ IF(INEGT>0) THEN
ENDDO
GDSOFT = .FALSE.
GLDCOMPUTE(:) = ZZT(:)<XTT
+ ZB_TH(:) = 0.
+ ZB_RV(:) = 0.
+ ZB_RI(:) = 0.
CALL ICE4_NUCLEATION(INEGT, GDSOFT, GLDCOMPUTE, &
ZTHT, ZPRES, ZRHODREF, ZEXN, ZLSFACT, ZZT, &
ZRVT, &
diff --git a/src/MNH/ice4_rainfr_vert.f90 b/src/MNH/ice4_rainfr_vert.f90
index a048fc341..620c732ca 100644
--- a/src/MNH/ice4_rainfr_vert.f90
+++ b/src/MNH/ice4_rainfr_vert.f90
@@ -4,15 +4,18 @@
!MNH_LIC for details. version 1.
MODULE MODI_ICE4_RAINFR_VERT
INTERFACE
-SUBROUTINE ICE4_RAINFR_VERT(KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKT, KKL, PPRFR, PRR)
+SUBROUTINE ICE4_RAINFR_VERT(KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKT, KKL, PPRFR, PRR, PRS, PRG, PRH)
IMPLICIT NONE
INTEGER, INTENT(IN) :: KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKT, KKL
REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PPRFR !Precipitation fraction
REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRR !Rain field
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRS !Snow field
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRG !Graupel field
+REAL, DIMENSION(KIT,KJT,KKT), OPTIONAL,INTENT(IN) :: PRH !Hail field
END SUBROUTINE ICE4_RAINFR_VERT
END INTERFACE
END MODULE MODI_ICE4_RAINFR_VERT
-SUBROUTINE ICE4_RAINFR_VERT(KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKT, KKL, PPRFR, PRR)
+SUBROUTINE ICE4_RAINFR_VERT(KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKT, KKL, PPRFR, PRR, PRS, PRG, PRH)
!!
!!** PURPOSE
!! -------
@@ -40,10 +43,14 @@ IMPLICIT NONE
INTEGER, INTENT(IN) :: KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKT, KKL
REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PPRFR !Precipitation fraction
REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRR !Rain field
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRS !Snow field
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRG !Graupel field
+REAL, DIMENSION(KIT,KJT,KKT), OPTIONAL, INTENT(IN) :: PRH !Hail field
!
!* 0.2 declaration of local variables
!
INTEGER :: JI, JJ, JK
+LOGICAL :: MASK
!
!-------------------------------------------------------------------------------
!
@@ -52,7 +59,14 @@ DO JI = KIB,KIE
DO JJ = KJB, KJE
PPRFR(JI,JJ,KKE)=0.
DO JK=KKE-KKL, KKB, -KKL
- IF (PRR(JI,JJ,JK) .GT. XRTMIN(3)) THEN
+ IF(PRESENT(PRH)) THEN
+ MASK=PRR(JI,JJ,JK) .GT. XRTMIN(3) .OR. PRS(JI,JJ,JK) .GT. XRTMIN(5) &
+ .OR. PRG(JI,JJ,JK) .GT. XRTMIN(6) .OR. PRH(JI,JJ,JK) .GT. XRTMIN(7)
+ ELSE
+ MASK=PRR(JI,JJ,JK) .GT. XRTMIN(3) .OR. PRS(JI,JJ,JK) .GT. XRTMIN(5) &
+ .OR. PRG(JI,JJ,JK) .GT. XRTMIN(6)
+ END IF
+ IF (MASK) THEN
PPRFR(JI,JJ,JK)=MAX(PPRFR(JI,JJ,JK),PPRFR(JI,JJ,JK+KKL))
IF (PPRFR(JI,JJ,JK)==0) THEN
PPRFR(JI,JJ,JK)=1.
diff --git a/src/MNH/ice4_rimltc.f90 b/src/MNH/ice4_rimltc.f90
index 6b63a46f5..ef1fb8082 100644
--- a/src/MNH/ice4_rimltc.f90
+++ b/src/MNH/ice4_rimltc.f90
@@ -4,7 +4,7 @@
!MNH_LIC for details. version 1.
MODULE MODI_ICE4_RIMLTC
INTERFACE
-SUBROUTINE ICE4_RIMLTC(KSIZE, LDSOFT, LDCOMPUTE, &
+SUBROUTINE ICE4_RIMLTC(KSIZE, LDSOFT, PCOMPUTE, &
&PEXN, PLVFACT, PLSFACT, &
&PT, &
&PTHT, PRIT, &
@@ -12,7 +12,7 @@ SUBROUTINE ICE4_RIMLTC(KSIZE, LDSOFT, LDCOMPUTE, &
IMPLICIT NONE
INTEGER, INTENT(IN) :: KSIZE
LOGICAL, INTENT(IN) :: LDSOFT
-LOGICAL, DIMENSION(KSIZE),INTENT(IN) :: LDCOMPUTE
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PCOMPUTE
REAL, DIMENSION(KSIZE), INTENT(IN) :: PEXN ! Exner function
REAL, DIMENSION(KSIZE), INTENT(IN) :: PLVFACT ! L_v/(Pi_ref*C_ph)
REAL, DIMENSION(KSIZE), INTENT(IN) :: PLSFACT ! L_s/(Pi_ref*C_ph)
@@ -26,7 +26,7 @@ REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PB_RI
END SUBROUTINE ICE4_RIMLTC
END INTERFACE
END MODULE MODI_ICE4_RIMLTC
-SUBROUTINE ICE4_RIMLTC(KSIZE, LDSOFT, LDCOMPUTE, &
+SUBROUTINE ICE4_RIMLTC(KSIZE, LDSOFT, PCOMPUTE, &
&PEXN, PLVFACT, PLSFACT, &
&PT, &
&PTHT, PRIT, &
@@ -57,7 +57,7 @@ IMPLICIT NONE
!
INTEGER, INTENT(IN) :: KSIZE
LOGICAL, INTENT(IN) :: LDSOFT
-LOGICAL, DIMENSION(KSIZE), INTENT(IN) :: LDCOMPUTE
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PCOMPUTE
REAL, DIMENSION(KSIZE), INTENT(IN) :: PEXN ! Exner function
REAL, DIMENSION(KSIZE), INTENT(IN) :: PLVFACT ! L_v/(Pi_ref*C_ph)
REAL, DIMENSION(KSIZE), INTENT(IN) :: PLSFACT ! L_s/(Pi_ref*C_ph)
@@ -71,7 +71,8 @@ REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PB_RI
!
!* 0.2 declaration of local variables
!
-LOGICAL, DIMENSION(KSIZE) :: GMASK
+REAL, DIMENSION(KSIZE) :: ZMASK
+INTEGER :: JL
!
!-------------------------------------------------------------------------------
!
@@ -79,21 +80,25 @@ LOGICAL, DIMENSION(KSIZE) :: GMASK
!
PRIMLTC_MR(:)=0.
IF(.NOT. LDSOFT) THEN
- GMASK(:)=PRIT(:)>0. .AND. PT(:)>XTT .AND. LDCOMPUTE(:)
- WHERE(GMASK(:))
- PRIMLTC_MR(:)=PRIT(:)
- END WHERE
+ DO JL=1, KSIZE
+ ZMASK(JL)=MAX(0., -SIGN(1., -PRIT(JL))) * & ! PRIT(:)>0.
+ &MAX(0., -SIGN(1., XTT-PT(JL))) * & ! PT(:)>XTT
+ &PCOMPUTE(JL)
+ PRIMLTC_MR(JL)=PRIT(JL) * ZMASK(JL)
+ ENDDO
IF(LFEEDBACKT) THEN
!Limitation due to 0 crossing of temperature
- WHERE(GMASK(:))
- PRIMLTC_MR(:)=MIN(PRIMLTC_MR(:), MAX(0., (PTHT(:)-XTT/PEXN(:)) / (PLSFACT(:)-PLVFACT(:))))
- END WHERE
+ DO JL=1, KSIZE
+ PRIMLTC_MR(JL)=MIN(PRIMLTC_MR(JL), MAX(0., (PTHT(JL)-XTT/PEXN(JL)) / (PLSFACT(JL)-PLVFACT(JL))))
+ ENDDO
ENDIF
ENDIF
-PB_RC(:) = PB_RC(:) + PRIMLTC_MR(:)
-PB_RI(:) = PB_RI(:) - PRIMLTC_MR(:)
-PB_TH(:) = PB_TH(:) - PRIMLTC_MR(:)*(PLSFACT(:)-PLVFACT(:))
+DO JL=1, KSIZE
+ PB_RC(JL) = PB_RC(JL) + PRIMLTC_MR(JL)
+ PB_RI(JL) = PB_RI(JL) - PRIMLTC_MR(JL)
+ PB_TH(JL) = PB_TH(JL) - PRIMLTC_MR(JL)*(PLSFACT(JL)-PLVFACT(JL))
+ENDDO
!
!
END SUBROUTINE ICE4_RIMLTC
diff --git a/src/MNH/ice4_rrhong.f90 b/src/MNH/ice4_rrhong.f90
index 08d296a4d..f12048030 100644
--- a/src/MNH/ice4_rrhong.f90
+++ b/src/MNH/ice4_rrhong.f90
@@ -4,7 +4,7 @@
!MNH_LIC for details. version 1.
MODULE MODI_ICE4_RRHONG
INTERFACE
-SUBROUTINE ICE4_RRHONG(KSIZE, LDSOFT, LDCOMPUTE, &
+SUBROUTINE ICE4_RRHONG(KSIZE, LDSOFT, PCOMPUTE, &
&PEXN, PLVFACT, PLSFACT, &
&PT, PRRT, &
&PTHT, &
@@ -12,7 +12,7 @@ SUBROUTINE ICE4_RRHONG(KSIZE, LDSOFT, LDCOMPUTE, &
IMPLICIT NONE
INTEGER, INTENT(IN) :: KSIZE
LOGICAL, INTENT(IN) :: LDSOFT
-LOGICAL, DIMENSION(KSIZE),INTENT(IN) :: LDCOMPUTE
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PCOMPUTE
REAL, DIMENSION(KSIZE), INTENT(IN) :: PEXN ! Exner function
REAL, DIMENSION(KSIZE), INTENT(IN) :: PLVFACT ! L_v/(Pi_ref*C_ph)
REAL, DIMENSION(KSIZE), INTENT(IN) :: PLSFACT ! L_s/(Pi_ref*C_ph)
@@ -26,7 +26,7 @@ REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PB_RG
END SUBROUTINE ICE4_RRHONG
END INTERFACE
END MODULE MODI_ICE4_RRHONG
-SUBROUTINE ICE4_RRHONG(KSIZE, LDSOFT, LDCOMPUTE, &
+SUBROUTINE ICE4_RRHONG(KSIZE, LDSOFT, PCOMPUTE, &
&PEXN, PLVFACT, PLSFACT, &
&PT, PRRT, &
&PTHT, &
@@ -58,7 +58,7 @@ IMPLICIT NONE
!
INTEGER, INTENT(IN) :: KSIZE
LOGICAL, INTENT(IN) :: LDSOFT
-LOGICAL, DIMENSION(KSIZE),INTENT(IN) :: LDCOMPUTE
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PCOMPUTE
REAL, DIMENSION(KSIZE), INTENT(IN) :: PEXN ! Exner function
REAL, DIMENSION(KSIZE), INTENT(IN) :: PLVFACT ! L_v/(Pi_ref*C_ph)
REAL, DIMENSION(KSIZE), INTENT(IN) :: PLSFACT ! L_s/(Pi_ref*C_ph)
@@ -72,7 +72,8 @@ REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PB_RG
!
!* 0.2 declaration of local variables
!
-LOGICAL, DIMENSION(SIZE(PRRT)) :: GMASK
+REAL, DIMENSION(KSIZE) :: ZMASK
+INTEGER :: JL
!
!-------------------------------------------------------------------------------
!
@@ -80,20 +81,24 @@ LOGICAL, DIMENSION(SIZE(PRRT)) :: GMASK
!
PRRHONG_MR(:) = 0.
IF(.NOT. LDSOFT) THEN
- GMASK(:)=PT(:)<XTT-35.0 .AND. PRRT(:)>XRTMIN(3) .AND. LDCOMPUTE(:)
- WHERE(GMASK(:))
- PRRHONG_MR(:) = PRRT(:)
- ENDWHERE
+ DO JL=1, KSIZE
+ ZMASK(JL)=MAX(0., -SIGN(1., PT(JL)-(XTT-35.0))) * & ! PT(:)<XTT-35.0
+ &MAX(0., -SIGN(1., XRTMIN(3)-PRRT(JL))) * & ! PRRT(:)>XRTMIN(3)
+ &PCOMPUTE(JL)
+ PRRHONG_MR(JL)=PRRT(JL) * ZMASK(JL)
+ ENDDO
IF(LFEEDBACKT) THEN
!Limitation due to -35 crossing of temperature
- WHERE(GMASK(:))
- PRRHONG_MR(:)=MIN(PRRHONG_MR(:), MAX(0., ((XTT-35.)/PEXN(:)-PTHT)/(PLSFACT(:)-PLVFACT(:))))
- ENDWHERE
+ DO JL=1, KSIZE
+ PRRHONG_MR(JL)=MIN(PRRHONG_MR(JL), MAX(0., ((XTT-35.)/PEXN(JL)-PTHT(JL))/(PLSFACT(JL)-PLVFACT(JL))))
+ ENDDO
ENDIF
ENDIF
-PB_RG(:) = PB_RG(:) + PRRHONG_MR(:)
-PB_RR(:) = PB_RR(:) - PRRHONG_MR(:)
-PB_TH(:) = PB_TH(:) + PRRHONG_MR(:)*(PLSFACT(:)-PLVFACT(:))
+DO JL=1, KSIZE
+ PB_RG(JL) = PB_RG(JL) + PRRHONG_MR(JL)
+ PB_RR(JL) = PB_RR(JL) - PRRHONG_MR(JL)
+ PB_TH(JL) = PB_TH(JL) + PRRHONG_MR(JL)*(PLSFACT(JL)-PLVFACT(JL))
+ENDDO
!
!
END SUBROUTINE ICE4_RRHONG
diff --git a/src/MNH/ice4_rsrimcg_old.f90 b/src/MNH/ice4_rsrimcg_old.f90
index 01f8f0310..1aa9afff0 100644
--- a/src/MNH/ice4_rsrimcg_old.f90
+++ b/src/MNH/ice4_rsrimcg_old.f90
@@ -72,11 +72,11 @@ REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PB_RG
!
!* 0.2 declaration of local variables
!
-LOGICAL, DIMENSION(SIZE(PRHODREF)) :: GRIM, GACC, GMASK
-INTEGER :: IGRIM, IGACC
-REAL, DIMENSION(SIZE(PRHODREF)) :: ZVEC1, ZVEC2, ZVEC3
-INTEGER, DIMENSION(SIZE(PRHODREF)) :: IVEC1, IVEC2
-REAL, DIMENSION(SIZE(PRHODREF)) :: ZZW, ZZW2, ZZW6
+LOGICAL, DIMENSION(KSIZE) :: GRIM
+INTEGER :: IGRIM
+REAL, DIMENSION(KSIZE) :: ZVEC1, ZVEC2
+INTEGER, DIMENSION(KSIZE) :: IVEC2, IVEC1
+REAL, DIMENSION(KSIZE) :: ZZW
INTEGER :: JL
!-------------------------------------------------------------------------------
!
@@ -98,7 +98,7 @@ IF(.NOT. ODSOFT) THEN
END IF
END DO
!
- IF(IGRIM>0 .AND. CSNOWRIMING=='OLD ') THEN
+ IF(IGRIM>0) THEN
!
! 5.1.1 select the PLBDAS
!
@@ -133,8 +133,8 @@ IF(.NOT. ODSOFT) THEN
WHERE(GRIM(:))
PRSRIMCG_MR(:) = XSRIMCG * PLBDAS(:)**XEXSRIMCG & ! RSRIMCG
* (1.0 - ZZW(:) )/PRHODREF(:)
+ PRSRIMCG_MR(:)=MIN(PRST(:), PRSRIMCG_MR(:))
END WHERE
- PRSRIMCG_MR(:)=MIN(PRST(:), PRSRIMCG_MR(:))
END IF
ENDIF
PB_RS(:) = PB_RS(:) - PRSRIMCG_MR(:)
diff --git a/src/MNH/ice4_sedimentation_split.f90 b/src/MNH/ice4_sedimentation_split.f90
index cb0a147d0..62b21dfbd 100644
--- a/src/MNH/ice4_sedimentation_split.f90
+++ b/src/MNH/ice4_sedimentation_split.f90
@@ -35,8 +35,8 @@ REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRSS ! Snow/aggregat
REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRGS ! Graupel m.r. source
REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRGT ! Graupel/hail m.r. at t
-REAL, DIMENSION(:,:), INTENT(OUT) :: PINPRC ! Cloud instant precip
-REAL, DIMENSION(:,:), INTENT(OUT) :: PINDEP ! Cloud instant deposition
+REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRC ! Cloud instant precip
+REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINDEP ! Cloud instant deposition
REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRR ! Rain instant precip
REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRI ! Pristine ice instant precip
REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRS ! Snow instant precip
@@ -112,8 +112,8 @@ REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRSS ! Snow/aggregat
REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRGS ! Graupel m.r. source
REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRGT ! Graupel/hail m.r. at t
-REAL, DIMENSION(:,:), INTENT(OUT) :: PINPRC ! Cloud instant precip
-REAL, DIMENSION(:,:), INTENT(OUT) :: PINDEP ! Cloud instant deposition
+REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRC ! Cloud instant precip
+REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINDEP ! Cloud instant deposition
REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRR ! Rain instant precip
REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRI ! Pristine ice instant precip
REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRS ! Snow instant precip
diff --git a/src/MNH/ice4_slow.f90 b/src/MNH/ice4_slow.f90
index f264b0b6f..9f8511e4f 100644
--- a/src/MNH/ice4_slow.f90
+++ b/src/MNH/ice4_slow.f90
@@ -4,17 +4,18 @@
!MNH_LIC for details. version 1.
MODULE MODI_ICE4_SLOW
INTERFACE
-SUBROUTINE ICE4_SLOW(KSIZE, LDSOFT, LDCOMPUTE, PRHODREF, PT,&
+SUBROUTINE ICE4_SLOW(KSIZE, LDSOFT, HSUBG_AUCV_RI, PCOMPUTE, PRHODREF, PT,&
&PSSI, PLVFACT, PLSFACT, &
&PRVT, PRCT, PRIT, PRST, PRGT,&
&PLBDAS, PLBDAG,&
- &PAI, PCJ,&
+ &PAI, PCJ, PHLI_HCF, PHLI_HRI,&
&PRCHONI, PRVDEPS, PRIAGGS, PRIAUTS, PRVDEPG, &
&PA_TH, PA_RV, PA_RC, PA_RI, PA_RS, PA_RG)
IMPLICIT NONE
INTEGER, INTENT(IN) :: KSIZE
LOGICAL, INTENT(IN) :: LDSOFT
-LOGICAL, DIMENSION(KSIZE), INTENT(IN) :: LDCOMPUTE
+CHARACTER(LEN=80), INTENT(IN) :: HSUBG_AUCV_RI
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PCOMPUTE
REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHODREF ! Reference density
REAL, DIMENSION(KSIZE), INTENT(IN) :: PT ! Temperature
REAL, DIMENSION(KSIZE), INTENT(IN) :: PSSI ! Supersaturation over ice
@@ -29,6 +30,8 @@ REAL, DIMENSION(KSIZE), INTENT(IN) :: PLBDAS ! Slope parameter of the
REAL, DIMENSION(KSIZE), INTENT(IN) :: PLBDAG ! Slope parameter of the graupel distribution
REAL, DIMENSION(KSIZE), INTENT(IN) :: PAI ! Thermodynamical function
REAL, DIMENSION(KSIZE), INTENT(IN) :: PCJ ! Function to compute the ventilation coefficient
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PHLI_HCF !
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PHLI_HRI !
REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRCHONI ! Homogeneous nucleation
REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRVDEPS ! Deposition on r_s
REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRIAGGS ! Aggregation on r_s
@@ -43,11 +46,11 @@ REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RG
END SUBROUTINE ICE4_SLOW
END INTERFACE
END MODULE MODI_ICE4_SLOW
-SUBROUTINE ICE4_SLOW(KSIZE, LDSOFT, LDCOMPUTE, PRHODREF, PT, &
+SUBROUTINE ICE4_SLOW(KSIZE, LDSOFT, HSUBG_AUCV_RI, PCOMPUTE, PRHODREF, PT, &
&PSSI, PLVFACT, PLSFACT, &
&PRVT, PRCT, PRIT, PRST, PRGT, &
&PLBDAS, PLBDAG, &
- &PAI, PCJ, &
+ &PAI, PCJ, PHLI_HCF, PHLI_HRI,&
&PRCHONI, PRVDEPS, PRIAGGS, PRIAUTS, PRVDEPG, &
&PA_TH, PA_RV, PA_RC, PA_RI, PA_RS, PA_RG)
!!
@@ -78,7 +81,8 @@ IMPLICIT NONE
!
INTEGER, INTENT(IN) :: KSIZE
LOGICAL, INTENT(IN) :: LDSOFT
-LOGICAL, DIMENSION(KSIZE), INTENT(IN) :: LDCOMPUTE
+CHARACTER(LEN=80), INTENT(IN) :: HSUBG_AUCV_RI
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PCOMPUTE
REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHODREF ! Reference density
REAL, DIMENSION(KSIZE), INTENT(IN) :: PT ! Temperature
REAL, DIMENSION(KSIZE), INTENT(IN) :: PSSI ! Supersaturation over ice
@@ -93,6 +97,8 @@ REAL, DIMENSION(KSIZE), INTENT(IN) :: PLBDAS ! Slope parameter of the
REAL, DIMENSION(KSIZE), INTENT(IN) :: PLBDAG ! Slope parameter of the graupel distribution
REAL, DIMENSION(KSIZE), INTENT(IN) :: PAI ! Thermodynamical function
REAL, DIMENSION(KSIZE), INTENT(IN) :: PCJ ! Function to compute the ventilation coefficient
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PHLI_HCF !
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PHLI_HRI !
REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRCHONI ! Homogeneous nucleation
REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRVDEPS ! Deposition on r_s
REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRIAGGS ! Aggregation on r_s
@@ -107,9 +113,10 @@ REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RG
!
!* 0.2 declaration of local variables
!
-LOGICAL, DIMENSION(SIZE(PRHODREF)) :: GMASK
-REAL, DIMENSION(SIZE(PRHODREF)) :: ZCRIAUTI
-REAL :: ZTIMAUTIC
+REAL, DIMENSION(KSIZE) :: ZCRIAUTI, ZMASK
+REAL :: ZTIMAUTIC,ZRCHONI
+INTEGER :: JL
+!-------------------------------------------------------------------------------
!
!
!-------------------------------------------------------------------------------
@@ -117,21 +124,28 @@ REAL :: ZTIMAUTIC
!
!* 3.2 compute the homogeneous nucleation source: RCHONI
!
-GMASK(:)=PT(:)<XTT-35.0 .AND. PRCT(:)>XRTMIN(2) .AND. LDCOMPUTE(:)
+DO JL=1, KSIZE
+ ZMASK(JL)=MAX(0., -SIGN(1., PT(JL)-(XTT-35.0))) * & ! PT(:)<XTT-35.0
+ &MAX(0., -SIGN(1., XRTMIN(2)-PRCT(JL))) * & ! PRCT(:)>XRTMIN(2)
+ &PCOMPUTE(JL)
+ENDDO
IF(LDSOFT) THEN
- WHERE(.NOT. GMASK(:))
- PRCHONI(:) = 0.
- END WHERE
+ DO JL=1, KSIZE
+ PRCHONI(JL) = PRCHONI(JL) * ZMASK(JL)
+ ENDDO
ELSE
PRCHONI(:) = 0.
- WHERE(GMASK(:))
+ WHERE(ZMASK(:)==1.)
PRCHONI(:) = XHON*PRHODREF(:)*PRCT(:) &
*EXP( XALPHA3*(PT(:)-XTT)-XBETA3 )
ENDWHERE
ENDIF
-PA_RI(:) = PA_RI(:) + PRCHONI(:)
-PA_RC(:) = PA_RC(:) - PRCHONI(:)
-PA_TH(:) = PA_TH(:) + PRCHONI(:)*(PLSFACT(:)-PLVFACT(:))
+DO JL=1, KSIZE
+ ZRCHONI=MIN(PRCHONI(JL),1000.)
+ PA_RI(JL) = PA_RI(JL) + ZRCHONI
+ PA_RC(JL) = PA_RC(JL) - ZRCHONI
+ PA_TH(JL) = PA_TH(JL) + ZRCHONI*(PLSFACT(JL)-PLVFACT(JL))
+ENDDO
!
!* 3.4 compute the deposition, aggregation and autoconversion sources
!
@@ -149,78 +163,103 @@ PA_TH(:) = PA_TH(:) + PRCHONI(:)*(PLSFACT(:)-PLVFACT(:))
!
!* 3.4.3 compute the deposition on r_s: RVDEPS
!
-GMASK(:)=PRVT(:)>XRTMIN(1) .AND. PRST(:)>XRTMIN(5) .AND. LDCOMPUTE(:)
+DO JL=1, KSIZE
+ ZMASK(JL)=MAX(0., -SIGN(1., XRTMIN(1)-PRVT(JL))) * & !PRVT(:)>XRTMIN(1)
+ &MAX(0., -SIGN(1., XRTMIN(5)-PRST(JL))) * & !PRST(:)>XRTMIN(5)
+ &PCOMPUTE(JL)
+ENDDO
IF(LDSOFT) THEN
- WHERE(.NOT. GMASK(:))
- PRVDEPS(:) = 0.
- END WHERE
+ DO JL=1, KSIZE
+ PRVDEPS(JL)=PRVDEPS(JL)*ZMASK(JL)
+ ENDDO
ELSE
PRVDEPS(:) = 0.
- WHERE(GMASK(:))
+ WHERE(ZMASK(:)==1.)
PRVDEPS(:) = ( PSSI(:)/(PRHODREF(:)*PAI(:)) ) * &
( X0DEPS*PLBDAS(:)**XEX0DEPS + X1DEPS*PCJ(:)*PLBDAS(:)**XEX1DEPS )
END WHERE
ENDIF
-PA_RS(:) = PA_RS(:) + PRVDEPS(:)
-PA_RV(:) = PA_RV(:) - PRVDEPS(:)
-PA_TH(:) = PA_TH(:) + PRVDEPS(:)*PLSFACT(:)
+DO JL=1, KSIZE
+ PA_RS(JL) = PA_RS(JL) + PRVDEPS(JL)
+ PA_RV(JL) = PA_RV(JL) - PRVDEPS(JL)
+ PA_TH(JL) = PA_TH(JL) + PRVDEPS(JL)*PLSFACT(JL)
+ENDDO
!
!* 3.4.4 compute the aggregation on r_s: RIAGGS
!
-GMASK(:)=PRIT(:)>XRTMIN(4) .AND. PRST(:)>XRTMIN(5) .AND. LDCOMPUTE(:)
+DO JL=1, KSIZE
+ ZMASK(JL)=MAX(0., -SIGN(1., XRTMIN(4)-PRIT(JL))) * & ! PRIT(:)>XRTMIN(4)
+ &MAX(0., -SIGN(1., XRTMIN(5)-PRST(JL))) * & ! PRST(:)>XRTMIN(5)
+ &PCOMPUTE(JL)
+ENDDO
IF(LDSOFT) THEN
- WHERE(.NOT. GMASK(:))
- PRIAGGS(:) = 0.
- END WHERE
+ DO JL=1, KSIZE
+ PRIAGGS(JL)=PRIAGGS(JL) * ZMASK(JL)
+ ENDDO
ELSE
PRIAGGS(:) = 0.
- WHERE(GMASK(:))
+ WHERE(ZMASK(:)==1)
PRIAGGS(:) = XFIAGGS * EXP( XCOLEXIS*(PT(:)-XTT) ) &
* PRIT(:) &
* PLBDAS(:)**XEXIAGGS &
* PRHODREF(:)**(-XCEXVT)
END WHERE
ENDIF
-PA_RS(:) = PA_RS(:) + PRIAGGS(:)
-PA_RI(:) = PA_RI(:) - PRIAGGS(:)
+DO JL=1, KSIZE
+ PA_RS(JL) = PA_RS(JL) + PRIAGGS(JL)
+ PA_RI(JL) = PA_RI(JL) - PRIAGGS(JL)
+ENDDO
!
!* 3.4.5 compute the autoconversion of r_i for r_s production: RIAUTS
!
-GMASK(:)=PRIT(:)>XRTMIN(4) .AND. LDCOMPUTE(:)
+DO JL=1, KSIZE
+ ZMASK(JL)=MAX(0., -SIGN(1., XRTMIN(4)-PHLI_HRI(JL))) * & ! PHLI_HRI(:)>XRTMIN(4)
+ &MAX(0., -SIGN(1., 1.E-20-PHLI_HCF(JL))) * & ! PHLI_HCF(:) .GT. 0.
+ &PCOMPUTE(JL)
+ENDDO
IF(LDSOFT) THEN
- WHERE(.NOT. GMASK(:))
- PRIAUTS(:) = 0.
- END WHERE
+ DO JL=1, KSIZE
+ PRIAUTS(JL) = PRIAUTS(JL) * ZMASK(JL)
+ ENDDO
ELSE
PRIAUTS(:) = 0.
!ZCRIAUTI(:)=MIN(XCRIAUTI,10**(0.06*(PT(:)-XTT)-3.5))
ZCRIAUTI(:)=MIN(XCRIAUTI,10**(XACRIAUTI*(PT(:)-XTT)+XBCRIAUTI))
- WHERE(GMASK(:))
+ WHERE(ZMASK(:)==1.)
PRIAUTS(:) = XTIMAUTI * EXP( XTEXAUTI*(PT(:)-XTT) ) &
- * MAX( PRIT(:)-ZCRIAUTI(:),0.0 )
+ * MAX( PHLI_HRI(:)/PHLI_HCF(:)-ZCRIAUTI(:),0.0 )
+ PRIAUTS(:) = PHLI_HCF(:)*PRIAUTS(:)
END WHERE
ENDIF
-PA_RS(:) = PA_RS(:) + PRIAUTS(:)
-PA_RI(:) = PA_RI(:) - PRIAUTS(:)
+DO JL=1, KSIZE
+ PA_RS(JL) = PA_RS(JL) + PRIAUTS(JL)
+ PA_RI(JL) = PA_RI(JL) - PRIAUTS(JL)
+ENDDO
!
!* 3.4.6 compute the deposition on r_g: RVDEPG
!
!
-GMASK(:)=PRVT(:)>XRTMIN(1) .AND. PRGT(:)>XRTMIN(6) .AND. LDCOMPUTE(:)
+DO JL=1, KSIZE
+ ZMASK(JL)=MAX(0., -SIGN(1., XRTMIN(1)-PRVT(JL))) * & ! PRVT(:)>XRTMIN(1)
+ &MAX(0., -SIGN(1., XRTMIN(6)-PRGT(JL))) * & ! PRGT(:)>XRTMIN(6)
+ &PCOMPUTE(JL)
+ENDDO
IF(LDSOFT) THEN
- WHERE(.NOT. GMASK(:))
- PRVDEPG(:) = 0.
- END WHERE
+ DO JL=1, KSIZE
+ PRVDEPG(JL) = PRVDEPG(JL) * ZMASK(JL)
+ ENDDO
ELSE
PRVDEPG(:) = 0.
- WHERE(GMASK(:))
+ WHERE(ZMASK(:)==1.)
PRVDEPG(:) = ( PSSI(:)/(PRHODREF(:)*PAI(:)) ) * &
( X0DEPG*PLBDAG(:)**XEX0DEPG + X1DEPG*PCJ(:)*PLBDAG(:)**XEX1DEPG )
END WHERE
ENDIF
-PA_RG(:) = PA_RG(:) + PRVDEPG(:)
-PA_RV(:) = PA_RV(:) - PRVDEPG(:)
-PA_TH(:) = PA_TH(:) + PRVDEPG(:)*PLSFACT(:)
+DO JL=1, KSIZE
+ PA_RG(JL) = PA_RG(JL) + PRVDEPG(JL)
+ PA_RV(JL) = PA_RV(JL) - PRVDEPG(JL)
+ PA_TH(JL) = PA_TH(JL) + PRVDEPG(JL)*PLSFACT(JL)
+ENDDO
!
!
END SUBROUTINE ICE4_SLOW
diff --git a/src/MNH/ice4_tendencies.f90 b/src/MNH/ice4_tendencies.f90
index 3259c42fe..f5c2121fb 100644
--- a/src/MNH/ice4_tendencies.f90
+++ b/src/MNH/ice4_tendencies.f90
@@ -6,13 +6,14 @@
MODULE MODI_ICE4_TENDENCIES
INTERFACE
SUBROUTINE ICE4_TENDENCIES(KSIZE, KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKT, KKL, &
- &KRR, ODSOFT, ODCOMPUTE, &
- &OWARM, HSUBG_RC_RR_ACCR, HSUBG_RR_EVAP, HSUBG_AUCV_RC, HSUBG_PR_PDF, &
+ &KRR, ODSOFT, PCOMPUTE, &
+ &OWARM, HSUBG_RC_RR_ACCR, HSUBG_RR_EVAP, &
+ &HSUBG_AUCV_RC, HSUBG_AUCV_RI, HSUBG_PR_PDF, &
&PEXN, PRHODREF, PLVFACT, PLSFACT, K1, K2, K3, &
&PPRES, PCF, PSIGMA_RC, &
&PCIT, &
&PT, PTHT, &
- &PRVT, PRCT, PRRT, PRIT, PRST, PRGT, PRHT, PRRT3D, &
+ &PRVT, PRCT, PRRT, PRIT, PRST, PRGT, PRHT, &
&PRVHENI_MR, PRRHONG_MR, PRIMLTC_MR, PRSRIMCG_MR, &
&PRCHONI, PRVDEPS, PRIAGGS, PRIAUTS, PRVDEPG, &
&PRCAUTR, PRCACCR, PRREVAV, &
@@ -22,19 +23,21 @@ SUBROUTINE ICE4_TENDENCIES(KSIZE, KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKT, K
&PRCWETH, PRIWETH, PRSWETH, PRGWETH, PRRWETH, &
&PRCDRYH, PRIDRYH, PRSDRYH, PRRDRYH, PRGDRYH, PRDRYHG, PRHMLTR, &
&PRCBERI, &
- &PRS_TEND, PRG_TEND, PRH_TEND, &
+ &PRS_TEND, PRG_TEND, PRH_TEND, PSSI, &
&PA_TH, PA_RV, PA_RC, PA_RR, PA_RI, PA_RS, PA_RG, PA_RH, &
&PB_TH, PB_RV, PB_RC, PB_RR, PB_RI, PB_RS, PB_RG, PB_RH, &
- &PHLC_HCF, PHLC_LCF, PHLC_HRC, PHLC_LRC, PRAINFR)
+ &PHLC_HCF, PHLC_LCF, PHLC_HRC, PHLC_LRC, &
+ &PHLI_HCF, PHLI_LCF, PHLI_HRI, PHLI_LRI, PRAINFR)
IMPLICIT NONE
INTEGER, INTENT(IN) :: KSIZE, KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKT, KKL
INTEGER, INTENT(IN) :: KRR
LOGICAL, INTENT(IN) :: ODSOFT
-LOGICAL, DIMENSION(KSIZE), INTENT(IN) :: ODCOMPUTE
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PCOMPUTE
LOGICAL, INTENT(IN) :: OWARM
CHARACTER(len=80), INTENT(IN) :: HSUBG_RC_RR_ACCR
CHARACTER(len=80), INTENT(IN) :: HSUBG_RR_EVAP
CHARACTER(len=4), INTENT(IN) :: HSUBG_AUCV_RC
+CHARACTER(len=80), INTENT(IN) :: HSUBG_AUCV_RI
CHARACTER(len=80), INTENT(IN) :: HSUBG_PR_PDF ! pdf for subgrid precipitation
REAL, DIMENSION(KSIZE), INTENT(IN) :: PEXN
REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHODREF
@@ -56,7 +59,6 @@ REAL, DIMENSION(KSIZE), INTENT(IN) :: PRIT
REAL, DIMENSION(KSIZE), INTENT(IN) :: PRST
REAL, DIMENSION(KSIZE), INTENT(IN) :: PRGT
REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHT
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRRT3D
REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRVHENI_MR
REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRRHONG_MR
REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRIMLTC_MR
@@ -104,9 +106,10 @@ REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRGDRYH
REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRDRYHG
REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRHMLTR
REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRCBERI
-REAL, DIMENSION(KSIZE, 6), INTENT(INOUT) :: PRS_TEND
-REAL, DIMENSION(KSIZE, 6), INTENT(INOUT) :: PRG_TEND
-REAL, DIMENSION(KSIZE, 8), INTENT(INOUT) :: PRH_TEND
+REAL, DIMENSION(KSIZE, 8), INTENT(INOUT) :: PRS_TEND
+REAL, DIMENSION(KSIZE, 8), INTENT(INOUT) :: PRG_TEND
+REAL, DIMENSION(KSIZE, 10), INTENT(INOUT) :: PRH_TEND
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PSSI
REAL, DIMENSION(KSIZE), INTENT(OUT) :: PA_TH
REAL, DIMENSION(KSIZE), INTENT(OUT) :: PA_RV
REAL, DIMENSION(KSIZE), INTENT(OUT) :: PA_RC
@@ -127,18 +130,23 @@ REAL, DIMENSION(KSIZE), INTENT(OUT) :: PHLC_HCF
REAL, DIMENSION(KSIZE), INTENT(OUT) :: PHLC_LCF
REAL, DIMENSION(KSIZE), INTENT(OUT) :: PHLC_HRC
REAL, DIMENSION(KSIZE), INTENT(OUT) :: PHLC_LRC
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PHLI_HCF
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PHLI_LCF
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PHLI_HRI
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PHLI_LRI
REAL, DIMENSION(KIT,KJT,KKT), INTENT(OUT) :: PRAINFR ! Rain fraction
END SUBROUTINE ICE4_TENDENCIES
END INTERFACE
END MODULE MODI_ICE4_TENDENCIES
SUBROUTINE ICE4_TENDENCIES(KSIZE, KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKT, KKL, &
- &KRR, ODSOFT, ODCOMPUTE, &
- &OWARM, HSUBG_RC_RR_ACCR, HSUBG_RR_EVAP, HSUBG_AUCV_RC, HSUBG_PR_PDF, &
+ &KRR, ODSOFT, PCOMPUTE, &
+ &OWARM, HSUBG_RC_RR_ACCR, HSUBG_RR_EVAP, &
+ &HSUBG_AUCV_RC, HSUBG_AUCV_RI, HSUBG_PR_PDF, &
&PEXN, PRHODREF, PLVFACT, PLSFACT, K1, K2, K3, &
&PPRES, PCF, PSIGMA_RC, &
&PCIT, &
&PT, PTHT, &
- &PRVT, PRCT, PRRT, PRIT, PRST, PRGT, PRHT, PRRT3D, &
+ &PRVT, PRCT, PRRT, PRIT, PRST, PRGT, PRHT, &
&PRVHENI_MR, PRRHONG_MR, PRIMLTC_MR, PRSRIMCG_MR, &
&PRCHONI, PRVDEPS, PRIAGGS, PRIAUTS, PRVDEPG, &
&PRCAUTR, PRCACCR, PRREVAV, &
@@ -148,10 +156,11 @@ SUBROUTINE ICE4_TENDENCIES(KSIZE, KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKT, K
&PRCWETH, PRIWETH, PRSWETH, PRGWETH, PRRWETH, &
&PRCDRYH, PRIDRYH, PRSDRYH, PRRDRYH, PRGDRYH, PRDRYHG, PRHMLTR, &
&PRCBERI, &
- &PRS_TEND, PRG_TEND, PRH_TEND, &
+ &PRS_TEND, PRG_TEND, PRH_TEND, PSSI, &
&PA_TH, PA_RV, PA_RC, PA_RR, PA_RI, PA_RS, PA_RG, PA_RH, &
&PB_TH, PB_RV, PB_RC, PB_RR, PB_RI, PB_RS, PB_RG, PB_RH, &
- &PHLC_HCF, PHLC_LCF, PHLC_HRC, PHLC_LRC, PRAINFR)
+ &PHLC_HCF, PHLC_LCF, PHLC_HRC, PHLC_LRC, &
+ &PHLI_HCF, PHLI_LCF, PHLI_HRI, PHLI_LRI, PRAINFR)
!!
!!** PURPOSE
!! -------
@@ -170,9 +179,10 @@ SUBROUTINE ICE4_TENDENCIES(KSIZE, KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKT, K
!* 0. DECLARATIONS
! ------------
!
-USE MODD_CST, ONLY: XALPI,XBETAI,XCI,XCPV,XGAMI,XLSTT,XMD,XMV,XP00,XRV,XTT
+USE MODD_CST, ONLY: XALPI,XBETAI,XCI,XCPV,XGAMI,XLSTT,XMD,XMV,XP00,XRV,XTT,XEPSILO
USE MODD_RAIN_ICE_DESCR, ONLY: XLBDAS_MAX,XLBEXG,XLBEXH,XLBEXR,XLBEXS,XLBG,XLBH,XLBR,XLBS,XRTMIN
USE MODD_RAIN_ICE_PARAM, ONLY: XSCFAC
+USE MODD_PARAM_ICE, ONLY : CSNOWRIMING
!
USE MODI_ICE4_COMPUTE_PDF
USE MODI_ICE4_FAST_RG
@@ -194,11 +204,12 @@ IMPLICIT NONE
INTEGER, INTENT(IN) :: KSIZE, KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKT, KKL
INTEGER, INTENT(IN) :: KRR
LOGICAL, INTENT(IN) :: ODSOFT
-LOGICAL, DIMENSION(KSIZE), INTENT(IN) :: ODCOMPUTE
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PCOMPUTE
LOGICAL, INTENT(IN) :: OWARM
CHARACTER(len=80), INTENT(IN) :: HSUBG_RC_RR_ACCR
CHARACTER(len=80), INTENT(IN) :: HSUBG_RR_EVAP
CHARACTER(len=4), INTENT(IN) :: HSUBG_AUCV_RC
+CHARACTER(len=80), INTENT(IN) :: HSUBG_AUCV_RI
CHARACTER(len=80), INTENT(IN) :: HSUBG_PR_PDF ! pdf for subgrid precipitation
REAL, DIMENSION(KSIZE), INTENT(IN) :: PEXN
REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHODREF
@@ -209,6 +220,7 @@ INTEGER, DIMENSION(KSIZE), INTENT(IN) :: K2
INTEGER, DIMENSION(KSIZE), INTENT(IN) :: K3
REAL, DIMENSION(KSIZE), INTENT(IN) :: PPRES
REAL, DIMENSION(KSIZE), INTENT(IN) :: PCF
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PSIGMA_RC
REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PCIT
REAL, DIMENSION(KSIZE), INTENT(IN) :: PT
REAL, DIMENSION(KSIZE), INTENT(IN) :: PTHT
@@ -219,8 +231,6 @@ REAL, DIMENSION(KSIZE), INTENT(IN) :: PRIT
REAL, DIMENSION(KSIZE), INTENT(IN) :: PRST
REAL, DIMENSION(KSIZE), INTENT(IN) :: PRGT
REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHT
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRRT3D
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PSIGMA_RC
REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRVHENI_MR
REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRRHONG_MR
REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRIMLTC_MR
@@ -268,9 +278,10 @@ REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRGDRYH
REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRDRYHG
REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRHMLTR
REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRCBERI
-REAL, DIMENSION(KSIZE, 6), INTENT(INOUT) :: PRS_TEND
-REAL, DIMENSION(KSIZE, 6), INTENT(INOUT) :: PRG_TEND
-REAL, DIMENSION(KSIZE, 8), INTENT(INOUT) :: PRH_TEND
+REAL, DIMENSION(KSIZE, 8), INTENT(INOUT) :: PRS_TEND
+REAL, DIMENSION(KSIZE, 8), INTENT(INOUT) :: PRG_TEND
+REAL, DIMENSION(KSIZE, 10), INTENT(INOUT) :: PRH_TEND
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PSSI
REAL, DIMENSION(KSIZE), INTENT(OUT) :: PA_TH
REAL, DIMENSION(KSIZE), INTENT(OUT) :: PA_RV
REAL, DIMENSION(KSIZE), INTENT(OUT) :: PA_RC
@@ -291,20 +302,24 @@ REAL, DIMENSION(KSIZE), INTENT(OUT) :: PHLC_HCF
REAL, DIMENSION(KSIZE), INTENT(OUT) :: PHLC_LCF
REAL, DIMENSION(KSIZE), INTENT(OUT) :: PHLC_HRC
REAL, DIMENSION(KSIZE), INTENT(OUT) :: PHLC_LRC
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PHLI_HCF
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PHLI_LCF
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PHLI_HRI
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PHLI_LRI
REAL, DIMENSION(KIT,KJT,KKT), INTENT(OUT) :: PRAINFR ! Rain fraction
!
!* 0.2 declaration of local variables
!
REAL, DIMENSION(KSIZE) :: ZRVT, ZRCT, ZRRT, ZRIT, ZRST, ZRGT, &
- & ZT, ZTHT, &
+ & ZT, ZTHT, ZRHT, &
& ZZW, &
- & ZSSI, ZKA, ZDV, ZAI, ZCJ, &
+ & ZKA, ZDV, ZAI, ZCJ, &
& ZRF, &
& ZLBDAR, ZLBDAS, ZLBDAG, ZLBDAH, ZLBDAR_RF, &
& ZRGSI, ZRGSI_MR
-REAL, DIMENSION(KIT,KJT,KKT) :: ZRRT3D
+REAL, DIMENSION(KIT,KJT,KKT) :: ZRRT3D, ZRST3D, ZRGT3D, ZRHT3D
INTEGER :: JL
-LOGICAL, DIMENSION(KSIZE) :: LLWETG
+REAL, DIMENSION(KSIZE) :: ZWETG ! 1. if graupel growths in wet mode, 0. otherwise
PA_TH(:)=0.
PA_RV(:)=0.
@@ -323,93 +338,134 @@ PB_RS(:)=0.
PB_RG(:)=0.
PB_RH(:)=0.
!
-ZRVT(:)=PRVT(:)
-ZRCT(:)=PRCT(:)
-ZRRT(:)=PRRT(:)
-ZRIT(:)=PRIT(:)
-ZRST(:)=PRST(:)
-ZRGT(:)=PRGT(:)
-ZTHT(:)=PTHT(:)
-ZT(:)=PT(:)
-!
-!* 2. COMPUTES THE SLOW COLD PROCESS SOURCES
-! --------------------------------------
-CALL ICE4_NUCLEATION(KSIZE, ODSOFT, ODCOMPUTE, &
- ZTHT, PPRES, PRHODREF, PEXN, PLSFACT, ZT, &
- ZRVT, &
- PCIT, PRVHENI_MR, PB_TH, PB_RV, PB_RI)
-ZRIT(:)=ZRIT(:) + PRVHENI_MR(:)
-ZRVT(:)=ZRVT(:) - PRVHENI_MR(:)
-ZTHT(:)=ZTHT(:) + PRVHENI_MR(:)*PLSFACT(:)
-ZT(:) = ZTHT(:) * PEXN(:)
-!
-!* 3.3 compute the spontaneous freezing source: RRHONG
-!
-CALL ICE4_RRHONG(KSIZE, ODSOFT, ODCOMPUTE, &
- &PEXN, PLVFACT, PLSFACT, &
- &ZT, ZRRT, &
- &ZTHT, &
- &PRRHONG_MR, PB_TH, PB_RR, PB_RG)
-ZRGT(:) = ZRGT(:) + PRRHONG_MR(:)
-ZRRT(:) = ZRRT(:) - PRRHONG_MR(:)
-ZTHT(:) = ZTHT(:) + PRRHONG_MR(:)*(PLSFACT(:)-PLVFACT(:)) ! f(L_f*(RRHONG))
-ZT(:) = ZTHT(:) * PEXN(:)
-!
-!* 7.1 cloud ice melting
-!
-CALL ICE4_RIMLTC(KSIZE, ODSOFT, ODCOMPUTE, &
- &PEXN, PLVFACT, PLSFACT, &
- &ZT, &
- &ZTHT, ZRIT, &
- &PRIMLTC_MR, PB_TH, PB_RC, PB_RI)
-ZRCT(:) = ZRCT(:) + PRIMLTC_MR(:)
-ZRIT(:) = ZRIT(:) - PRIMLTC_MR(:)
-ZTHT(:) = ZTHT(:) - PRIMLTC_MR(:)*(PLSFACT(:)-PLVFACT(:)) ! f(L_f*(-RIMLTC))
-ZT(:) = ZTHT(:) * PEXN(:)
-!
-! 5.1.6 riming-conversion of the large sized aggregates into graupel (old parametrisation)
-!
-ZLBDAS(:)=0.
-WHERE(ZRST(:)>0.)
- ZLBDAS(:) = MIN(XLBDAS_MAX, XLBS*(PRHODREF(:)*MAX(ZRST(:), XRTMIN(5)))**XLBEXS)
-END WHERE
-CALL ICE4_RSRIMCG_OLD(KSIZE, ODSOFT, ODCOMPUTE, &
- &PRHODREF, &
- &ZLBDAS, &
- &ZT, ZRCT, ZRST, &
- &PRSRIMCG_MR, PB_RS, PB_RG)
-ZRST(:) = ZRST(:) - PRSRIMCG_MR(:)
-ZRGT(:) = ZRGT(:) + PRSRIMCG_MR(:)
+DO JL=1, KSIZE
+ ZRVT(JL)=PRVT(JL)
+ ZRCT(JL)=PRCT(JL)
+ ZRRT(JL)=PRRT(JL)
+ ZRIT(JL)=PRIT(JL)
+ ZRST(JL)=PRST(JL)
+ ZRGT(JL)=PRGT(JL)
+ ZTHT(JL)=PTHT(JL)
+ ZRHT(JL)=PRHT(JL)
+ ZT(JL)=PT(JL)
+ENDDO
+IF(ODSOFT) THEN
+ PRVHENI_MR(:)=0.
+ PRRHONG_MR(:)=0.
+ PRIMLTC_MR(:)=0.
+ PRSRIMCG_MR(:)=0.
+ELSE
+ !
+ !* 2. COMPUTES THE SLOW COLD PROCESS SOURCES
+ ! --------------------------------------
+ CALL ICE4_NUCLEATION(KSIZE, ODSOFT, PCOMPUTE==1., &
+ ZTHT, PPRES, PRHODREF, PEXN, PLSFACT, ZT, &
+ ZRVT, &
+ PCIT, PRVHENI_MR, PB_TH, PB_RV, PB_RI)
+ DO JL=1, KSIZE
+ ZRIT(JL)=ZRIT(JL) + PRVHENI_MR(JL)
+ ZRVT(JL)=ZRVT(JL) - PRVHENI_MR(JL)
+ ZTHT(JL)=ZTHT(JL) + PRVHENI_MR(JL)*PLSFACT(JL)
+ ZT(JL) = ZTHT(JL) * PEXN(JL)
+ ENDDO
+ !
+ !* 3.3 compute the spontaneous freezing source: RRHONG
+ !
+ CALL ICE4_RRHONG(KSIZE, ODSOFT, PCOMPUTE, &
+ &PEXN, PLVFACT, PLSFACT, &
+ &ZT, ZRRT, &
+ &ZTHT, &
+ &PRRHONG_MR, PB_TH, PB_RR, PB_RG)
+ DO JL=1, KSIZE
+ ZRGT(JL) = ZRGT(JL) + PRRHONG_MR(JL)
+ ZRRT(JL) = ZRRT(JL) - PRRHONG_MR(JL)
+ ZTHT(JL) = ZTHT(JL) + PRRHONG_MR(JL)*(PLSFACT(JL)-PLVFACT(JL)) ! f(L_f*(RRHONG))
+ ZT(JL) = ZTHT(JL) * PEXN(JL)
+ ENDDO
+ !
+ !* 7.1 cloud ice melting
+ !
+ CALL ICE4_RIMLTC(KSIZE, ODSOFT, PCOMPUTE, &
+ &PEXN, PLVFACT, PLSFACT, &
+ &ZT, &
+ &ZTHT, ZRIT, &
+ &PRIMLTC_MR, PB_TH, PB_RC, PB_RI)
+ DO JL=1, KSIZE
+ ZRCT(JL) = ZRCT(JL) + PRIMLTC_MR(JL)
+ ZRIT(JL) = ZRIT(JL) - PRIMLTC_MR(JL)
+ ZTHT(JL) = ZTHT(JL) - PRIMLTC_MR(JL)*(PLSFACT(JL)-PLVFACT(JL)) ! f(L_f*(-RIMLTC))
+ ZT(JL) = ZTHT(JL) * PEXN(JL)
+ ENDDO
+ !
+ ! 5.1.6 riming-conversion of the large sized aggregates into graupel (old parametrisation)
+ !
+ IF(CSNOWRIMING=='OLD ') THEN
+ ZLBDAS(:)=0.
+ WHERE(ZRST(:)>0.)
+ ZLBDAS(:) = MIN(XLBDAS_MAX, XLBS*(PRHODREF(:)*MAX(ZRST(:), XRTMIN(5)))**XLBEXS)
+ END WHERE
+ CALL ICE4_RSRIMCG_OLD(KSIZE, ODSOFT, PCOMPUTE==1., &
+ &PRHODREF, &
+ &ZLBDAS, &
+ &ZT, ZRCT, ZRST, &
+ &PRSRIMCG_MR, PB_RS, PB_RG)
+ DO JL=1, KSIZE
+ ZRST(JL) = ZRST(JL) - PRSRIMCG_MR(JL)
+ ZRGT(JL) = ZRGT(JL) + PRSRIMCG_MR(JL)
+ ENDDO
+ ELSE
+ PRSRIMCG_MR(:) = 0.
+ ENDIF
+ENDIF
!
!* Derived fields
!
IF(KSIZE>0) THEN
- ZZW(:) = EXP(XALPI-XBETAI/ZT(:)-XGAMI*ALOG(ZT(:)))
- DO JL=1, KSIZE
- ZSSI(JL) = ZRVT(JL)*( PPRES(JL)-ZZW(JL) ) / ( (XMV/XMD) * ZZW(JL) ) - 1.0
- ! Supersaturation over ice
- ZKA(JL) = 2.38E-2 + 0.0071E-2*(ZT(JL)-XTT) ! k_a
- ZDV(JL) = 0.211E-4*(ZT(JL)/XTT)**1.94 * (XP00/PPRES(JL)) ! D_v
- ZAI(JL) = (XLSTT+(XCPV-XCI)*(ZT(JL)-XTT))**2 / (ZKA(JL)*XRV*ZT(JL)**2) &
- + ( XRV*ZT(JL) ) / (ZDV(JL)*ZZW(JL))
- ZCJ(JL) = XSCFAC*PRHODREF(JL)**0.3 / SQRT(1.718E-5+0.0049E-5*(ZT(JL)-XTT))
- ENDDO
+ IF(.NOT. ODSOFT) THEN
+ ZZW(:) = EXP(XALPI-XBETAI/ZT(:)-XGAMI*ALOG(ZT(:)))
+ DO JL=1, KSIZE
+ PSSI(JL) = ZRVT(JL)*( PPRES(JL)-ZZW(JL) ) / ( XEPSILO * ZZW(JL) ) - 1.0
+ ! Supersaturation over ice
+ ZKA(JL) = 2.38E-2 + 0.0071E-2*(ZT(JL)-XTT) ! k_a
+ ZDV(JL) = 0.211E-4*(ZT(JL)/XTT)**1.94 * (XP00/PPRES(JL)) ! D_v
+ ZAI(JL) = (XLSTT+(XCPV-XCI)*(ZT(JL)-XTT))**2 / (ZKA(JL)*XRV*ZT(JL)**2) &
+ + ( XRV*ZT(JL) ) / (ZDV(JL)*ZZW(JL))
+ ZCJ(JL) = XSCFAC*PRHODREF(JL)**0.3 / SQRT(1.718E-5+0.0049E-5*(ZT(JL)-XTT))
+ ENDDO
+ ENDIF
!
!Cloud water split between high and low content part is done here
- CALL ICE4_COMPUTE_PDF(KSIZE, HSUBG_AUCV_RC, HSUBG_PR_PDF,&
- PRHODREF, ZRCT, PCF, PSIGMA_RC,&
- PHLC_HCF, PHLC_LCF, PHLC_HRC, PHLC_LRC, ZRF)
- !Diagnostic of precipitation fraction
- PRAINFR(:,:,:) = 0.
- ZRRT3D (:,:,:) = PRRT3D(:,:,:)
- DO JL=1,KSIZE
- PRAINFR(K1(JL), K2(JL), K3(JL)) = ZRF(JL)
- ZRRT3D (K1(JL), K2(JL), K3(JL)) = ZRRT3D(K1(JL), K2(JL), K3(JL)) - PRRHONG_MR(JL)
- END DO
- CALL ICE4_RAINFR_VERT(KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKT, KKL, PRAINFR(:,:,:), ZRRT3D(:,:,:))
- DO JL=1,KSIZE
- ZRF(JL)=PRAINFR(K1(JL), K2(JL), K3(JL))
- END DO
+ CALL ICE4_COMPUTE_PDF(KSIZE, HSUBG_AUCV_RC, HSUBG_AUCV_RI, HSUBG_PR_PDF,&
+ PRHODREF, ZRCT, ZRIT, PCF, ZT, PSIGMA_RC,&
+ PHLC_HCF, PHLC_LCF, PHLC_HRC, PHLC_LRC,&
+ PHLI_HCF, PHLI_LCF, PHLI_HRI, PHLI_LRI, ZRF)
+ IF(HSUBG_RC_RR_ACCR=='PRFR' .OR. HSUBG_RR_EVAP=='PRFR') THEN
+ !Diagnostic of precipitation fraction
+ PRAINFR(:,:,:) = 0.
+ ZRRT3D (:,:,:) = 0.
+ ZRST3D (:,:,:) = 0.
+ ZRGT3D (:,:,:) = 0.
+ ZRHT3D (:,:,:) = 0.
+ DO JL=1,KSIZE
+ PRAINFR(K1(JL), K2(JL), K3(JL)) = ZRF(JL)
+ ZRRT3D (K1(JL), K2(JL), K3(JL)) = ZRRT(JL)
+ ZRST3D (K1(JL), K2(JL), K3(JL)) = ZRST(JL)
+ ZRGT3D (K1(JL), K2(JL), K3(JL)) = ZRGT(JL)
+ END DO
+ IF (KRR==7) THEN
+ DO JL=1,KSIZE
+ ZRHT3D (K1(JL), K2(JL), K3(JL)) = ZRHT(JL)
+ ENDDO
+ ENDIF
+ CALL ICE4_RAINFR_VERT(KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKT, KKL, PRAINFR(:,:,:), ZRRT3D(:,:,:), &
+ &ZRST3D(:,:,:), ZRGT3D(:,:,:), ZRHT3D(:,:,:))
+ DO JL=1,KSIZE
+ ZRF(JL)=PRAINFR(K1(JL), K2(JL), K3(JL))
+ END DO
+ ELSE
+ PRAINFR(:,:,:)=1.
+ ZRF(:)=1.
+ ENDIF
!
!* compute the slope parameters
!
@@ -427,10 +483,14 @@ IF(KSIZE>0) THEN
ZLBDAR(:) = XLBR*( PRHODREF(:)*MAX( ZRRT(:), XRTMIN(3)))**XLBEXR
END WHERE
!ZLBDAR_RF is used when we consider rain concentrated in its fraction
- ZLBDAR_RF(:)=0.
- WHERE(ZRRT(:)>0. .AND. ZRF(:)>0.)
- ZLBDAR_RF(:) = XLBR*( PRHODREF(:) *MAX( ZRRT(:)/ZRF(:) , XRTMIN(3)))**XLBEXR
- END WHERE
+ IF (HSUBG_RC_RR_ACCR=='PRFR' .OR. HSUBG_RR_EVAP=='PRFR') THEN
+ ZLBDAR_RF(:)=0.
+ WHERE(ZRRT(:)>0. .AND. ZRF(:)>0.)
+ ZLBDAR_RF(:) = XLBR*( PRHODREF(:) *MAX( ZRRT(:)/ZRF(:) , XRTMIN(3)))**XLBEXR
+ END WHERE
+ ELSE
+ ZLBDAR_RF(:) = ZLBDAR(:)
+ ENDIF
IF(KRR==7) THEN
ZLBDAH(:)=0.
WHERE(PRHT(:)>0.)
@@ -440,11 +500,11 @@ IF(KSIZE>0) THEN
ENDIF
!
!
-CALL ICE4_SLOW(KSIZE, ODSOFT, ODCOMPUTE, PRHODREF, ZT, &
- &ZSSI, PLVFACT, PLSFACT, &
+CALL ICE4_SLOW(KSIZE, ODSOFT, HSUBG_AUCV_RI, PCOMPUTE, PRHODREF, ZT, &
+ &PSSI, PLVFACT, PLSFACT, &
&ZRVT, ZRCT, ZRIT, ZRST, ZRGT, &
&ZLBDAS, ZLBDAG, &
- &ZAI, ZCJ, &
+ &ZAI, ZCJ, PHLI_HCF, PHLI_HRI, &
&PRCHONI, PRVDEPS, PRIAGGS, PRIAUTS, PRVDEPG, &
&PA_TH, PA_RV, PA_RC, PA_RI, PA_RS, PA_RG)
!
@@ -457,7 +517,7 @@ CALL ICE4_SLOW(KSIZE, ODSOFT, ODCOMPUTE, PRHODREF, ZT, &
!
IF(OWARM) THEN ! Check if the formation of the raindrops by the slow
! warm processes is allowed
- CALL ICE4_WARM(KSIZE, ODSOFT, ODCOMPUTE, HSUBG_RC_RR_ACCR, HSUBG_RR_EVAP, &
+ CALL ICE4_WARM(KSIZE, ODSOFT, PCOMPUTE, HSUBG_RC_RR_ACCR, HSUBG_RR_EVAP, &
&PRHODREF, PLVFACT, ZT, PPRES, ZTHT,&
&ZLBDAR, ZLBDAR_RF, ZKA, ZDV, ZCJ, &
&PHLC_LCF, PHLC_HCF, PHLC_LRC, PHLC_HRC, &
@@ -477,7 +537,7 @@ END IF
!* 4. COMPUTES THE FAST COLD PROCESS SOURCES FOR r_s
! ----------------------------------------------
!
-CALL ICE4_FAST_RS(KSIZE, ODSOFT, ODCOMPUTE, &
+CALL ICE4_FAST_RS(KSIZE, ODSOFT, PCOMPUTE, &
&PRHODREF, PLVFACT, PLSFACT, PPRES, &
&ZDV, ZKA, ZCJ, &
&ZLBDAR, ZLBDAS, &
@@ -495,15 +555,18 @@ CALL ICE4_FAST_RS(KSIZE, ODSOFT, ODCOMPUTE, &
!* 5. COMPUTES THE FAST COLD PROCESS SOURCES FOR r_g
! ------------------------------------------------------
!
-ZRGSI(:) = PRVDEPG(:) + PRSMLTG(:) + PRRACCSG(:) + PRSACCRG(:) + PRCRIMSG(:) + PRSRIMCG(:)
-ZRGSI_MR(:) = PRRHONG_MR(:) + PRSRIMCG_MR(:)
-CALL ICE4_FAST_RG(KSIZE, ODSOFT, ODCOMPUTE, KRR, &
+DO JL=1, KSIZE
+ ZRGSI(JL) = PRVDEPG(JL) + PRSMLTG(JL) + PRRACCSG(JL) + &
+ & PRSACCRG(JL) + PRCRIMSG(JL) + PRSRIMCG(JL)
+ ZRGSI_MR(JL) = PRRHONG_MR(JL) + PRSRIMCG_MR(JL)
+ENDDO
+CALL ICE4_FAST_RG(KSIZE, ODSOFT, PCOMPUTE, KRR, &
&PRHODREF, PLVFACT, PLSFACT, PPRES, &
&ZDV, ZKA, ZCJ, PCIT, &
&ZLBDAR, ZLBDAS, ZLBDAG, &
&ZT, ZRVT, ZRCT, ZRRT, ZRIT, ZRST, ZRGT, &
&ZRGSI, ZRGSI_MR(:), &
- &LLWETG, &
+ &ZWETG, &
&PRICFRRG, PRRCFRIG, PRICFRR, PRCWETG, PRIWETG, PRRWETG, PRSWETG, &
&PRCDRYG, PRIDRYG, PRRDRYG, PRSDRYG, PRWETGH, PRWETGH_MR, PRGMLTR, &
&PRG_TEND, &
@@ -516,7 +579,7 @@ CALL ICE4_FAST_RG(KSIZE, ODSOFT, ODCOMPUTE, KRR, &
! ----------------------------------------------
!
IF (KRR==7) THEN
- CALL ICE4_FAST_RH(KSIZE, ODSOFT, ODCOMPUTE, LLWETG, &
+ CALL ICE4_FAST_RH(KSIZE, ODSOFT, PCOMPUTE, ZWETG, &
&PRHODREF, PLVFACT, PLSFACT, PPRES, &
&ZDV, ZKA, ZCJ, &
&ZLBDAS, ZLBDAG, ZLBDAR, ZLBDAH, &
@@ -546,10 +609,10 @@ END IF
!* 7. COMPUTES SPECIFIC SOURCES OF THE WARM AND COLD CLOUDY SPECIES
! -------------------------------------------------------------
!
-CALL ICE4_FAST_RI(KSIZE, ODSOFT, ODCOMPUTE, &
+CALL ICE4_FAST_RI(KSIZE, ODSOFT, PCOMPUTE, &
&PRHODREF, PLVFACT, PLSFACT, &
&ZAI, ZCJ, PCIT, &
- &ZSSI, &
+ &PSSI, &
&ZRCT, ZRIT, &
&PRCBERI, PA_TH, PA_RC, PA_RI)
!
diff --git a/src/MNH/ice4_warm.f90 b/src/MNH/ice4_warm.f90
index 429c0522b..ff37bc325 100644
--- a/src/MNH/ice4_warm.f90
+++ b/src/MNH/ice4_warm.f90
@@ -5,7 +5,7 @@
!-----------------------------------------------------------------
MODULE MODI_ICE4_WARM
INTERFACE
-SUBROUTINE ICE4_WARM(KSIZE, LDSOFT, LDCOMPUTE, HSUBG_RC_RR_ACCR, HSUBG_RR_EVAP, &
+SUBROUTINE ICE4_WARM(KSIZE, LDSOFT, PCOMPUTE, HSUBG_RC_RR_ACCR, HSUBG_RR_EVAP, &
PRHODREF, PLVFACT, PT, PPRES, PTHT, &
PLBDAR, PLBDAR_RF, PKA, PDV, PCJ, &
PHLC_LCF, PHLC_HCF, PHLC_LRC, PHLC_HRC, &
@@ -16,7 +16,7 @@ SUBROUTINE ICE4_WARM(KSIZE, LDSOFT, LDCOMPUTE, HSUBG_RC_RR_ACCR, HSUBG_RR_EVAP,
IMPLICIT NONE
INTEGER, INTENT(IN) :: KSIZE
LOGICAL, INTENT(IN) :: LDSOFT
-LOGICAL, DIMENSION(KSIZE), INTENT(IN) :: LDCOMPUTE
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PCOMPUTE
CHARACTER(len=80), INTENT(IN) :: HSUBG_RC_RR_ACCR ! subgrid rc-rr accretion
CHARACTER(len=80), INTENT(IN) :: HSUBG_RR_EVAP ! subgrid rr evaporation
REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHODREF ! Reference density
@@ -48,7 +48,7 @@ REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RR
END SUBROUTINE ICE4_WARM
END INTERFACE
END MODULE MODI_ICE4_WARM
-SUBROUTINE ICE4_WARM(KSIZE, LDSOFT, LDCOMPUTE, HSUBG_RC_RR_ACCR, HSUBG_RR_EVAP, &
+SUBROUTINE ICE4_WARM(KSIZE, LDSOFT, PCOMPUTE, HSUBG_RC_RR_ACCR, HSUBG_RR_EVAP, &
PRHODREF, PLVFACT, PT, PPRES, PTHT, &
PLBDAR, PLBDAR_RF, PKA, PDV, PCJ, &
PHLC_LCF, PHLC_HCF, PHLC_LRC, PHLC_HRC, &
@@ -73,7 +73,7 @@ SUBROUTINE ICE4_WARM(KSIZE, LDSOFT, LDCOMPUTE, HSUBG_RC_RR_ACCR, HSUBG_RR_EVAP,
!* 0. DECLARATIONS
! ------------
!
-USE MODD_CST, ONLY: XALPW,XBETAW,XCL,XCPD,XCPV,XGAMW,XLVTT,XMD,XMV,XRV,XTT
+USE MODD_CST, ONLY: XALPW,XBETAW,XCL,XCPD,XCPV,XGAMW,XLVTT,XMD,XMV,XRV,XTT,XEPSILO
USE MODD_RAIN_ICE_DESCR, ONLY: XCEXVT,XRTMIN
USE MODD_RAIN_ICE_PARAM, ONLY: X0EVAR,X1EVAR,XCRIAUTC,XEX0EVAR,XEX1EVAR,XEXCACCR,XFCACCR,XTIMAUTC
!
@@ -85,7 +85,7 @@ IMPLICIT NONE
!
INTEGER, INTENT(IN) :: KSIZE
LOGICAL, INTENT(IN) :: LDSOFT
-LOGICAL, DIMENSION(KSIZE), INTENT(IN) :: LDCOMPUTE
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PCOMPUTE
CHARACTER(len=80), INTENT(IN) :: HSUBG_RC_RR_ACCR ! subgrid rc-rr accretion
CHARACTER(len=80), INTENT(IN) :: HSUBG_RR_EVAP ! subgrid rr evaporation
REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHODREF ! Reference density
@@ -117,10 +117,12 @@ REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RR
!
!* 0.2 declaration of local variables
!
-LOGICAL, DIMENSION(SIZE(PRHODREF)) :: GMASK, GMASK1, GMASK2
-REAL, DIMENSION(SIZE(PRHODREF)) :: ZZW2, ZZW3, ZZW4
-REAL, DIMENSION(SIZE(PRHODREF)) :: ZUSW ! Undersaturation over water
-REAL, DIMENSION(SIZE(PRHODREF)) :: ZTHLT ! Liquid potential temperature
+REAL, DIMENSION(KSIZE) :: ZZW2, ZZW3, ZZW4
+REAL, DIMENSION(KSIZE) :: ZUSW ! Undersaturation over water
+REAL, DIMENSION(KSIZE) :: ZTHLT ! Liquid potential temperature
+REAL, DIMENSION(KSIZE) :: ZMASK, ZMASK1, ZMASK2
+INTEGER :: JL
+!-------------------------------------------------------------------------------
!
!
!
@@ -128,33 +130,44 @@ REAL, DIMENSION(SIZE(PRHODREF)) :: ZTHLT ! Liquid potential temperature
!
!* 4.2 compute the autoconversion of r_c for r_r production: RCAUTR
!
-GMASK(:)=PHLC_HRC(:)>XRTMIN(2) .AND. PHLC_HCF(:) .GT. 0. .AND. LDCOMPUTE(:)
+DO JL=1, KSIZE
+ ZMASK(JL)=MAX(0., -SIGN(1., XRTMIN(2)-PHLC_HRC(JL))) * & ! PHLC_HRC(:)>XRTMIN(2)
+ &MAX(0., -SIGN(1., 1.E-20-PHLC_HCF(JL))) * & ! PHLC_HCF(:) .GT. 0.
+ &PCOMPUTE(JL)
+ENDDO
IF(LDSOFT) THEN
- WHERE(.NOT. GMASK(:))
- PRCAUTR(:) = 0.
- END WHERE
+ DO JL=1, KSIZE
+ PRCAUTR(JL)=PRCAUTR(JL)*ZMASK(JL)
+ ENDDO
ELSE
PRCAUTR(:) = 0.
- WHERE(GMASK(:))
+ WHERE(ZMASK(:)==1.)
PRCAUTR(:) = XTIMAUTC*MAX(PHLC_HRC(:)/PHLC_HCF(:) - XCRIAUTC/PRHODREF(:), 0.0)
PRCAUTR(:) = PHLC_HCF(:)*PRCAUTR(:)
END WHERE
ENDIF
-PA_RC(:) = PA_RC(:) - PRCAUTR(:)
-PA_RR(:) = PA_RR(:) + PRCAUTR(:)
+DO JL=1, KSIZE
+ PA_RC(JL) = PA_RC(JL) - PRCAUTR(JL)
+ PA_RR(JL) = PA_RR(JL) + PRCAUTR(JL)
+ENDDO
+!
!
!* 4.3 compute the accretion of r_c for r_r production: RCACCR
!
IF (HSUBG_RC_RR_ACCR=='NONE') THEN
!CLoud water and rain are diluted over the grid box
- GMASK(:)=PRCT(:)>XRTMIN(2) .AND. PRRT(:)>XRTMIN(3) .AND. LDCOMPUTE(:)
+ DO JL=1, KSIZE
+ ZMASK(JL)=MAX(0., -SIGN(1., XRTMIN(2)-PRCT(JL))) * & ! PRCT(:)>XRTMIN(2)
+ &MAX(0., -SIGN(1., XRTMIN(3)-PRRT(JL))) * & ! PRRT(:)>XRTMIN(3)
+ &PCOMPUTE(JL)
+ ENDDO
IF(LDSOFT) THEN
- WHERE(.NOT. GMASK(:))
- PRCACCR(:)=0.
- END WHERE
+ DO JL=1, KSIZE
+ PRCACCR(JL)=PRCACCR(JL) * ZMASK(JL)
+ ENDDO
ELSE
PRCACCR(:) = 0.
- WHERE(GMASK(:))
+ WHERE(ZMASK(:)==1.)
PRCACCR(:) = XFCACCR * PRCT(:) &
* PLBDAR(:)**XEXCACCR &
* PRHODREF(:)**(-XCEXVT)
@@ -169,23 +182,31 @@ ELSEIF (HSUBG_RC_RR_ACCR=='PRFR') THEN
! 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
- GMASK(:)=PRCT(:)>XRTMIN(2) .AND. PRRT(:)>XRTMIN(3) .AND. LDCOMPUTE(:)
- GMASK1(:)=GMASK(:) .AND. PHLC_HRC(:)>XRTMIN(2) .AND. PHLC_HCF(:)>0.
- GMASK2(:)=GMASK(:) .AND. PHLC_LRC(:)>XRTMIN(2) .AND. PHLC_LCF(:)>0.
+ DO JL=1, KSIZE
+ ZMASK(JL)=MAX(0., -SIGN(1., XRTMIN(2)-PRCT(JL))) * & ! PRCT(:)>XRTMIN(2)
+ &MAX(0., -SIGN(1., XRTMIN(3)-PRRT(JL))) * & ! PRRT(:)>XRTMIN(3)
+ &PCOMPUTE(JL)
+ ZMASK1(JL)=ZMASK(JL) * &
+ &MAX(0., -SIGN(1., XRTMIN(2)-PHLC_HRC(JL))) * & ! PHLC_HRC(:)>XRTMIN(2)
+ &MAX(0., -SIGN(1., 1.E-20-PHLC_HCF(JL))) ! PHLC_HCF(:)>0.
+ ZMASK2(JL)=ZMASK(JL) * &
+ &MAX(0., -SIGN(1., XRTMIN(2)-PHLC_LRC(JL))) * & ! PHLC_LRC(:)>XRTMIN(2)
+ &MAX(0., -SIGN(1., 1.E-20-PHLC_LCF(JL))) ! PHLC_LCF(:)>0.
+ ENDDO
IF(LDSOFT) THEN
- WHERE(.NOT. (GMASK1(:) .OR. GMASK2(:)))
- PRCACCR(:)=0.
- END WHERE
+ DO JL=1, KSIZE
+ PRCACCR(JL)=PRCACCR(JL) * MIN(1., ZMASK1(JL)+ZMASK2(JL))
+ ENDDO
ELSE
PRCACCR(:)=0.
- WHERE(GMASK1(:))
+ WHERE(ZMASK1(:)==1.)
!Accretion due to rain falling in high cloud content
PRCACCR(:) = XFCACCR * ( PHLC_HRC(:)/PHLC_HCF(:) ) &
* PLBDAR_RF(:)**XEXCACCR &
* PRHODREF(:)**(-XCEXVT) &
* PHLC_HCF
END WHERE
- WHERE(GMASK2(:))
+ WHERE(ZMASK2(:)==1.)
!We add acrretion due to rain falling in low cloud content
PRCACCR(:) = PRCACCR(:) + XFCACCR * ( PHLC_LRC(:)/PHLC_LCF(:) ) &
* PLBDAR_RF(:)**XEXCACCR &
@@ -196,24 +217,29 @@ ELSEIF (HSUBG_RC_RR_ACCR=='PRFR') THEN
ELSE
CALL PRINT_MSG(NVERB_FATAL,'GEN','ICE4_WARM','wrong HSUBG_RC_RR_ACCR case')
ENDIF
-!
-PA_RC(:) = PA_RC(:) - PRCACCR(:)
-PA_RR(:) = PA_RR(:) + PRCACCR(:)
+DO JL=1, KSIZE
+ PA_RC(JL) = PA_RC(JL) - PRCACCR(JL)
+ PA_RR(JL) = PA_RR(JL) + PRCACCR(JL)
+ENDDO
!
!* 4.4 compute the evaporation of r_r: RREVAV
!
IF (HSUBG_RR_EVAP=='NONE') THEN
- GMASK(:)=PRRT(:)>XRTMIN(3) .AND. PRCT(:)<=XRTMIN(2) .AND. LDCOMPUTE(:)
+ DO JL=1, KSIZE
+ ZMASK(JL)=MAX(0., -SIGN(1., XRTMIN(3)-PRRT(JL))) * & ! PRRT(:)>XRTMIN(3)
+ &MAX(0., SIGN(1., XRTMIN(2)-PRCT(JL))) * & ! PRCT(:)<=XRTMIN(2)
+ &PCOMPUTE(JL)
+ ENDDO
IF(LDSOFT) THEN
- WHERE(.NOT. GMASK(:))
- PRREVAV(:)=0.
- END WHERE
+ DO JL=1, KSIZE
+ PRREVAV(JL)=PRREVAV(JL)*ZMASK(JL)
+ ENDDO
ELSE
PRREVAV(:) = 0.
!Evaporation only when there's no cloud (RC must be 0)
- WHERE(GMASK(:))
+ WHERE(ZMASK(:)==1.)
PRREVAV(:) = EXP( XALPW - XBETAW/PT(:) - XGAMW*ALOG(PT(:) ) ) ! es_w
- ZUSW(:) = 1.0 - PRVT(:)*( PPRES(:)-PRREVAV(:) ) / ( (XMV/XMD) * PRREVAV(:) )
+ ZUSW(:) = 1.0 - PRVT(:)*( PPRES(:)-PRREVAV(:) ) / ( XEPSILO * PRREVAV(:) )
! Undersaturation over water
PRREVAV(:) = ( XLVTT+(XCPV-XCL)*(PT(:)-XTT) )**2 / ( PKA(:)*XRV*PT(:)**2 ) &
+ ( XRV*PT(:) ) / ( PDV(:)*PRREVAV(:) )
@@ -240,14 +266,18 @@ ELSEIF (HSUBG_RR_EVAP=='CLFR' .OR. HSUBG_RR_EVAP=='PRFR') THEN
!Ces variables devraient être sorties de rain_ice_slow et on mettrait le calcul de T^u, T^s
!et plusieurs versions (comme actuellement, en ciel clair, en ciel nuageux) de PKA, PDV, PCJ dans rain_ice
!On utiliserait la bonne version suivant l'option NONE, CLFR... dans l'évaporation et ailleurs
- GMASK(:)=PRRT(:)>XRTMIN(3) .AND. ZZW4(:) > PCF(:) .AND. LDCOMPUTE(:)
+ DO JL=1, KSIZE
+ ZMASK(JL)=MAX(0., -SIGN(1., XRTMIN(3)-PRRT(JL))) * & ! PRRT(:)>XRTMIN(3)
+ &MAX(0., -SIGN(1., PCF(JL)-ZZW4(JL))) * & ! ZZW4(:) > PCF(:)
+ &PCOMPUTE(JL)
+ ENDDO
IF(LDSOFT) THEN
- WHERE(.NOT. GMASK(:))
- PRREVAV(:)=0.
- END WHERE
+ DO JL=1, KSIZE
+ PRREVAV(JL)=PRREVAV(JL)*ZMASK(JL)
+ ENDDO
ELSE
PRREVAV(:) = 0.
- WHERE(GMASK(:))
+ WHERE(ZMASK(:)==1)
! outside the cloud (environment) the use of T^u (unsaturated) instead of T
! Bechtold et al. 1993
!
@@ -261,7 +291,7 @@ ELSEIF (HSUBG_RR_EVAP=='CLFR' .OR. HSUBG_RR_EVAP=='PRFR') THEN
PRREVAV(:) = EXP( XALPW - XBETAW/ZZW2(:) - XGAMW*ALOG(ZZW2(:) ) )
!
! S, Undersaturation over water (with new theta^u)
- ZUSW(:) = 1.0 - PRVT(:)*( PPRES(:)-PRREVAV(:) ) / ( (XMV/XMD) * PRREVAV(:) )
+ ZUSW(:) = 1.0 - PRVT(:)*( PPRES(:)-PRREVAV(:) ) / ( XEPSILO * PRREVAV(:) )
!
PRREVAV(:) = ( XLVTT+(XCPV-XCL)*(ZZW2(:)-XTT) )**2 / ( PKA(:)*XRV*ZZW2(:)**2 ) &
+ ( XRV*ZZW2(:) ) / ( PDV(:)*PRREVAV(:) )
@@ -276,9 +306,11 @@ ELSEIF (HSUBG_RR_EVAP=='CLFR' .OR. HSUBG_RR_EVAP=='PRFR') THEN
ELSE
CALL PRINT_MSG(NVERB_FATAL,'GEN','ICE4_WARM','wrong HSUBG_RR_EVAP case')
END IF
-PA_RR(:) = PA_RR(:) - PRREVAV(:)
-PA_RV(:) = PA_RV(:) + PRREVAV(:)
-PA_TH(:) = PA_TH(:) - PRREVAV(:)*PLVFACT(:)
+DO JL=1, KSIZE
+ PA_RR(JL) = PA_RR(JL) - PRREVAV(JL)
+ PA_RV(JL) = PA_RV(JL) + PRREVAV(JL)
+ PA_TH(JL) = PA_TH(JL) - PRREVAV(JL)*PLVFACT(JL)
+ENDDO
!
!
END SUBROUTINE ICE4_WARM
diff --git a/src/MNH/ice_adjust.f90 b/src/MNH/ice_adjust.f90
index aaf7c903b..fa66ddbaa 100644
--- a/src/MNH/ice_adjust.f90
+++ b/src/MNH/ice_adjust.f90
@@ -9,32 +9,37 @@
!
INTERFACE
!
- SUBROUTINE ICE_ADJUST (KKA, KKU, KKL, KRR, HFRAC_ICE, &
- HBUNAME, OSUBG_COND, OSIGMAS, &
+ SUBROUTINE ICE_ADJUST (KKA, KKU, KKL, KRR, HFRAC_ICE, HCONDENS, HLAMBDA3,&
+ HBUNAME, OSUBG_COND, OSIGMAS, HSUBG_MF_PDF,&
PTSTEP, PSIGQSAT, &
- PRHODJ, PEXNREF, PSIGS, PMFCONV, PPABST, PZZ, &
+ PRHODJ, PEXNREF, PRHODREF, PSIGS, PMFCONV, PPABST, PZZ, &
PEXN, PCF_MF, PRC_MF, PRI_MF, &
PRV, PRC, PRVS, PRCS, PTH, PTHS, PSRCS, PCLDFR , &
PRR, PRI, PRIS, PRS, PRG, &
- PRH, POUT_RV, POUT_RC, POUT_RI, POUT_TH )
+ PRH, POUT_RV, POUT_RC, POUT_RI, POUT_TH, &
+ PHLC_HRC, PHLC_HCF, PHLI_HRI, PHLI_HCF )
!
INTEGER, INTENT(IN) :: KKA !near ground array index
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=80), INTENT(IN) :: HCONDENS
+CHARACTER(len=4), INTENT(IN) :: HLAMBDA3 ! formulation for lambda3 coeff
CHARACTER(len=*), INTENT(IN) :: HBUNAME ! Name of the budget
LOGICAL, INTENT(IN) :: OSUBG_COND ! Switch for Subgrid
! Condensation
LOGICAL :: OSIGMAS ! Switch for Sigma_s:
! use values computed in CONDENSATION
! or that from turbulence scheme
+CHARACTER(len=80), INTENT(IN) :: HSUBG_MF_PDF
REAL, INTENT(IN) :: PTSTEP ! Double Time step
! (single if cold start)
REAL, INTENT(IN) :: PSIGQSAT ! coeff applied to qsat variance contribution
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PSIGS ! Sigma_s at time t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PMFCONV ! convective mass flux
@@ -66,6 +71,10 @@ REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(OUT) :: POUT_RV ! Adjusted value
REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(OUT) :: POUT_RC ! Adjusted value
REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(OUT) :: POUT_RI ! Adjusted value
REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(OUT) :: POUT_TH ! Adjusted value
+REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(OUT) :: PHLC_HRC
+REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(OUT) :: PHLC_HCF
+REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(OUT) :: PHLI_HRI
+REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(OUT) :: PHLI_HCF
!
!
END SUBROUTINE ICE_ADJUST
@@ -75,14 +84,16 @@ END INTERFACE
END MODULE MODI_ICE_ADJUST
! ##########################################################################
- SUBROUTINE ICE_ADJUST (KKA, KKU, KKL, KRR, HFRAC_ICE, &
- HBUNAME, OSUBG_COND, OSIGMAS, &
+ SUBROUTINE ICE_ADJUST (KKA, KKU, KKL, KRR, HFRAC_ICE, HCONDENS, HLAMBDA3,&
+ HBUNAME, OSUBG_COND, OSIGMAS, HSUBG_MF_PDF, &
PTSTEP, PSIGQSAT, &
- PRHODJ, PEXNREF, PSIGS, PMFCONV, PPABST, PZZ, &
+ PRHODJ, PEXNREF, PRHODREF, PSIGS, PMFCONV, &
+ PPABST, PZZ, &
PEXN, PCF_MF, PRC_MF, PRI_MF, &
- PRV, PRC, PRVS, PRCS, PTH, PTHS, PSRCS, PCLDFR , &
+ PRV, PRC, PRVS, PRCS, PTH, PTHS, PSRCS, PCLDFR, &
PRR, PRI, PRIS, PRS, PRG, PRH, &
- POUT_RV, POUT_RC, POUT_RI, POUT_TH )
+ POUT_RV, POUT_RC, POUT_RI, POUT_TH, &
+ PHLC_HRC, PHLC_HCF, PHLI_HRI, PHLI_HCF )
! #########################################################################
!
!!**** *ICE_ADJUST* - compute the ajustment of water vapor in mixed-phase
@@ -178,6 +189,7 @@ USE MODD_CST
USE MODD_PARAMETERS
use mode_budget, only: Budget_store_init, Budget_store_end
+USE MODD_RAIN_ICE_PARAM, ONLY : XCRIAUTC, XCRIAUTI, XACRIAUTI, XBCRIAUTI
use mode_tools_ll, only: GET_INDICE_ll
USE MODI_CONDENSATION
@@ -194,18 +206,22 @@ 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=80), INTENT(IN) :: HCONDENS
+CHARACTER(len=4), INTENT(IN) :: HLAMBDA3 ! formulation for lambda3 coeff
CHARACTER(len=*), INTENT(IN) :: HBUNAME ! Name of the budget
LOGICAL, INTENT(IN) :: OSUBG_COND ! Switch for Subgrid
! Condensation
LOGICAL :: OSIGMAS ! Switch for Sigma_s:
! use values computed in CONDENSATION
! or that from turbulence scheme
+CHARACTER(len=80), INTENT(IN) :: HSUBG_MF_PDF
REAL, INTENT(IN) :: PTSTEP ! Double Time step
! (single if cold start)
REAL, INTENT(IN) :: PSIGQSAT ! coeff applied to qsat variance contribution
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PSIGS ! Sigma_s at time t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PMFCONV ! convective mass flux
@@ -238,6 +254,10 @@ REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(OUT) :: POUT_RV ! Adjusted value
REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(OUT) :: POUT_RC ! Adjusted value
REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(OUT) :: POUT_RI ! Adjusted value
REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(OUT) :: POUT_TH ! Adjusted value
+REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(OUT) :: PHLC_HRC
+REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(OUT) :: PHLC_HCF
+REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(OUT) :: PHLI_HRI
+REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(OUT) :: PHLI_HCF
!
!* 0.2 Declarations of local variables :
!
@@ -248,7 +268,9 @@ REAL, DIMENSION(SIZE(PEXNREF,1),SIZE(PEXNREF,2),SIZE(PEXNREF,3)) &
ZCPH, & ! guess of the CPh for the mixing
ZLV, & ! guess of the Lv at t+1
ZLS, & ! guess of the Ls at t+1
- ZW1,ZW2 ! Work arrays for intermediate fields
+ ZW1,ZW2, & ! Work arrays for intermediate fields
+ ZCRIAUT, & ! Autoconversion thresholds
+ ZHCF, ZHR
!
INTEGER :: IIU,IJU,IKU! dimensions of dummy arrays
INTEGER :: IIB,IJB ! Horz index values of the first inner mass points
@@ -327,10 +349,11 @@ DO JITER =1,ITERMAX
!
! PSRC= s'rci'/Sigma_s^2
! ZT, ZRV, ZRC and ZRI are INOUT
- CALL CONDENSATION(IIU, IJU, IKU, IIB, IIE, IJB, IJE, IKB, IKE, KKL, &
- HFRAC_ICE, &
- PPABST, PZZ, ZT, ZRV, ZRC, ZRI, PRS, PRG, PSIGS, PMFCONV, PCLDFR, PSRCS, .TRUE., OSIGMAS, &
- PSIGQSAT, PLV=ZLV, PLS=ZLS, PCPH=ZCPH )
+ CALL CONDENSATION(IIU, IJU, IKU, IIB, IIE, IJB, IJE, IKB, IKE, KKL, &
+ HFRAC_ICE, HCONDENS, HLAMBDA3, &
+ PPABST, PZZ, PRHODREF, ZT, ZRV, ZRC, ZRI, PRS, PRG, PSIGS, PMFCONV, PCLDFR, &
+ PSRCS, .TRUE., OSIGMAS, &
+ PSIGQSAT, PLV=ZLV, PLS=ZLS, PCPH=ZCPH, PHLC_HRC=PHLC_HRC, PHLC_HCF=PHLC_HCF, PHLI_HRI=PHLI_HRI, PHLI_HCF=PHLI_HCF)
ELSE
!
!* 4. ALL OR NOTHING CONDENSATION SCHEME
@@ -343,12 +366,12 @@ DO JITER =1,ITERMAX
!CALL ADJUST_LANGLOIS(IIU, IJU, IKU, IIB, IIE, IJB, IJE, IKB, IKE, KKL, &
! PPABST, ZT, ZRV, ZRC, ZRI, ZLV, ZLS, ZCPH) HFRAC_ICE must be implemented in Langlois before using it again
ZSIGS=0.
- CALL CONDENSATION(IIU, IJU, IKU, IIB, IIE, IJB, IJE, IKB, IKE, KKL, &
- HFRAC_ICE, &
- PPABST, PZZ, ZT, ZRV, ZRC, ZRI, PRS, PRG, ZSIGS, PMFCONV, PCLDFR, &
- ZSRCS, .TRUE., OSIGMAS=.TRUE., &
- PSIGQSAT=0., PLV=ZLV, PLS=ZLS, PCPH=ZCPH )
- END IF
+ CALL CONDENSATION(IIU, IJU, IKU, IIB, IIE, IJB, IJE, IKB, IKE, KKL, &
+ HFRAC_ICE, HCONDENS, HLAMBDA3, &
+ PPABST, PZZ, PRHODREF, ZT, ZRV, ZRC, ZRI, PRS, PRG, ZSIGS, PMFCONV, PCLDFR, &
+ ZSRCS, .TRUE., OSIGMAS=.TRUE., &
+ PSIGQSAT=0., PLV=ZLV, PLS=ZLS, PHLC_HRC=PHLC_HRC, PHLC_HCF=PHLC_HCF, PHLI_HRI=PHLI_HRI, PHLI_HCF=PHLI_HCF)
+ ENDIF
ENDDO ! end of the iterative loop
!
!* 5. COMPUTE THE SOURCES AND STORES THE CLOUD FRACTION
@@ -405,6 +428,59 @@ ELSE
ZW1(:,:,:)=ZW1(:,:,:)*PRVS(:,:,:)/(ZW1(:,:,:)+ZW2(:,:,:))
ZW2(:,:,:)=PRVS(:,:,:)-ZW1(:,:,:)
ENDWHERE
+ IF(PRESENT(PHLC_HRC) .AND. PRESENT(PHLC_HCF)) THEN
+ ZCRIAUT(:,:,:)=XCRIAUTC/PRHODREF
+ IF(HSUBG_MF_PDF=='NONE')THEN
+ WHERE(ZW1(:,:,:)*PTSTEP>PCF_MF * ZCRIAUT)
+ PHLC_HRC(:,:,:)=PHLC_HRC(:,:,:)+ZW1(:,:,:)*PTSTEP
+ PHLC_HCF(:,:,:)=MIN(1.,PHLC_HCF(:,:,:)+PCF_MF(:,:,:))
+ ENDWHERE
+ ELSEIF(HSUBG_MF_PDF=='TRIANGLE')THEN
+ !ZHCF is the precipitating part of the *cloud* and not of the grid cell
+ WHERE(ZW1(:,:,:)*PTSTEP>PCF_MF*ZCRIAUT(:,:,:))
+ ZHCF(:,:,:)=1.-.5*(ZCRIAUT(:,:,:)*PCF_MF(:,:,:) / MAX(1.E-20, ZW1(:,:,:)*PTSTEP))**2
+ ZHR(:,:,:)=ZW1(:,:,:)*PTSTEP-(ZCRIAUT(:,:,:)*PCF_MF(:,:,:))**3 / &
+ &(3*MAX(1.E-20, ZW1(:,:,:)*PTSTEP)**2)
+ ELSEWHERE(2.*ZW1(:,:,:)*PTSTEP<=PCF_MF * ZCRIAUT(:,:,:))
+ ZHCF(:,:,:)=0.
+ ZHR(:,:,:)=0.
+ ELSEWHERE
+ ZHCF(:,:,:)=(2.*ZW1(:,:,:)*PTSTEP-ZCRIAUT(:,:,:)*PCF_MF(:,:,:))**2 / &
+ &(2.*MAX(1.E-20, ZW1(:,:,:)*PTSTEP)**2)
+ ZHR(:,:,:)=(4.*(ZW1(:,:,:)*PTSTEP)**3-3.*ZW1(:,:,:)*PTSTEP*(ZCRIAUT(:,:,:)*PCF_MF(:,:,:))**2+&
+ (ZCRIAUT(:,:,:)*PCF_MF(:,:,:))**3) / &
+ &(3*MAX(1.E-20, ZW1(:,:,:)*PTSTEP)**2)
+ ENDWHERE
+ ZHCF(:,:,:)=ZHCF(:,:,:)*PCF_MF(:,:,:) !to retrieve the part of the grid cell
+ PHLC_HCF(:,:,:)=MIN(1.,PHLC_HCF(:,:,:)+ZHCF(:,:,:)) !total part of the grid cell that is precipitating
+ PHLC_HRC(:,:,:)=PHLC_HRC(:,:,:)+ZHR(:,:,:)
+ ENDIF
+ ENDIF
+ IF(PRESENT(PHLI_HRI) .AND. PRESENT(PHLI_HCF)) THEN
+ ZCRIAUT(:,:,:)=MIN(XCRIAUTI,10**(XACRIAUTI*(ZT(:,:,:)-XTT)+XBCRIAUTI))
+ IF(HSUBG_MF_PDF=='NONE')THEN
+ WHERE(ZW2(:,:,:)*PTSTEP>PCF_MF * ZCRIAUT(:,:,:))
+ PHLI_HRI(:,:,:)=PHLI_HRI(:,:,:)+ZW2(:,:,:)*PTSTEP
+ PHLI_HCF(:,:,:)=MIN(1.,PHLI_HCF(:,:,:)+PCF_MF(:,:,:))
+ ENDWHERE
+ ELSEIF(HSUBG_MF_PDF=='TRIANGLE')THEN
+ !ZHCF is the precipitating part of the *cloud* and not of the grid cell
+ WHERE(ZW2(:,:,:)*PTSTEP>PCF_MF*ZCRIAUT)
+ ZHCF(:,:,:)=1.-.5*(ZCRIAUT*PCF_MF(:,:,:) / (ZW2(:,:,:)*PTSTEP))**2
+ ZHR(:,:,:)=ZW2(:,:,:)*PTSTEP-(ZCRIAUT*PCF_MF(:,:,:))**3/(3*(ZW2(:,:,:)*PTSTEP)**2)
+ ELSEWHERE(2.*ZW2(:,:,:)*PTSTEP<=PCF_MF * ZCRIAUT)
+ ZHCF(:,:,:)=0.
+ ZHR(:,:,:)=0.
+ ELSEWHERE
+ ZHCF(:,:,:)=(2.*ZW2(:,:,:)*PTSTEP-ZCRIAUT*PCF_MF(:,:,:))**2 / (2.*(ZW2(:,:,:)*PTSTEP)**2)
+ ZHR(:,:,:)=(4.*(ZW2(:,:,:)*PTSTEP)**3-3.*ZW2(:,:,:)*PTSTEP*(ZCRIAUT*PCF_MF(:,:,:))**2+&
+ (ZCRIAUT*PCF_MF(:,:,:))**3)/(3*(ZW2(:,:,:)*PTSTEP)**2)
+ ENDWHERE
+ ZHCF(:,:,:)=ZHCF(:,:,:)*PCF_MF(:,:,:) !to retrieve the part of the grid cell
+ PHLI_HCF(:,:,:)=MIN(1.,PHLI_HCF(:,:,:)+ZHCF(:,:,:)) !total part of the grid cell that is precipitating
+ PHLI_HRI(:,:,:)=PHLI_HRI(:,:,:)+ZHR(:,:,:)
+ ENDIF
+ ENDIF
PCLDFR(:,:,:)=MIN(1.,PCLDFR(:,:,:)+PCF_MF(:,:,:))
PRCS(:,:,:)=PRCS(:,:,:)+ZW1(:,:,:)
PRIS(:,:,:)=PRIS(:,:,:)+ZW2(:,:,:)
@@ -425,13 +501,13 @@ ELSE
ZRV(:,:,:)=ZRV(:,:,:)-(ZW1(:,:,:)+ZW2(:,:,:))
ZT(:,:,:) = ZT(:,:,:) + &
(ZW1 * ZLV(:,:,:) + ZW2 * ZLS(:,:,:)) / ZCPH(:,:,:)
- IF(PRESENT(POUT_RV)) POUT_RV=ZRV
- IF(PRESENT(POUT_RC)) POUT_RC=ZRC
- IF(PRESENT(POUT_RI)) POUT_RI=ZRI
- IF(PRESENT(POUT_TH)) POUT_TH=ZT / PEXN(:,:,:)
ENDIF
ENDIF
!
+IF(PRESENT(POUT_RV)) POUT_RV=ZRV
+IF(PRESENT(POUT_RC)) POUT_RC=ZRC
+IF(PRESENT(POUT_RI)) POUT_RI=ZRI
+IF(PRESENT(POUT_TH)) POUT_TH=ZT / PEXN(:,:,:)
!
!
!* 6. STORE THE BUDGET TERMS
diff --git a/src/MNH/ice_adjust_elec.f90 b/src/MNH/ice_adjust_elec.f90
index 6d766496d..9c4d20e41 100644
--- a/src/MNH/ice_adjust_elec.f90
+++ b/src/MNH/ice_adjust_elec.f90
@@ -370,9 +370,10 @@ DO JITER = 1, ITERMAX
!
! ZW3=water vapor ZW1=rc (INOUT) ZW2=ri (INOUT) PSRC= s'rci'/Sigma_s^2
ZW3 = PRVS * PTSTEP; ZW1 = PRCS * PTSTEP; ZW2 = PRIS * PTSTEP
+ ZW4 = 1. ! PRODREF is not used if HL variables are not present
!
- CALL CONDENSATION( IIU, IJU, IKU, IIB, IIE, IJB, IJE, IKB, IKE,1, 'T', &
- PPABST, PZZ, ZT, ZW3, ZW1, ZW2, PRSS*PTSTEP, PRGS*PTSTEP, &
+ CALL CONDENSATION( IIU, IJU, IKU, IIB, IIE, IJB, IJE, IKB, IKE,1, 'T', 'CB02', 'CB', &
+ PPABST, PZZ, ZW4, ZT, ZW3, ZW1, ZW2, PRSS*PTSTEP, PRGS*PTSTEP, &
PSIGS, PMFCONV, PCLDFR, PSRCS, .TRUE., &
OSIGMAS, PSIGQSAT, PLV=ZLV, PLS=ZLS, PCPH=ZCPH )
!
diff --git a/src/MNH/ini_cst.f90 b/src/MNH/ini_cst.f90
index 91526bed4..8ce239471 100644
--- a/src/MNH/ini_cst.f90
+++ b/src/MNH/ini_cst.f90
@@ -132,6 +132,7 @@ XMD = 28.9644E-3
XMV = 18.0153E-3
XRD = XAVOGADRO * XBOLTZ / XMD
XRV = XAVOGADRO * XBOLTZ / XMV
+XEPSILO= XMV/XMD
XCPD = 7.* XRD /2.
XCPV = 4.* XRV
XRHOLW = 1000.
diff --git a/src/MNH/ini_modeln.f90 b/src/MNH/ini_modeln.f90
index 49a15b336..d0020427d 100644
--- a/src/MNH/ini_modeln.f90
+++ b/src/MNH/ini_modeln.f90
@@ -289,6 +289,7 @@ END MODULE MODI_INI_MODEL_n
! P. Wautelet 07/06/2019: allocate lookup tables for optical properties only when needed
! P. Wautelet 13/09/2019: budget: simplify and modernize date/time management
! C. Lac 11/2019: correction in the drag formula and application to building in addition to tree
+! S. Riette 04/2020: XHL* fields
!---------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -846,6 +847,21 @@ ELSE
ALLOCATE(XSRCT(0,0,0))
ALLOCATE(XSIGS(0,0,0))
END IF
+IF (CCLOUD == 'ICE3'.OR.CCLOUD == 'ICE4') THEN
+ ALLOCATE(XHLC_HRC(IIU,IJU,IKU))
+ ALLOCATE(XHLC_HCF(IIU,IJU,IKU))
+ ALLOCATE(XHLI_HRI(IIU,IJU,IKU))
+ ALLOCATE(XHLI_HCF(IIU,IJU,IKU))
+ XHLC_HRC(:,:,:)=0.
+ XHLC_HCF(:,:,:)=0.
+ XHLI_HRI(:,:,:)=0.
+ XHLI_HCF(:,:,:)=0.
+ELSE
+ ALLOCATE(XHLC_HRC(0,0,0))
+ ALLOCATE(XHLC_HCF(0,0,0))
+ ALLOCATE(XHLI_HRI(0,0,0))
+ ALLOCATE(XHLI_HCF(0,0,0))
+END IF
!
IF (NRR>1) THEN
ALLOCATE(XCLDFR(IIU,IJU,IKU)); XCLDFR (:, :, :) = 0.
diff --git a/src/MNH/modd_cst.f90 b/src/MNH/modd_cst.f90
index 0becaf15d..f6bc6c52f 100644
--- a/src/MNH/modd_cst.f90
+++ b/src/MNH/modd_cst.f90
@@ -68,6 +68,7 @@ REAL,SAVE :: XSTEFAN,XI0 ! Stefan-Boltzman constant, solar constant
!
REAL,SAVE :: XMD,XMV ! Molar mass of dry air and molar mass of vapor
REAL,SAVE :: XRD,XRV ! Gaz constant for dry air, gaz constant for vapor
+REAL,SAVE :: XEPSILO ! XMV/XMD
REAL,SAVE :: XCPD,XCPV ! Cpd (dry air), Cpv (vapor)
REAL,SAVE :: XRHOLW ! Volumic mass of liquid water
REAL,SAVE :: XCL,XCI ! Cl (liquid), Ci (ice)
diff --git a/src/MNH/modd_fieldn.f90 b/src/MNH/modd_fieldn.f90
index 92e3b89c6..32ba30187 100644
--- a/src/MNH/modd_fieldn.f90
+++ b/src/MNH/modd_fieldn.f90
@@ -53,6 +53,7 @@
!! Bielli S. 02/2019 Sea salt : significant sea wave height influences salt emission; 5 salt modes
! P. Wautelet 06/03/2019: correct XZWS entry
! P. Wautelet 14/03/2019: add XZWS_DEFAULT parameter
+! 04/2020 S. Riette HighLow cloud
!!
!-------------------------------------------------------------------------------
!
@@ -139,6 +140,10 @@ REAL, POINTER :: XDRYMASST=>NULL()
REAL, POINTER :: XDRYMASSS=>NULL()
REAL, DIMENSION(:,:,:), POINTER :: XSRC=>NULL()
REAL, DIMENSION(:,:,:), POINTER :: XSRCT=>NULL()
+REAL, DIMENSION(:,:,:), POINTER :: XHLC_HRC=>NULL()
+REAL, DIMENSION(:,:,:), POINTER :: XHLC_HCF=>NULL()
+REAL, DIMENSION(:,:,:), POINTER :: XHLI_HRI=>NULL()
+REAL, DIMENSION(:,:,:), POINTER :: XHLI_HCF=>NULL()
REAL, DIMENSION(:,:,:), POINTER :: XSIGS=>NULL()
REAL, DIMENSION(:,:,:), POINTER :: XCLDFR=>NULL()
REAL, DIMENSION(:,:,:), POINTER :: XRAINFR=>NULL()
diff --git a/src/MNH/modd_getn.f90 b/src/MNH/modd_getn.f90
index bae3402d5..282172d1d 100644
--- a/src/MNH/modd_getn.f90
+++ b/src/MNH/modd_getn.f90
@@ -53,6 +53,7 @@
!! 05/2006 Remove EPS and LGETALL
!! M. Leriche 04/2010 add get indicators for pH in cloud and rain
!! Bielli S. 02/2019 Sea salt : significant sea wave height influences salt emission; 5 salt modes
+! S. Riette 04/2020 HighLow cloud
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -92,6 +93,7 @@ TYPE GET_t
! CLouD FRaction
CHARACTER (LEN=4) :: CGETSRCT ! Get indicator for SRCM
! and SRCT related to the subgrid condensation
+ CHARACTER (LEN=4) :: CGETHL ! Get indicator for HighLow cloud
CHARACTER (LEN=4) :: CGETCIT ! Get indicator for the
! primary ice concentration
CHARACTER (LEN=4) :: CGETCONV ! Get indicator for the
@@ -127,6 +129,7 @@ CHARACTER (LEN=4), POINTER :: CGETLSTHM=>NULL(), CGETLSRVM=>NULL()
CHARACTER (LEN=4), POINTER :: CGETSIGS=>NULL(),CGETSRC=>NULL()
CHARACTER (LEN=4), POINTER :: CGETCLDFR=>NULL()
CHARACTER (LEN=4), POINTER :: CGETSRCT=>NULL()
+CHARACTER (LEN=4), POINTER :: CGETHL=>NULL()
CHARACTER (LEN=4), POINTER :: CGETCIT=>NULL()
CHARACTER (LEN=4), POINTER :: CGETCONV=>NULL()
CHARACTER (LEN=4), POINTER :: CGETRAD=>NULL()
@@ -181,6 +184,7 @@ CGETSIGS=>GET_MODEL(KTO)%CGETSIGS
CGETSRC=>GET_MODEL(KTO)%CGETSRC
CGETCLDFR=>GET_MODEL(KTO)%CGETCLDFR
CGETSRCT=>GET_MODEL(KTO)%CGETSRCT
+CGETHL=>GET_MODEL(KTO)%CGETHL
CGETCIT=>GET_MODEL(KTO)%CGETCIT
CGETZWS=>GET_MODEL(KTO)%CGETZWS
CGETCONV=>GET_MODEL(KTO)%CGETCONV
diff --git a/src/MNH/modd_turbn.f90 b/src/MNH/modd_turbn.f90
index 8dc0cb5e1..7bb60fe40 100644
--- a/src/MNH/modd_turbn.f90
+++ b/src/MNH/modd_turbn.f90
@@ -77,7 +77,12 @@ TYPE TURB_t
CHARACTER(LEN=4) :: CTOM ! type of Third Order Moments
! 'NONE' none
! 'TM06' Tomas Masson 2006
- CHARACTER(LEN=4) :: CSUBG_AUCV ! type of subgrid autoconv. method
+ CHARACTER(LEN=4) :: CSUBG_AUCV ! type of subgrid rc->rr autoconv. method
+ CHARACTER(LEN=80) :: CSUBG_AUCV_RI ! type of subgrid ri->rs autoconv. method
+ CHARACTER(LEN=80) :: CCONDENS ! subrgrid condensation PDF
+ CHARACTER(LEN=4) :: CLAMBDA3 ! lambda3 choice for subgrid cloud scheme
+ CHARACTER(LEN=80) :: CSUBG_MF_PDF ! PDF to use for MF cloud autoconversions
+
! REAL, DIMENSION(:,:), POINTER :: XBL_DEPTH=>NULL() ! BL depth for TOMS computations
! REAL, DIMENSION(:,:), POINTER :: XSBL_DEPTH=>NULL()! SurfaceBL depth for RMC01 computations
! REAL, DIMENSION(:,:,:), POINTER :: XWTHVMF=>NULL()! Mass Flux vert. transport of buoyancy
@@ -105,6 +110,10 @@ LOGICAL, POINTER :: LSIG_CONV=>NULL()
LOGICAL, POINTER :: LRMC01=>NULL()
CHARACTER(LEN=4),POINTER :: CTOM=>NULL()
CHARACTER(LEN=4),POINTER :: CSUBG_AUCV=>NULL()
+CHARACTER(LEN=80),POINTER :: CSUBG_AUCV_RI=>NULL()
+CHARACTER(LEN=80),POINTER :: CCONDENS=>NULL()
+CHARACTER(LEN=4),POINTER :: CLAMBDA3=>NULL()
+CHARACTER(LEN=80),POINTER :: CSUBG_MF_PDF=>NULL()
REAL, DIMENSION(:,:), POINTER :: XBL_DEPTH=>NULL()
REAL, DIMENSION(:,:), POINTER :: XSBL_DEPTH=>NULL()
REAL, DIMENSION(:,:,:), POINTER :: XWTHVMF=>NULL()
@@ -145,6 +154,10 @@ LSIG_CONV=>TURB_MODEL(KTO)%LSIG_CONV
LRMC01=>TURB_MODEL(KTO)%LRMC01
CTOM=>TURB_MODEL(KTO)%CTOM
CSUBG_AUCV=>TURB_MODEL(KTO)%CSUBG_AUCV
+CSUBG_AUCV_RI=>TURB_MODEL(KTO)%CSUBG_AUCV_RI
+CCONDENS=>TURB_MODEL(KTO)%CCONDENS
+CLAMBDA3=>TURB_MODEL(KTO)%CLAMBDA3
+CSUBG_MF_PDF=>TURB_MODEL(KTO)%CSUBG_MF_PDF
!XBL_DEPTH=>TURB_MODEL(KTO)%XBL_DEPTH !Done in FIELDLIST_GOTO_MODEL
!XSBL_DEPTH=>TURB_MODEL(KTO)%XSBL_DEPTH !Done in FIELDLIST_GOTO_MODEL
!XWTHVMF=>TURB_MODEL(KTO)%XWTHVMF !Done in FIELDLIST_GOTO_MODEL
diff --git a/src/MNH/modeln.f90 b/src/MNH/modeln.f90
index 585b131a3..934a06acc 100644
--- a/src/MNH/modeln.f90
+++ b/src/MNH/modeln.f90
@@ -1805,6 +1805,7 @@ IF (CCLOUD /= 'NONE' .AND. CELEC == 'NONE') THEN
XINPRS,ZINPRS3D, XINPRG,ZINPRG3D, XINPRH,ZINPRH3D, &
XSOLORG, XMI,ZSPEEDC, ZSPEEDR, ZSPEEDS, ZSPEEDG, ZSPEEDH, &
XINDEP, XSUPSAT, XNACT, XNPRO,XSSPRO, XRAINFR, &
+ XHLC_HRC, XHLC_HCF, XHLI_HRI, XHLI_HCF, &
ZSEA, ZTOWN )
DEALLOCATE(ZTOWN)
ELSE
@@ -1822,7 +1823,8 @@ IF (CCLOUD /= 'NONE' .AND. CELEC == 'NONE') THEN
XINPRC,ZINPRC3D,XINPRR, XINPRR3D, XEVAP3D, &
XINPRS,ZINPRS3D, XINPRG,ZINPRG3D, XINPRH,ZINPRH3D, &
XSOLORG, XMI,ZSPEEDC, ZSPEEDR, ZSPEEDS, ZSPEEDG, ZSPEEDH, &
- XINDEP, XSUPSAT, XNACT, XNPRO,XSSPRO, XRAINFR )
+ XINDEP, XSUPSAT, XNACT, XNPRO,XSSPRO, XRAINFR, &
+ XHLC_HRC, XHLC_HCF, XHLI_HRI, XHLI_HCF )
END IF
XRTHS_CLD = XRTHS - XRTHS_CLD
XRRS_CLD = XRRS - XRRS_CLD
diff --git a/src/MNH/modn_turbn.f90 b/src/MNH/modn_turbn.f90
index a91112bee..cce15ba12 100644
--- a/src/MNH/modn_turbn.f90
+++ b/src/MNH/modn_turbn.f90
@@ -66,7 +66,11 @@ USE MODD_TURB_n, ONLY: &
LRMC01_n => LRMC01, &
CTOM_n => CTOM, &
CSUBG_AUCV_n => CSUBG_AUCV, &
- VSIGQSAT_n => VSIGQSAT
+ VSIGQSAT_n => VSIGQSAT, &
+ CSUBG_AUCV_RI_n => CSUBG_AUCV_RI, &
+ CCONDENS_n => CCONDENS, &
+ CLAMBDA3_n => CLAMBDA3, &
+ CSUBG_MF_PDF_n => CSUBG_MF_PDF
!
IMPLICIT NONE
!
@@ -83,11 +87,16 @@ LOGICAL,SAVE :: LSIG_CONV
LOGICAL,SAVE :: LRMC01
CHARACTER (LEN=4),SAVE :: CTOM
CHARACTER (LEN=4),SAVE :: CSUBG_AUCV
+CHARACTER (LEN=80),SAVE :: CSUBG_AUCV_RI
+CHARACTER (LEN=80),SAVE :: CCONDENS
+CHARACTER (LEN=4),SAVE :: CLAMBDA3
+CHARACTER (LEN=80),SAVE :: CSUBG_MF_PDF
REAL,SAVE :: VSIGQSAT
!
NAMELIST/NAM_TURBn/XIMPL,CTURBLEN,CTURBDIM,LTURB_FLX,LTURB_DIAG, &
LSUBG_COND,LSIGMAS,LSIG_CONV,LRMC01,CTOM,CSUBG_AUCV,&
- XKEMIN,VSIGQSAT,XCEDIS
+ XKEMIN,VSIGQSAT,XCEDIS,CSUBG_AUCV_RI,CCONDENS,&
+ CLAMBDA3,CSUBG_MF_PDF
!
CONTAINS
@@ -107,6 +116,10 @@ SUBROUTINE INIT_NAM_TURBn
CTOM = CTOM_n
CSUBG_AUCV = CSUBG_AUCV_n
VSIGQSAT = VSIGQSAT_n
+ CSUBG_AUCV_RI = CSUBG_AUCV_RI_n
+ CCONDENS = CCONDENS_n
+ CLAMBDA3 = CLAMBDA3_n
+ CSUBG_MF_PDF = CSUBG_MF_PDF_n
END SUBROUTINE INIT_NAM_TURBn
SUBROUTINE UPDATE_NAM_TURBn
@@ -124,6 +137,10 @@ SUBROUTINE UPDATE_NAM_TURBn
CTOM_n = CTOM
CSUBG_AUCV_n = CSUBG_AUCV
VSIGQSAT_n = VSIGQSAT
+ CSUBG_AUCV_RI_n = CSUBG_AUCV_RI
+ CCONDENS_n = CCONDENS
+ CLAMBDA3_n = CLAMBDA3
+ CSUBG_MF_PDF_n = CSUBG_MF_PDF
END SUBROUTINE UPDATE_NAM_TURBn
END MODULE MODN_TURB_n
diff --git a/src/MNH/radtr_satel.f90 b/src/MNH/radtr_satel.f90
index 851030cd8..b22d80313 100644
--- a/src/MNH/radtr_satel.f90
+++ b/src/MNH/radtr_satel.f90
@@ -257,6 +257,7 @@ REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZNCLD ! grid scale cloud fraction
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRC ! grid scale r_c mixing ratio (kg/kg)
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRI ! grid scale r_i (kg/kg)
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRV ! grid scale r_v (kg/kg)
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRHO
!----------------------------------------------------------------------------
!
!* 1. INITIALIZATION OF CONSTANTS FOR TRANSFERT CODE
@@ -476,8 +477,10 @@ IF( SIZE(PRT(:,:,:,:),4) >= 2 ) THEN
ALLOCATE(ZSIGRC(IIU,IJU,IKU))
ALLOCATE(ZRV(IIU,IJU,IKU))
ZRV=PRT(:,:,:,1)
- CALL CONDENSATION( IIU, IJU, IKU, IIB, IIE, IJB, IJE, IKB, IKE, 1, 'T',&
- PPABST, PZZ, ZTEMP, ZRV, ZRC, ZRI, PRT(:,:,:,5), PRT(:,:,:,6), PSIGS,&
+ ALLOCATE(ZRHO(IIU,IJU,IKU))
+ ZRHO=1. !unused
+ CALL CONDENSATION( IIU, IJU, IKU, IIB, IIE, IJB, IJE, IKB, IKE, 1, 'T', 'CB02', 'CB',&
+ PPABST, PZZ, ZRHO, ZTEMP, ZRV, ZRC, ZRI, PRT(:,:,:,5), PRT(:,:,:,6), PSIGS,&
PMFCONV, ZNCLD, ZSIGRC, OUSERI, OSIGMAS,PSIGQSAT )
DEALLOCATE(ZTEMP,ZSIGRC)
ELSE
diff --git a/src/MNH/rain_ice.f90 b/src/MNH/rain_ice.f90
index ec1f39204..a9bfe9104 100644
--- a/src/MNH/rain_ice.f90
+++ b/src/MNH/rain_ice.f90
@@ -751,7 +751,8 @@ IF( IMICRO >= 0 ) THEN
DO JL=1,IMICRO
PRAINFR(I1(JL),I2(JL),I3(JL)) = ZRF(JL)
END DO
- CALL ICE4_RAINFR_VERT(IIB, IIE, IIT, IJB, IJE, IJT, IKB, IKE, IKT, KKL, PRAINFR, PRRT(:,:,:))
+ CALL ICE4_RAINFR_VERT(IIB, IIE, IIT, IJB, IJE, IJT, IKB, IKE, IKT, KKL, PRAINFR, PRRT(:,:,:), &
+ PRSS(:,:,:)*0., PRGS(:,:,:)*0.)
DO JL=1,IMICRO
ZRF(JL)=PRAINFR(I1(JL),I2(JL),I3(JL))
END DO
@@ -935,7 +936,8 @@ ELSE
call Print_msg( NVERB_FATAL, 'GEN', 'RAIN_ICE', 'no sedimentation scheme for HSEDIM='//HSEDIM )
END IF
!sedimentation of rain fraction
-CALL ICE4_RAINFR_VERT(IIB, IIE, IIT, IJB, IJE, IJT, IKB, IKE, IKT, KKL, PRAINFR, PRRS(:,:,:)*PTSTEP)
+CALL ICE4_RAINFR_VERT(IIB, IIE, IIT, IJB, IJE, IJT, IKB, IKE, IKT, KKL, PRAINFR, PRRS(:,:,:)*PTSTEP, &
+ PRSS(:,:,:)*PTSTEP, PRGS(:,:,:)*PTSTEP)
!
!-------------------------------------------------------------------------------
!
diff --git a/src/MNH/rain_ice_red.f90 b/src/MNH/rain_ice_red.f90
index 1a7088f18..5f347b729 100644
--- a/src/MNH/rain_ice_red.f90
+++ b/src/MNH/rain_ice_red.f90
@@ -8,20 +8,27 @@
! ########################
!
INTERFACE
- SUBROUTINE RAIN_ICE_RED ( OSEDIC,HSEDIM, HSUBG_AUCV_RC, OWARM, KKA, KKU, KKL, &
+ SUBROUTINE RAIN_ICE_RED ( KIT, KJT, KKT, KSIZE, &
+ OSEDIC, HSEDIM, HSUBG_AUCV_RC, HSUBG_AUCV_RI, &
+ OWARM, KKA, KKU, KKL, &
PTSTEP, KRR, ODMICRO, PEXN, &
PDZZ, PRHODJ, PRHODREF, PEXNREF, PPABST, PCIT, PCLDFR,&
+ PHLC_HRC, PHLC_HCF, PHLI_HRI, PHLI_HCF,&
PTHT, PRVT, PRCT, PRRT, PRIT, PRST, &
PRGT, PTHS, PRVS, PRCS, PRRS, PRIS, PRSS, PRGS, &
PINPRC,PINPRR, PINPRR3D, PEVAP3D, &
- PINPRS, PINPRG, PSIGS, PINDEP, PRAINFR, PSEA, PTOWN, &
+ PINPRS, PINPRG, PINDEP, PRAINFR, PSIGS, PSEA, PTOWN, &
PRHT, PRHS, PINPRH, PFPR )
!
!
+INTEGER, INTENT(IN) :: KIT, KJT, KKT ! arrays size
+INTEGER, INTENT(IN) :: KSIZE
LOGICAL, INTENT(IN) :: OSEDIC ! Switch for droplet sedim.
CHARACTER(LEN=4), INTENT(IN) :: HSEDIM ! Sedimentation scheme
CHARACTER(LEN=4), INTENT(IN) :: HSUBG_AUCV_RC ! Switch for rc->rr Subgrid autoconversion
! Kind of Subgrid autoconversion method
+CHARACTER(LEN=80), INTENT(IN) :: HSUBG_AUCV_RI ! Switch for ri->rs Subgrid autoconversion
+ ! Kind of Subgrid autoconversion method
LOGICAL, INTENT(IN) :: OWARM ! .TRUE. allows raindrops to
! form by warm processes
! (Kessler scheme)
@@ -32,63 +39,69 @@ INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=ARO
REAL, INTENT(IN) :: PTSTEP ! Double Time step
! (single if cold start)
INTEGER, INTENT(IN) :: KRR ! Number of moist variable
-LOGICAL, DIMENSION(:,:,:), INTENT(IN) :: ODMICRO ! mask to limit computation
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXN ! Exner function
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! Layer thikness (m)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF! Reference density
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! absolute pressure at t
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCIT ! Pristine ice n.c. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PCLDFR ! Cloud fraction
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta at time t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVT ! Water vapor m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCT ! Cloud water m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Rain water m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRIT ! Pristine ice m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRGT ! Graupel/hail m.r. at t
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSIGS ! Sigma_s at t
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta 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
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRIS ! Pristine ice m.r. source
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRSS ! Snow/aggregate m.r. source
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRGS ! Graupel m.r. source
-
-!
-REAL, DIMENSION(:,:), INTENT(OUT) :: PINPRC! Cloud instant precip
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PINDEP ! Cloud instant deposition
-REAL, DIMENSION(:,:), INTENT(OUT) :: PINPRR! Rain instant precip
-REAL, DIMENSION(:,:,:),INTENT(OUT) :: PINPRR3D! Rain inst precip 3D
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PEVAP3D! Rain evap profile
-REAL, DIMENSION(:,:), INTENT(OUT) :: PINPRS! Snow instant precip
-REAL, DIMENSION(:,:), INTENT(OUT) :: PINPRG! Graupel instant precip
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRAINFR! Rain fraction
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PSEA ! Sea Mask
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PTOWN! Fraction that is town
-REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(IN) :: PRHT ! Hail m.r. at t
-REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(INOUT) :: PRHS ! Hail m.r. source
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: PINPRH! Hail instant precip
-REAL, DIMENSION(:,:,:,:), OPTIONAL, INTENT(OUT) :: PFPR ! upper-air precipitation fluxes
+LOGICAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: ODMICRO ! mask to limit computation
+!
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PEXN ! Exner function
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PDZZ ! Layer thikness (m)
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRHODREF! Reference density
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PEXNREF ! Reference Exner function
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PPABST ! absolute pressure at t
+!
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PCIT ! Pristine ice n.c. at t
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PCLDFR ! Cloud fraction
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PHLC_HRC
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PHLC_HCF
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PHLI_HRI
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PHLI_HCF
+!
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PTHT ! Theta at time t
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRVT ! Water vapor m.r. at t
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRCT ! Cloud water m.r. at t
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRRT ! Rain water m.r. at t
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRIT ! Pristine ice m.r. at t
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRGT ! Graupel/hail m.r. at t
+!
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PTHS ! Theta source
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRVS ! Water vapor m.r. source
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRCS ! Cloud water m.r. source
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRRS ! Rain water m.r. source
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRIS ! Pristine ice m.r. source
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRSS ! Snow/aggregate m.r. source
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRGS ! Graupel m.r. source
+
+!
+REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRC! Cloud instant precip
+REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRR! Rain instant precip
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(OUT) :: PINPRR3D! Rain inst precip 3D
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(OUT) :: PEVAP3D! Rain evap profile
+REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRS! Snow instant precip
+REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRG! Graupel instant precip
+REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINDEP ! Cloud instant deposition
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(OUT) :: PRAINFR
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PSIGS ! Sigma_s at t
+REAL, DIMENSION(KIT,KJT), OPTIONAL, INTENT(IN) :: PSEA ! Sea Mask
+REAL, DIMENSION(KIT,KJT), OPTIONAL, INTENT(IN) :: PTOWN! Fraction that is town
+REAL, DIMENSION(KIT,KJT,KKT), OPTIONAL, INTENT(IN) :: PRHT ! Hail m.r. at t
+REAL, DIMENSION(KIT,KJT,KKT), OPTIONAL, INTENT(INOUT) :: PRHS ! Hail m.r. source
+REAL, DIMENSION(KIT,KJT), OPTIONAL, INTENT(OUT) :: PINPRH! Hail instant precip
+REAL, DIMENSION(KIT,KJT,KKT,KRR), OPTIONAL, INTENT(OUT) :: PFPR ! upper-air precipitation fluxes
!
END SUBROUTINE RAIN_ICE_RED
END INTERFACE
END MODULE MODI_RAIN_ICE_RED
! ######spl
- SUBROUTINE RAIN_ICE_RED ( OSEDIC,HSEDIM, HSUBG_AUCV_RC, OWARM, KKA, KKU, KKL, &
- PTSTEP, KRR, ODMICRO, PEXN, &
+ SUBROUTINE RAIN_ICE_RED ( KIT, KJT, KKT, KSIZE, &
+ OSEDIC, HSEDIM, HSUBG_AUCV_RC, HSUBG_AUCV_RI, &
+ OWARM,KKA,KKU,KKL,&
+ PTSTEP, KRR, ODMICRO, PEXN, &
PDZZ, PRHODJ, PRHODREF, PEXNREF, PPABST, PCIT, PCLDFR,&
+ PHLC_HRC, PHLC_HCF, PHLI_HRI, PHLI_HCF, &
PTHT, PRVT, PRCT, PRRT, PRIT, PRST, &
PRGT, PTHS, PRVS, PRCS, PRRS, PRIS, PRSS, PRGS, &
PINPRC,PINPRR, PINPRR3D, PEVAP3D, &
- PINPRS, PINPRG, PSIGS, PINDEP, PRAINFR, PSEA, PTOWN, &
+ PINPRS, PINPRG, PINDEP, PRAINFR, PSIGS, PSEA, PTOWN, &
PRHT, PRHS, PINPRH, PFPR )
! ######################################################################
!
@@ -249,6 +262,9 @@ END MODULE MODI_RAIN_ICE_RED
!* 0. DECLARATIONS
! ------------
!
+USE PARKIND1, ONLY : JPRB
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK
+
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, &
@@ -277,9 +293,12 @@ IMPLICIT NONE
!
!
!
+INTEGER, INTENT(IN) :: KIT, KJT, KKT ! arrays size
+INTEGER, INTENT(IN) :: KSIZE
LOGICAL, INTENT(IN) :: OSEDIC ! Switch for droplet sedim.
CHARACTER(LEN=4), INTENT(IN) :: HSEDIM ! Sedimentation scheme
CHARACTER(LEN=4), INTENT(IN) :: HSUBG_AUCV_RC ! Kind of Subgrid autoconversion method
+CHARACTER(LEN=80), INTENT(IN) :: HSUBG_AUCV_RI ! Kind of Subgrid autoconversion method
LOGICAL, INTENT(IN) :: OWARM ! .TRUE. allows raindrops to
! form by warm processes
! (Kessler scheme)
@@ -288,200 +307,216 @@ INTEGER, INTENT(IN) :: KKU !uppest atmosphere array index
INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=ARO
REAL, INTENT(IN) :: PTSTEP ! Double Time step (single if cold start)
INTEGER, INTENT(IN) :: KRR ! Number of moist variable
-LOGICAL, DIMENSION(:,:,:), INTENT(IN) :: ODMICRO ! mask to limit computation
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXN ! Exner function
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! Layer thikness (m)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF! Reference density
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! absolute pressure at t
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCIT ! Pristine ice n.c. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PCLDFR ! Convective Mass Flux Cloud fraction
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta at time t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVT ! Water vapor m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCT ! Cloud water m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Rain water m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRIT ! Pristine ice m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRGT ! Graupel/hail m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSIGS ! Sigma_s at t
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta 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
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRIS ! Pristine ice m.r. source
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRSS ! Snow/aggregate m.r. source
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRGS ! Graupel m.r. source
-!
-REAL, DIMENSION(:,:), INTENT(OUT) :: PINPRC! Cloud instant precip
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PINDEP ! Cloud instant deposition
-REAL, DIMENSION(:,:), INTENT(OUT) :: PINPRR! Rain instant precip
-REAL, DIMENSION(:,:,:),INTENT(OUT) :: PINPRR3D! Rain inst precip 3D
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PEVAP3D! Rain evap profile
-REAL, DIMENSION(:,:), INTENT(OUT) :: PINPRS! Snow instant precip
-REAL, DIMENSION(:,:), INTENT(OUT) :: PINPRG! Graupel instant precip
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRAINFR! Rain fraction
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PSEA ! Sea Mask
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PTOWN! Fraction that is town
-REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(IN) :: PRHT ! Hail m.r. at t
-REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(INOUT) :: PRHS ! Hail m.r. source
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: PINPRH! Hail instant precip
-REAL, DIMENSION(:,:,:,:), OPTIONAL, INTENT(OUT) :: PFPR ! upper-air precipitation fluxes
+LOGICAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: ODMICRO ! mask to limit computation
+!
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PEXN ! Exner function
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PDZZ ! Layer thikness (m)
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRHODREF! Reference density
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PEXNREF ! Reference Exner function
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PPABST ! absolute pressure at t
+!
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PCIT ! Pristine ice n.c. at t
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PCLDFR ! Convective Mass Flux Cloud fraction
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PHLC_HRC
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PHLC_HCF
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PHLI_HRI
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PHLI_HCF
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PTHT ! Theta at time t
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRVT ! Water vapor m.r. at t
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRCT ! Cloud water m.r. at t
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRRT ! Rain water m.r. at t
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRIT ! Pristine ice m.r. at t
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRGT ! Graupel/hail m.r. at t
+!
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PTHS ! Theta source
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRVS ! Water vapor m.r. source
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRCS ! Cloud water m.r. source
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRRS ! Rain water m.r. source
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRIS ! Pristine ice m.r. source
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRSS ! Snow/aggregate m.r. source
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRGS ! Graupel m.r. source
+!
+REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRC! Cloud instant precip
+REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRR! Rain instant precip
+REAL, DIMENSION(KIT,KJT,KKT),INTENT(OUT) :: PINPRR3D! Rain inst precip 3D
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(OUT) :: PEVAP3D! Rain evap profile
+REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRS! Snow instant precip
+REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRG! Graupel instant precip
+REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINDEP ! Cloud instant deposition
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(OUT) :: PRAINFR
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PSIGS ! Sigma_s at t
+REAL, DIMENSION(KIT,KJT), OPTIONAL, INTENT(IN) :: PSEA ! Sea Mask
+REAL, DIMENSION(KIT,KJT), OPTIONAL, INTENT(IN) :: PTOWN! Fraction that is town
+REAL, DIMENSION(KIT,KJT,KKT), OPTIONAL, INTENT(IN) :: PRHT ! Hail m.r. at t
+REAL, DIMENSION(KIT,KJT,KKT), OPTIONAL, INTENT(INOUT) :: PRHS ! Hail m.r. source
+REAL, DIMENSION(KIT,KJT), OPTIONAL, INTENT(OUT) :: PINPRH! Hail instant precip
+REAL, DIMENSION(KIT,KJT,KKT,KRR), OPTIONAL, INTENT(OUT) :: PFPR ! upper-air precipitation fluxes
!
!* 0.2 Declarations of local variables :
!
INTEGER :: IIB ! Define the domain where is
INTEGER :: IIE ! the microphysical sources have to be computed
-INTEGER :: IIT !
INTEGER :: IJB !
INTEGER :: IJE !
-INTEGER :: IJT !
-INTEGER :: IKB, IKTB, IKT!
+INTEGER :: IKB, IKTB !
INTEGER :: IKE, IKTE !
!
+INTEGER :: JI, JJ, JK
+!
!For packing
INTEGER :: IMICRO ! Case r_x>0 locations
-INTEGER, DIMENSION(COUNT(ODMICRO)) :: I1,I2,I3 ! Used to replace the COUNT
-INTEGER :: JL ! and PACK intrinsics
+INTEGER, DIMENSION(KSIZE) :: I1,I2,I3 ! Used to replace the COUNT
+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)) :: &
+!Arrays for nucleation call outisde of LDMICRO points
+REAL, DIMENSION(KIT, KJT, KKT) :: ZW ! work array
+REAL, DIMENSION(KIT, KJT, KKT) :: ZT ! Temperature
+REAL, DIMENSION(KIT, KJT, KKT) :: &
& 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 :: zw1, zw2, zw3, zw4, zw5, zw6 !Work arrays
real, dimension(:,:,:), allocatable :: zz_diff
+REAL, DIMENSION(KIT, KJT, KKT) :: ZZ_LVFACT, ZZ_LSFACT
!
!Diagnostics
-REAL, DIMENSION(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)) :: &
- & ZHLC_HCF3D,& ! HLCLOUDS cloud fraction in high water content part
- & ZHLC_LCF3D,& ! HLCLOUDS cloud fraction in low water content part
- & ZHLC_HRC3D,& ! HLCLOUDS cloud water content in high water content
- & ZHLC_LRC3D ! HLCLOUDS cloud water content in low water content
+REAL, DIMENSION(KIT, KJT, KKT) :: &
+ & ZHLC_HCF3D,& ! HLCLOUDS cloud fraction in high water content part
+ & ZHLC_LCF3D,& ! HLCLOUDS cloud fraction in low water content part
+ & ZHLC_HRC3D,& ! HLCLOUDS cloud water content in high water content
+ & ZHLC_LRC3D,& ! HLCLOUDS cloud water content in low water content
+ & ZHLI_HCF3D,& ! HLCLOUDS cloud fraction in high ice content part
+ & ZHLI_LCF3D,& ! HLCLOUDS cloud fraction in low ice content part
+ & ZHLI_HRI3D,& ! HLCLOUDS cloud water content in high ice content
+ & ZHLI_LRI3D ! HLCLOUDS cloud water content in high ice content
+
REAL, DIMENSION(SIZE(PTHT,1),SIZE(PTHT,2)) :: ZINPRI ! Pristine ice instant precip
!
!Packed variables
-REAL, DIMENSION(COUNT(ODMICRO)) :: ZRVT, & ! Water vapor m.r. at t
- & ZRCT, & ! Cloud water m.r. at t
- & ZRRT, & ! Rain water m.r. at t
- & ZRIT, & ! Pristine ice m.r. at t
- & ZRST, & ! Snow/aggregate m.r. at t
- & ZRGT, & ! Graupel m.r. at t
- & ZRHT, & ! Hail m.r. at t
- & ZCIT, & ! Pristine ice conc. at t
- & ZTHT, & ! Potential temperature
- & ZRHODREF, & ! RHO Dry REFerence
- & ZZT, & ! Temperature
- & ZPRES, & ! Pressure
- & ZEXN, & ! EXNer Pressure
- & ZLSFACT, & ! L_s/(Pi*C_ph)
- & ZLVFACT, & ! L_v/(Pi*C_ph)
- & ZSIGMA_RC,& ! Standard deviation of rc at time t
- & ZCF, & ! Cloud fraction
- & ZHLC_HCF, & ! HLCLOUDS : fraction of High Cloud Fraction in grid
- & ZHLC_LCF, & ! HLCLOUDS : fraction of Low Cloud Fraction in grid
- ! note that ZCF = ZHLC_HCF + ZHLC_LCF
- & ZHLC_HRC, & ! HLCLOUDS : LWC that is High LWC in grid
- & ZHLC_LRC ! HLCLOUDS : LWC that is Low LWC in grid
- ! note that ZRC = ZHLC_HRC + ZHLC_LRC
+REAL, DIMENSION(KSIZE) :: ZRVT, & ! Water vapor m.r. at t
+ & ZRCT, & ! Cloud water m.r. at t
+ & ZRRT, & ! Rain water m.r. at t
+ & ZRIT, & ! Pristine ice m.r. at t
+ & ZRST, & ! Snow/aggregate m.r. at t
+ & ZRGT, & ! Graupel m.r. at t
+ & ZRHT, & ! Hail m.r. at t
+ & ZCIT, & ! Pristine ice conc. at t
+ & ZTHT, & ! Potential temperature
+ & ZRHODREF, & ! RHO Dry REFerence
+ & ZZT, & ! Temperature
+ & ZPRES, & ! Pressure
+ & ZEXN, & ! EXNer Pressure
+ & ZLSFACT, & ! L_s/(Pi*C_ph)
+ & ZLVFACT, & ! L_v/(Pi*C_ph)
+ & ZSIGMA_RC,& ! Standard deviation of rc at time t
+ & ZCF, & ! Cloud fraction
+ & ZHLC_HCF, & ! HLCLOUDS : fraction of High Cloud Fraction in grid
+ & ZHLC_LCF, & ! HLCLOUDS : fraction of Low Cloud Fraction in grid
+ ! note that ZCF = ZHLC_HCF + ZHLC_LCF
+ & ZHLC_HRC, & ! HLCLOUDS : LWC that is High LWC in grid
+ & ZHLC_LRC, & ! HLCLOUDS : LWC that is Low LWC in grid
+ ! note that ZRC = ZHLC_HRC + ZHLC_LRC
+ & ZHLI_HCF, &
+ & ZHLI_LCF, &
+ & ZHLI_HRI, &
+ & ZHLI_LRI, &
+ & ZFRAC
!
!Output packed tendencies (for budgets only)
-REAL, DIMENSION(COUNT(ODMICRO)) :: ZRVHENI_MR, & ! heterogeneous nucleation mixing ratio change
- & ZRCHONI, & ! Homogeneous nucleation
- & ZRRHONG_MR, & ! Spontaneous freezing mixing ratio change
- & ZRVDEPS, & ! Deposition on r_s,
- & ZRIAGGS, & ! Aggregation on r_s
- & ZRIAUTS, & ! Autoconversion of r_i for r_s production
- & ZRVDEPG, & ! Deposition on r_g
- & ZRCAUTR, & ! Autoconversion of r_c for r_r production
- & ZRCACCR, & ! Accretion of r_c for r_r production
- & ZRREVAV, & ! Evaporation of r_r
- & ZRIMLTC_MR, & ! Cloud ice melting mixing ratio change
- & ZRCBERI, & ! Bergeron-Findeisen effect
- & ZRHMLTR, & ! Melting of the hailstones
- & ZRSMLTG, & ! Conversion-Melting of the aggregates
- & ZRCMLTSR, & ! Cloud droplet collection onto aggregates by positive temperature
- & ZRRACCSS, ZRRACCSG, ZRSACCRG, & ! Rain accretion onto the aggregates
- & ZRCRIMSS, ZRCRIMSG, ZRSRIMCG, ZRSRIMCG_MR, & ! Cloud droplet riming of the aggregates
- & ZRICFRRG, ZRRCFRIG, ZRICFRR, & ! Rain contact freezing
- & ZRCWETG, ZRIWETG, ZRRWETG, ZRSWETG, & ! Graupel wet growth
- & ZRCDRYG, ZRIDRYG, ZRRDRYG, ZRSDRYG, & ! Graupel dry growth
- & ZRWETGH, & ! Conversion of graupel into hail
- & ZRWETGH_MR, & ! Conversion of graupel into hail, mr change
- & ZRGMLTR, & ! Melting of the graupel
- & ZRCWETH, ZRIWETH, ZRSWETH, ZRGWETH, ZRRWETH, & ! Dry growth of hailstone
- & ZRCDRYH, ZRIDRYH, ZRSDRYH, ZRRDRYH, ZRGDRYH, & ! Wet growth of hailstone
- & ZRDRYHG ! Conversion of hailstone into graupel
+REAL, DIMENSION(KSIZE) :: ZRVHENI_MR, & ! heterogeneous nucleation mixing ratio change
+ & ZRCHONI, & ! Homogeneous nucleation
+ & ZRRHONG_MR, & ! Spontaneous freezing mixing ratio change
+ & ZRVDEPS, & ! Deposition on r_s,
+ & ZRIAGGS, & ! Aggregation on r_s
+ & ZRIAUTS, & ! Autoconversion of r_i for r_s production
+ & ZRVDEPG, & ! Deposition on r_g
+ & ZRCAUTR, & ! Autoconversion of r_c for r_r production
+ & ZRCACCR, & ! Accretion of r_c for r_r production
+ & ZRREVAV, & ! Evaporation of r_r
+ & ZRIMLTC_MR, & ! Cloud ice melting mixing ratio change
+ & ZRCBERI, & ! Bergeron-Findeisen effect
+ & ZRHMLTR, & ! Melting of the hailstones
+ & ZRSMLTG, & ! Conversion-Melting of the aggregates
+ & ZRCMLTSR, & ! Cloud droplet collection onto aggregates by positive temperature
+ & ZRRACCSS, ZRRACCSG, ZRSACCRG, & ! Rain accretion onto the aggregates
+ & ZRCRIMSS, ZRCRIMSG, ZRSRIMCG, ZRSRIMCG_MR, & ! Cloud droplet riming of the aggregates
+ & ZRICFRRG, ZRRCFRIG, ZRICFRR, & ! Rain contact freezing
+ & ZRCWETG, ZRIWETG, ZRRWETG, ZRSWETG, & ! Graupel wet growth
+ & ZRCDRYG, ZRIDRYG, ZRRDRYG, ZRSDRYG, & ! Graupel dry growth
+ & ZRWETGH, & ! Conversion of graupel into hail
+ & ZRWETGH_MR, & ! Conversion of graupel into hail, mr change
+ & ZRGMLTR, & ! Melting of the graupel
+ & ZRCWETH, ZRIWETH, ZRSWETH, ZRGWETH, ZRRWETH, & ! Dry growth of hailstone
+ & ZRCDRYH, ZRIDRYH, ZRSDRYH, ZRRDRYH, ZRGDRYH, & ! Wet growth of hailstone
+ & ZRDRYHG ! Conversion of hailstone into graupel
!
!Output packed total mixing ratio change (for budgets only)
-REAL, DIMENSION(COUNT(ODMICRO)) :: ZTOT_RVHENI, & ! heterogeneous nucleation mixing ratio change
- & ZTOT_RCHONI, & ! Homogeneous nucleation
- & ZTOT_RRHONG, & ! Spontaneous freezing mixing ratio change
- & ZTOT_RVDEPS, & ! Deposition on r_s,
- & ZTOT_RIAGGS, & ! Aggregation on r_s
- & ZTOT_RIAUTS, & ! Autoconversion of r_i for r_s production
- & ZTOT_RVDEPG, & ! Deposition on r_g
- & ZTOT_RCAUTR, & ! Autoconversion of r_c for r_r production
- & ZTOT_RCACCR, & ! Accretion of r_c for r_r production
- & ZTOT_RREVAV, & ! Evaporation of r_r
- & ZTOT_RCRIMSS, ZTOT_RCRIMSG, ZTOT_RSRIMCG, & ! Cloud droplet riming of the aggregates
- & ZTOT_RIMLTC, & ! Cloud ice melting mixing ratio change
- & ZTOT_RCBERI, & ! Bergeron-Findeisen effect
- & ZTOT_RHMLTR, & ! Melting of the hailstones
- & ZTOT_RSMLTG, & ! Conversion-Melting of the aggregates
- & ZTOT_RCMLTSR, & ! Cloud droplet collection onto aggregates by positive temperature
- & ZTOT_RRACCSS, ZTOT_RRACCSG, ZTOT_RSACCRG, & ! Rain accretion onto the aggregates
- & ZTOT_RICFRRG, ZTOT_RRCFRIG, ZTOT_RICFRR, & ! Rain contact freezing
- & ZTOT_RCWETG, ZTOT_RIWETG, ZTOT_RRWETG, ZTOT_RSWETG, & ! Graupel wet growth
- & ZTOT_RCDRYG, ZTOT_RIDRYG, ZTOT_RRDRYG, ZTOT_RSDRYG, & ! Graupel dry growth
- & ZTOT_RWETGH, & ! Conversion of graupel into hail
- & ZTOT_RGMLTR, & ! Melting of the graupel
- & ZTOT_RCWETH, ZTOT_RIWETH, ZTOT_RSWETH, ZTOT_RGWETH, ZTOT_RRWETH, & ! Dry growth of hailstone
- & ZTOT_RCDRYH, ZTOT_RIDRYH, ZTOT_RSDRYH, ZTOT_RRDRYH, ZTOT_RGDRYH, & ! Wet growth of hailstone
- & ZTOT_RDRYHG ! Conversion of hailstone into graupel
+REAL, DIMENSION(KSIZE) :: ZTOT_RVHENI, & ! heterogeneous nucleation mixing ratio change
+ & ZTOT_RCHONI, & ! Homogeneous nucleation
+ & ZTOT_RRHONG, & ! Spontaneous freezing mixing ratio change
+ & ZTOT_RVDEPS, & ! Deposition on r_s,
+ & ZTOT_RIAGGS, & ! Aggregation on r_s
+ & ZTOT_RIAUTS, & ! Autoconversion of r_i for r_s production
+ & ZTOT_RVDEPG, & ! Deposition on r_g
+ & ZTOT_RCAUTR, & ! Autoconversion of r_c for r_r production
+ & ZTOT_RCACCR, & ! Accretion of r_c for r_r production
+ & ZTOT_RREVAV, & ! Evaporation of r_r
+ & ZTOT_RCRIMSS, ZTOT_RCRIMSG, ZTOT_RSRIMCG, & ! Cloud droplet riming of the aggregates
+ & ZTOT_RIMLTC, & ! Cloud ice melting mixing ratio change
+ & ZTOT_RCBERI, & ! Bergeron-Findeisen effect
+ & ZTOT_RHMLTR, & ! Melting of the hailstones
+ & ZTOT_RSMLTG, & ! Conversion-Melting of the aggregates
+ & ZTOT_RCMLTSR, & ! Cloud droplet collection onto aggregates by positive temperature
+ & ZTOT_RRACCSS, ZTOT_RRACCSG, ZTOT_RSACCRG, & ! Rain accretion onto the aggregates
+ & ZTOT_RICFRRG, ZTOT_RRCFRIG, ZTOT_RICFRR, & ! Rain contact freezing
+ & ZTOT_RCWETG, ZTOT_RIWETG, ZTOT_RRWETG, ZTOT_RSWETG, & ! Graupel wet growth
+ & ZTOT_RCDRYG, ZTOT_RIDRYG, ZTOT_RRDRYG, ZTOT_RSDRYG, & ! Graupel dry growth
+ & ZTOT_RWETGH, & ! Conversion of graupel into hail
+ & ZTOT_RGMLTR, & ! Melting of the graupel
+ & ZTOT_RCWETH, ZTOT_RIWETH, ZTOT_RSWETH, ZTOT_RGWETH, ZTOT_RRWETH, & ! Dry growth of hailstone
+ & ZTOT_RCDRYH, ZTOT_RIDRYH, ZTOT_RSDRYH, ZTOT_RRDRYH, ZTOT_RGDRYH, & ! Wet growth of hailstone
+ & ZTOT_RDRYHG ! Conversion of hailstone into graupel
!
!For time- or mixing-ratio- splitting
-REAL, DIMENSION(COUNT(ODMICRO)) :: Z0RVT, & ! Water vapor m.r. at the beginig of the current loop
- & Z0RCT, & ! Cloud water m.r. at the beginig of the current loop
- & Z0RRT, & ! Rain water m.r. at the beginig of the current loop
- & Z0RIT, & ! Pristine ice m.r. at the beginig of the current loop
- & Z0RST, & ! Snow/aggregate m.r. at the beginig of the current loop
- & Z0RGT, & ! Graupel m.r. at the beginig of the current loop
- & Z0RHT, & ! Hail m.r. at the beginig of the current loop
- & ZA_TH, ZA_RV, ZA_RC, ZA_RR, ZA_RI, ZA_RS, ZA_RG, ZA_RH, &
- & ZB_TH, ZB_RV, ZB_RC, ZB_RR, ZB_RI, ZB_RS, ZB_RG, ZB_RH
+REAL, DIMENSION(KSIZE) :: Z0RVT, & ! Water vapor m.r. at the beginig of the current loop
+ & Z0RCT, & ! Cloud water m.r. at the beginig of the current loop
+ & Z0RRT, & ! Rain water m.r. at the beginig of the current loop
+ & Z0RIT, & ! Pristine ice m.r. at the beginig of the current loop
+ & Z0RST, & ! Snow/aggregate m.r. at the beginig of the current loop
+ & Z0RGT, & ! Graupel m.r. at the beginig of the current loop
+ & Z0RHT, & ! Hail m.r. at the beginig of the current loop
+ & ZA_TH, ZA_RV, ZA_RC, ZA_RR, ZA_RI, ZA_RS, ZA_RG, ZA_RH, &
+ & ZB_TH, ZB_RV, ZB_RC, ZB_RR, ZB_RI, ZB_RS, ZB_RG, ZB_RH
!
!To take into acount external tendencies inside the splitting
-REAL, DIMENSION(COUNT(ODMICRO)) :: ZEXT_RV, & ! External tendencie for rv
- ZEXT_RC, & ! External tendencie for rc
- ZEXT_RR, & ! External tendencie for rr
- ZEXT_RI, & ! External tendencie for ri
- ZEXT_RS, & ! External tendencie for rs
- ZEXT_RG, & ! External tendencie for rg
- ZEXT_RH, & ! External tendencie for rh
- ZEXT_TH, & ! External tendencie for th
- ZEXT_WW ! Working array
+REAL, DIMENSION(KSIZE) :: ZEXT_RV, & ! External tendencie for rv
+ & ZEXT_RC, & ! External tendencie for rc
+ & ZEXT_RR, & ! External tendencie for rr
+ & ZEXT_RI, & ! External tendencie for ri
+ & ZEXT_RS, & ! External tendencie for rs
+ & ZEXT_RG, & ! External tendencie for rg
+ & ZEXT_RH, & ! External tendencie for rh
+ & ZEXT_TH, & ! External tendencie for th
+ & ZEXT_WW ! Working array
LOGICAL :: GEXT_TEND
!
-INTEGER, DIMENSION(COUNT(ODMICRO)) :: IITER ! Number of iterations done (with real tendencies computation)
+INTEGER, DIMENSION(KSIZE) :: IITER ! Number of iterations done (with real tendencies computation)
INTEGER :: INB_ITER_MAX ! Maximum number of iterations (with real tendencies computation)
-REAL, DIMENSION(COUNT(ODMICRO)) :: ZTIME, & ! Current integration time (starts with 0 and ends with PTSTEP)
- & ZMAXTIME, & ! Time on which we can apply the current tendencies
- & ZTIME_THRESHOLD, & ! Time to reach threshold
- & ZTIME_LASTCALL ! Integration time when last tendecies call has been done
-LOGICAL, DIMENSION(COUNT(ODMICRO)) :: LLCOMPUTE ! Points where we must compute tendenceis
+REAL, DIMENSION(KSIZE) :: ZTIME, & ! Current integration time (starts with 0 and ends with PTSTEP)
+ & ZMAXTIME, & ! Time on which we can apply the current tendencies
+ & ZTIME_THRESHOLD, & ! Time to reach threshold
+ & ZTIME_LASTCALL ! Integration time when last tendecies call has been done
+REAL, DIMENSION(KSIZE) :: ZW1D
+REAL, DIMENSION(KSIZE) :: ZCOMPUTE ! 1. for points where we must compute tendencies, 0. elsewhere
LOGICAL :: LSOFT ! Must we really compute tendencies or only adjust them to new T variables
LOGICAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2)):: GDEP
REAL :: ZTSTEP ! length of sub-timestep in case of time splitting
REAL :: ZINV_TSTEP ! Inverse ov PTSTEP
-REAL, DIMENSION(COUNT(ODMICRO), 6) :: ZRS_TEND
-REAL, DIMENSION(COUNT(ODMICRO), 6) :: ZRG_TEND
-REAL, DIMENSION(COUNT(ODMICRO), 8) :: ZRH_TEND
+REAL, DIMENSION(KSIZE, 8) :: ZRS_TEND
+REAL, DIMENSION(KSIZE, 8) :: ZRG_TEND
+REAL, DIMENSION(KSIZE, 10) :: ZRH_TEND
+REAL, DIMENSION(KSIZE) :: ZSSI
!
!For total tendencies computation
REAL, DIMENSION(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)) :: &
@@ -498,33 +533,43 @@ end if
! -----------------------
!
CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
-IIT=SIZE(PDZZ,1)
-IJT=SIZE(PDZZ,2)
IKB=KKA+JPVEXT*KKL
IKE=KKU-JPVEXT*KKL
-IKT=SIZE(PDZZ,3)
IKTB=1+JPVEXT
-IKTE=IKT-JPVEXT
+IKTE=KKT-JPVEXT
!
ZINV_TSTEP=1./PTSTEP
GEXT_TEND=.TRUE.
!
-ZT(:,:,:) = PTHT(:,:,:) * PEXN(:,:,:)
! LSFACT and LVFACT without exner
IF(KRR==7) THEN
- ZZ_LSFACT(:,:,:)=(XLSTT+(XCPV-XCI)*(ZT(:,:,:)-XTT)) &
- /( XCPD + XCPV*PRVT(:,:,:) + XCL*(PRCT(:,:,:)+PRRT(:,:,:)) &
- + XCI*(PRIT(:,:,:)+PRST(:,:,:)+PRGT(:,:,:)+PRHT(:,:,:)))
- ZZ_LVFACT(:,:,:)=(XLVTT+(XCPV-XCL)*(ZT(:,:,:)-XTT)) &
- /( XCPD + XCPV*PRVT(:,:,:) + XCL*(PRCT(:,:,:)+PRRT(:,:,:)) &
- + XCI*(PRIT(:,:,:)+PRST(:,:,:)+PRGT(:,:,:)+PRHT(:,:,:)))
+ DO JK = 1, KKT
+ DO JJ = 1, KJT
+ DO JI = 1, KIT
+ ZT(JI,JJ,JK) = PTHT(JI,JJ,JK) * PEXN(JI,JJ,JK)
+ ZZ_LSFACT(JI,JJ,JK)=(XLSTT+(XCPV-XCI)*(ZT(JI,JJ,JK)-XTT)) &
+ /( XCPD + XCPV*PRVT(JI,JJ,JK) + XCL*(PRCT(JI,JJ,JK)+PRRT(JI,JJ,JK)) &
+ + XCI*(PRIT(JI,JJ,JK)+PRST(JI,JJ,JK)+PRGT(JI,JJ,JK)+PRHT(JI,JJ,JK)))
+ ZZ_LVFACT(JI,JJ,JK)=(XLVTT+(XCPV-XCL)*(ZT(JI,JJ,JK)-XTT)) &
+ /( XCPD + XCPV*PRVT(JI,JJ,JK) + XCL*(PRCT(JI,JJ,JK)+PRRT(JI,JJ,JK)) &
+ + XCI*(PRIT(JI,JJ,JK)+PRST(JI,JJ,JK)+PRGT(JI,JJ,JK)+PRHT(JI,JJ,JK)))
+ ENDDO
+ ENDDO
+ ENDDO
ELSE
- ZZ_LSFACT(:,:,:)=(XLSTT+(XCPV-XCI)*(ZT(:,:,:)-XTT)) &
- /( XCPD + XCPV*PRVT(:,:,:) + XCL*(PRCT(:,:,:)+PRRT(:,:,:)) &
- + XCI*(PRIT(:,:,:)+PRST(:,:,:)+PRGT(:,:,:)))
- ZZ_LVFACT(:,:,:)=(XLVTT+(XCPV-XCL)*(ZT(:,:,:)-XTT)) &
- /( XCPD + XCPV*PRVT(:,:,:) + XCL*(PRCT(:,:,:)+PRRT(:,:,:)) &
- + XCI*(PRIT(:,:,:)+PRST(:,:,:)+PRGT(:,:,:)))
+ DO JK = 1, KKT
+ DO JJ = 1, KJT
+ DO JI = 1, KIT
+ ZT(JI,JJ,JK) = PTHT(JI,JJ,JK) * PEXN(JI,JJ,JK)
+ ZZ_LSFACT(JI,JJ,JK)=(XLSTT+(XCPV-XCI)*(ZT(JI,JJ,JK)-XTT)) &
+ /( XCPD + XCPV*PRVT(JI,JJ,JK) + XCL*(PRCT(JI,JJ,JK)+PRRT(JI,JJ,JK)) &
+ + XCI*(PRIT(JI,JJ,JK)+PRST(JI,JJ,JK)+PRGT(JI,JJ,JK)))
+ ZZ_LVFACT(JI,JJ,JK)=(XLVTT+(XCPV-XCL)*(ZT(JI,JJ,JK)-XTT)) &
+ /( XCPD + XCPV*PRVT(JI,JJ,JK) + XCL*(PRCT(JI,JJ,JK)+PRRT(JI,JJ,JK)) &
+ + XCI*(PRIT(JI,JJ,JK)+PRST(JI,JJ,JK)+PRGT(JI,JJ,JK)))
+ ENDDO
+ ENDDO
+ ENDDO
ENDIF
!
!-------------------------------------------------------------------------------
@@ -552,22 +597,22 @@ IF(.NOT. LSEDIM_AFTER) THEN
IF(HSEDIM=='STAT') THEN
!SR: It *seems* that we must have two separate calls for ifort
IF(KRR==7) THEN
- CALL ICE4_SEDIMENTATION_STAT(IIB, IIE, IIT, IJB, IJE, IJT, IKB, IKE, IKTB, IKTE, IKT, KKL, &
+ CALL ICE4_SEDIMENTATION_STAT(IIB, IIE, KIT, IJB, IJE, KJT, IKB, IKE, IKTB, IKTE, KKT, KKL, &
&PTSTEP, KRR, OSEDIC, LDEPOSC, XVDEPOSC, PDZZ, &
&PRHODREF, PPABST, PTHT, PRHODJ, &
&PRCS, PRCS*PTSTEP, PRRS, PRRS*PTSTEP, PRIS, PRIS*PTSTEP,&
&PRSS, PRSS*PTSTEP, PRGS, PRGS*PTSTEP,&
&PINPRC, PINDEP, PINPRR, ZINPRI, PINPRS, PINPRG, &
- &PSEA, PTOWN, &
+ &PSEA=PSEA, PTOWN=PTOWN, &
&PINPRH=PINPRH, PRHT=PRHS*PTSTEP, PRHS=PRHS, PFPR=PFPR)
ELSE
- CALL ICE4_SEDIMENTATION_STAT(IIB, IIE, IIT, IJB, IJE, IJT, IKB, IKE, IKTB, IKTE, IKT, KKL, &
- &PTSTEP, KRR, OSEDIC, LDEPOSC, XVDEPOSC, PDZZ, &
+ CALL ICE4_SEDIMENTATION_STAT(IIB, IIE, KIT, IJB, IJE, KJT, IKB, IKE, IKTB, IKTE, KKT, KKL, &
+ &PTSTEP, KRR, OSEDIC, LDEPOSC, XVDEPOSC, PDZZ, &
&PRHODREF, PPABST, PTHT, PRHODJ, &
&PRCS, PRCS*PTSTEP, PRRS, PRRS*PTSTEP, PRIS, PRIS*PTSTEP,&
&PRSS, PRSS*PTSTEP, PRGS, PRGS*PTSTEP,&
&PINPRC, PINDEP, PINPRR, ZINPRI, PINPRS, PINPRG, &
- &PSEA, PTOWN, &
+ &PSEA=PSEA, PTOWN=PTOWN, &
&PFPR=PFPR)
ENDIF
PINPRS(:,:) = PINPRS(:,:) + ZINPRI(:,:)
@@ -575,20 +620,20 @@ IF(.NOT. LSEDIM_AFTER) THEN
ELSEIF(HSEDIM=='SPLI') THEN
!SR: It *seems* that we must have two separate calls for ifort
IF(KRR==7) THEN
- CALL ICE4_SEDIMENTATION_SPLIT(IIB, IIE, IIT, IJB, IJE, IJT, IKB, IKE, IKTB, IKTE, IKT, KKL, &
- &PTSTEP, KRR, OSEDIC, LDEPOSC,XVDEPOSC, PDZZ, &
+ CALL ICE4_SEDIMENTATION_SPLIT(IIB, IIE, KIT, IJB, IJE, KJT, IKB, IKE, IKTB, IKTE, KKT, KKL, &
+ &PTSTEP, KRR, OSEDIC, LDEPOSC, XVDEPOSC, PDZZ, &
&PRHODREF, PPABST, PTHT, PRHODJ, &
&PRCS, PRCT, PRRS, PRRT, PRIS, PRIT, PRSS, PRST, PRGS, PRGT,&
&PINPRC, PINDEP, PINPRR, ZINPRI, PINPRS, PINPRG, &
- &PSEA, PTOWN, &
+ &PSEA=PSEA, PTOWN=PTOWN, &
&PINPRH=PINPRH, PRHT=PRHT, PRHS=PRHS, PFPR=PFPR)
ELSE
- CALL ICE4_SEDIMENTATION_SPLIT(IIB, IIE, IIT, IJB, IJE, IJT, IKB, IKE, IKTB, IKTE, IKT, KKL, &
- &PTSTEP, KRR, OSEDIC, LDEPOSC,XVDEPOSC, PDZZ, &
+ CALL ICE4_SEDIMENTATION_SPLIT(IIB, IIE, KIT, IJB, IJE, KJT, IKB, IKE, IKTB, IKTE, KKT, KKL, &
+ &PTSTEP, KRR, OSEDIC, LDEPOSC, XVDEPOSC, PDZZ, &
&PRHODREF, PPABST, PTHT, PRHODJ, &
&PRCS, PRCT, PRRS, PRRT, PRIS, PRIT, PRSS, PRST, PRGS, PRGT,&
&PINPRC, PINDEP, PINPRR, ZINPRI, PINPRS, PINPRG, &
- &PSEA, PTOWN, &
+ &PSEA=PSEA, PTOWN=PTOWN, &
&PFPR=PFPR)
ENDIF
PINPRS(:,:) = PINPRS(:,:) + ZINPRI(:,:)
@@ -602,9 +647,10 @@ IF(.NOT. LSEDIM_AFTER) THEN
! will be still active and will lead to negative values.
! We could prevent the algorithm to not consume too much a specie, instead we apply
! a correction here.
- CALL CORRECT_NEGATIVITIES(KRR, PRVS, PRCS, PRRS, &
+ CALL CORRECT_NEGATIVITIES(KIT, KJT, KKT, KRR, PRVS, PRCS, PRRS, &
&PRIS, PRSS, PRGS, &
&PTHS, ZZ_LVFACT, ZZ_LSFACT, PRHS)
+ ELSEIF(HSEDIM=='NONE') THEN
ELSE
call Print_msg( NVERB_FATAL, 'GEN', 'RAIN_ICE_RED', 'no sedimentation scheme for HSEDIM='//HSEDIM )
END IF
@@ -631,8 +677,8 @@ ENDIF
! optimization by looking for locations where
! the microphysical fields are larger than a minimal value only !!!
!
-! IMICRO=0
-IMICRO=COUNTJV(ODMICRO(:,:,:), I1(:), I2(:), I3(:))
+!IMICRO=0
+IF(KSIZE/=0) IMICRO=COUNTJV(ODMICRO(:,:,:), I1(:), I2(:), I3(:))
!Packing
IF(IMICRO>0) THEN
DO JL=1, IMICRO
@@ -648,6 +694,22 @@ IF(IMICRO>0) THEN
ZTHT(JL) = PTHT(I1(JL),I2(JL),I3(JL))
ZPRES(JL) = PPABST(I1(JL),I2(JL),I3(JL))
ZEXN(JL) = PEXN(I1(JL),I2(JL),I3(JL))
+ ZHLC_HCF(JL) = PHLC_HCF(I1(JL),I2(JL),I3(JL))
+ ZHLC_HRC(JL) = PHLC_HRC(I1(JL),I2(JL),I3(JL))
+ ZHLC_LRC(JL) = ZRCT(JL) - ZHLC_HRC(JL)
+ ZHLI_HCF(JL) = PHLI_HCF(I1(JL),I2(JL),I3(JL))
+ ZHLI_HRI(JL) = PHLI_HRI(I1(JL),I2(JL),I3(JL))
+ ZHLI_LRI(JL) = ZRIT(JL) - ZHLI_HRI(JL)
+ IF(ZRCT(JL)>0.) THEN
+ ZHLC_LCF(JL) = ZCF(JL)- ZHLC_HCF(JL)
+ ELSE
+ ZHLC_LCF(JL)=0.
+ ENDIF
+ IF(ZRIT(JL)>0.) THEN
+ ZHLI_LCF(JL) = ZCF(JL)- ZHLI_HCF(JL)
+ ELSE
+ ZHLI_LCF(JL)=0.
+ ENDIF
ENDDO
IF(GEXT_TEND) THEN
DO JL=1, IMICRO
@@ -664,7 +726,6 @@ IF(IMICRO>0) THEN
IF(HSUBG_AUCV_RC=='PDF ' .AND. CSUBG_PR_PDF=='SIGM') THEN
DO JL=1, IMICRO
ZSIGMA_RC(JL) = PSIGS(I1(JL),I2(JL),I3(JL))*2.
-! ZSIGMA_RC(JL) = MAX(PSIGS(I1(JL),I2(JL),I3(JL)) * 2., 1.E-12)
ENDDO
ENDIF
IF(KRR==7) THEN
@@ -747,53 +808,59 @@ DO WHILE(ANY(ZTIME(:)<PTSTEP)) ! Loop to *really* compute tendencies
IF(XMRSTEP/=0.) THEN
! In this case we need to remember the mixing ratios used to compute the tendencies
! because when mixing ratio has evolved more than a threshold, we must re-compute tendecies
- Z0RVT(:)=ZRVT(:)
- Z0RCT(:)=ZRCT(:)
- Z0RRT(:)=ZRRT(:)
- Z0RIT(:)=ZRIT(:)
- Z0RST(:)=ZRST(:)
- Z0RGT(:)=ZRGT(:)
- Z0RHT(:)=ZRHT(:)
+ DO JL=1, IMICRO
+ Z0RVT(JL)=ZRVT(JL)
+ Z0RCT(JL)=ZRCT(JL)
+ Z0RRT(JL)=ZRRT(JL)
+ Z0RIT(JL)=ZRIT(JL)
+ Z0RST(JL)=ZRST(JL)
+ Z0RGT(JL)=ZRGT(JL)
+ Z0RHT(JL)=ZRHT(JL)
+ ENDDO
ENDIF
IF(XTSTEP_TS/=0.) THEN
! In this case we need to remember the time when tendencies were computed
! because when time has evolved more than a limit, we must re-compute tendecies
ZTIME_LASTCALL(:)=ZTIME(:)
ENDIF
- LLCOMPUTE(:)=ZTIME(:)<PTSTEP ! Compuation only for points for which integration time has not reached the timestep
+ ZCOMPUTE(:)=MAX(0., -SIGN(1., ZTIME(:)-PTSTEP)) ! Compuation (1.) only for points for which integration time has not reached the timestep
LSOFT=.FALSE. ! We *really* compute the tendencies
- WHERE(LLCOMPUTE(:))
- IITER(:)=IITER(:)+1
- END WHERE
- DO WHILE(ANY(LLCOMPUTE(:))) ! Loop to adjust tendencies when we cross the 0°C or when a specie disappears
- ZZT(:) = ZTHT(:) * ZEXN(:)
+ IITER(:)=IITER(:)+INT(ZCOMPUTE(:))
+ DO WHILE(SUM(ZCOMPUTE(:))>0.) ! Loop to adjust tendencies when we cross the 0°C or when a specie disappears
IF(KRR==7) THEN
- ZLSFACT(:)=(XLSTT+(XCPV-XCI)*(ZZT(:)-XTT)) &
- /( (XCPD + XCPV*ZRVT(:) + XCL*(ZRCT(:)+ZRRT(:)) &
- + XCI*(ZRIT(:)+ZRST(:)+ZRGT(:)+ZRHT(:)))*ZEXN(:) )
- ZLVFACT(:)=(XLVTT+(XCPV-XCL)*(ZZT(:)-XTT)) &
- /( (XCPD + XCPV*ZRVT(:) + XCL*(ZRCT(:)+ZRRT(:)) &
- + XCI*(ZRIT(:)+ZRST(:)+ZRGT(:)+ZRHT(:)))*ZEXN(:) )
+ DO JL=1, IMICRO
+ ZZT(JL) = ZTHT(JL) * ZEXN(JL)
+ ZLSFACT(JL)=(XLSTT+(XCPV-XCI)*(ZZT(JL)-XTT)) &
+ &/( (XCPD + XCPV*ZRVT(JL) + XCL*(ZRCT(JL)+ZRRT(JL)) &
+ &+ XCI*(ZRIT(JL)+ZRST(JL)+ZRGT(JL)+ZRHT(JL)))*ZEXN(JL) )
+ ZLVFACT(JL)=(XLVTT+(XCPV-XCL)*(ZZT(JL)-XTT)) &
+ &/( (XCPD + XCPV*ZRVT(JL) + XCL*(ZRCT(JL)+ZRRT(JL)) &
+ &+ XCI*(ZRIT(JL)+ZRST(JL)+ZRGT(JL)+ZRHT(JL)))*ZEXN(JL) )
+ ENDDO
ELSE
- ZLSFACT(:)=(XLSTT+(XCPV-XCI)*(ZZT(:)-XTT)) &
- /( (XCPD + XCPV*ZRVT(:) + XCL*(ZRCT(:)+ZRRT(:)) &
- + XCI*(ZRIT(:)+ZRST(:)+ZRGT(:)))*ZEXN(:) )
- ZLVFACT(:)=(XLVTT+(XCPV-XCL)*(ZZT(:)-XTT)) &
- /( (XCPD + XCPV*ZRVT(:) + XCL*(ZRCT(:)+ZRRT(:)) &
- + XCI*(ZRIT(:)+ZRST(:)+ZRGT(:)))*ZEXN(:) )
+ DO JL=1, IMICRO
+ ZZT(JL) = ZTHT(JL) * ZEXN(JL)
+ ZLSFACT(JL)=(XLSTT+(XCPV-XCI)*(ZZT(JL)-XTT)) &
+ &/( (XCPD + XCPV*ZRVT(JL) + XCL*(ZRCT(JL)+ZRRT(JL)) &
+ &+ XCI*(ZRIT(JL)+ZRST(JL)+ZRGT(JL)))*ZEXN(JL) )
+ ZLVFACT(JL)=(XLVTT+(XCPV-XCL)*(ZZT(JL)-XTT)) &
+ &/( (XCPD + XCPV*ZRVT(JL) + XCL*(ZRCT(JL)+ZRRT(JL)) &
+ &+ XCI*(ZRIT(JL)+ZRST(JL)+ZRGT(JL)))*ZEXN(JL) )
+ ENDDO
ENDIF
!
!*** 4.1 Tendecies computation
!
! Tendencies are *really* computed when LSOFT==.FALSE. and only adjusted otherwise
- CALL ICE4_TENDENCIES(IMICRO, IIB, IIE, IIT, IJB, IJE, IJT, IKB, IKE, IKT, KKL, &
- &KRR, LSOFT, LLCOMPUTE, &
- &OWARM, CSUBG_RC_RR_ACCR, CSUBG_RR_EVAP, HSUBG_AUCV_RC, CSUBG_PR_PDF, &
+ CALL ICE4_TENDENCIES(IMICRO, IIB, IIE, KIT, IJB, IJE, KJT, IKB, IKE, KKT, KKL, &
+ &KRR, LSOFT, ZCOMPUTE, &
+ &OWARM, CSUBG_RC_RR_ACCR, CSUBG_RR_EVAP, &
+ &HSUBG_AUCV_RC, HSUBG_AUCV_RI, CSUBG_PR_PDF, &
&ZEXN, ZRHODREF, ZLVFACT, ZLSFACT, I1, I2, I3, &
- &ZPRES, ZCF, ZSIGMA_RC, &
+ &ZPRES, ZCF, ZSIGMA_RC,&
&ZCIT, &
&ZZT, ZTHT, &
- &ZRVT, ZRCT, ZRRT, ZRIT, ZRST, ZRGT, ZRHT, PRRT, &
+ &ZRVT, ZRCT, ZRRT, ZRIT, ZRST, ZRGT, ZRHT, &
&ZRVHENI_MR, ZRRHONG_MR, ZRIMLTC_MR, ZRSRIMCG_MR, &
&ZRCHONI, ZRVDEPS, ZRIAGGS, ZRIAUTS, ZRVDEPG, &
&ZRCAUTR, ZRCACCR, ZRREVAV, &
@@ -803,181 +870,229 @@ DO WHILE(ANY(ZTIME(:)<PTSTEP)) ! Loop to *really* compute tendencies
&ZRCWETH, ZRIWETH, ZRSWETH, ZRGWETH, ZRRWETH, &
&ZRCDRYH, ZRIDRYH, ZRSDRYH, ZRRDRYH, ZRGDRYH, ZRDRYHG, ZRHMLTR, &
&ZRCBERI, &
- &ZRS_TEND, ZRG_TEND, ZRH_TEND, &
+ &ZRS_TEND, ZRG_TEND, ZRH_TEND, ZSSI, &
&ZA_TH, ZA_RV, ZA_RC, ZA_RR, ZA_RI, ZA_RS, ZA_RG, ZA_RH, &
&ZB_TH, ZB_RV, ZB_RC, ZB_RR, ZB_RI, ZB_RS, ZB_RG, ZB_RH, &
- &ZHLC_HCF, ZHLC_LCF, ZHLC_HRC, ZHLC_LRC, PRAINFR)
+ &ZHLC_HCF, ZHLC_LCF, ZHLC_HRC, ZHLC_LRC, &
+ &ZHLI_HCF, ZHLI_LCF, ZHLI_HRI, ZHLI_LRI, PRAINFR)
! External tendencies
IF(GEXT_TEND) THEN
- ZA_TH(:) = ZA_TH(:) + ZEXT_TH(:)
- ZA_RV(:) = ZA_RV(:) + ZEXT_RV(:)
- ZA_RC(:) = ZA_RC(:) + ZEXT_RC(:)
- ZA_RR(:) = ZA_RR(:) + ZEXT_RR(:)
- ZA_RI(:) = ZA_RI(:) + ZEXT_RI(:)
- ZA_RS(:) = ZA_RS(:) + ZEXT_RS(:)
- ZA_RG(:) = ZA_RG(:) + ZEXT_RG(:)
- ZA_RH(:) = ZA_RH(:) + ZEXT_RH(:)
+ DO JL=1, IMICRO
+ ZA_TH(JL) = ZA_TH(JL) + ZEXT_TH(JL)
+ ZA_RV(JL) = ZA_RV(JL) + ZEXT_RV(JL)
+ ZA_RC(JL) = ZA_RC(JL) + ZEXT_RC(JL)
+ ZA_RR(JL) = ZA_RR(JL) + ZEXT_RR(JL)
+ ZA_RI(JL) = ZA_RI(JL) + ZEXT_RI(JL)
+ ZA_RS(JL) = ZA_RS(JL) + ZEXT_RS(JL)
+ ZA_RG(JL) = ZA_RG(JL) + ZEXT_RG(JL)
+ ZA_RH(JL) = ZA_RH(JL) + ZEXT_RH(JL)
+ ENDDO
ENDIF
!
!*** 4.2 Integration time
!
- ! If we can, we will use these tendecies until the end of the timestep
- ZMAXTIME(:)=0.
- WHERE(LLCOMPUTE(:))
- ZMAXTIME(:)=PTSTEP-ZTIME(:) ! Remaining time until the end of the timestep
- ENDWHERE
+ ! If we can, we will use these tendencies until the end of the timestep
+ ZMAXTIME(:)=ZCOMPUTE(:) * (PTSTEP-ZTIME(:)) ! Remaining time until the end of the timestep
!We need to adjust tendencies when temperature reaches 0
IF(LFEEDBACKT) THEN
- !Is ZB_TH enough to change temperature sign?
- WHERE( (ZTHT(:) - XTT/ZEXN(:)) * (ZTHT(:) + ZB_TH(:) - XTT/ZEXN(:)) < 0. )
- ZMAXTIME(:)=0.
- ENDWHERE
- !Can ZA_TH make temperature change of sign?
- ZTIME_THRESHOLD(:)=-1.
- WHERE(ABS(ZA_TH(:))>1.E-20)
- ZTIME_THRESHOLD(:)=(XTT/ZEXN(:) - ZB_TH(:) - ZTHT(:))/ZA_TH(:)
- ENDWHERE
- WHERE(ZTIME_THRESHOLD(:)>0.)
- ZMAXTIME(:)=MIN(ZMAXTIME(:), ZTIME_THRESHOLD(:))
- ENDWHERE
+ DO JL=1, IMICRO
+ !Is ZB_TH enough to change temperature sign?
+ ZW1D(JL)=(ZTHT(JL) - XTT/ZEXN(JL)) * (ZTHT(JL) + ZB_TH(JL) - XTT/ZEXN(JL))
+ ZMAXTIME(JL)=ZMAXTIME(JL)*MAX(0., SIGN(1., ZW1D(JL)))
+ !Can ZA_TH make temperature change of sign?
+ ZW1D(JL)=MAX(0., -SIGN(1., 1.E-20 - ABS(ZA_TH(JL)))) ! WHERE(ABS(ZA_TH(:))>1.E-20)
+ ZTIME_THRESHOLD(JL)=(1. - ZW1D(JL))*(-1.) + &
+ ZW1D(JL) * &
+ (XTT/ZEXN(JL) - ZB_TH(JL) - ZTHT(JL))/ &
+ SIGN(MAX(ABS(ZA_TH(JL)), 1.E-20), ZA_TH(JL))
+ ZW1D(JL)=MAX(0., -SIGN(1., 1.E-20 - ZTIME_THRESHOLD(JL))) ! WHERE(ZTIME_THRESHOLD(:)>1.E-20)
+ ZMAXTIME(JL)=(1.-ZW1D(JL)) * ZMAXTIME(JL) + &
+ ZW1D(JL) * MIN(ZMAXTIME(JL), ZTIME_THRESHOLD(JL))
+ ENDDO
ENDIF
!We need to adjust tendencies when a specy disappears
!When a species is missing, only the external tendencies can be negative (and we must keep track of it)
- WHERE(ZA_RV(:)<-1.E-20 .AND. ZRVT(:)>XRTMIN(1))
- ZMAXTIME(:)=MIN(ZMAXTIME(:), -(ZB_RV(:)+ZRVT(:))/ZA_RV(:))
- END WHERE
- WHERE(ZA_RC(:)<-1.E-20 .AND. ZRCT(:)>XRTMIN(2))
- ZMAXTIME(:)=MIN(ZMAXTIME(:), -(ZB_RC(:)+ZRCT(:))/ZA_RC(:))
- END WHERE
- WHERE(ZA_RR(:)<-1.E-20 .AND. ZRRT(:)>XRTMIN(3))
- ZMAXTIME(:)=MIN(ZMAXTIME(:), -(ZB_RR(:)+ZRRT(:))/ZA_RR(:))
- END WHERE
- WHERE(ZA_RI(:)<-1.E-20 .AND. ZRIT(:)>XRTMIN(4))
- ZMAXTIME(:)=MIN(ZMAXTIME(:), -(ZB_RI(:)+ZRIT(:))/ZA_RI(:))
- END WHERE
- WHERE(ZA_RS(:)<-1.E-20 .AND. ZRST(:)>XRTMIN(5))
- ZMAXTIME(:)=MIN(ZMAXTIME(:), -(ZB_RS(:)+ZRST(:))/ZA_RS(:))
- END WHERE
- WHERE(ZA_RG(:)<-1.E-20 .AND. ZRGT(:)>XRTMIN(6))
- ZMAXTIME(:)=MIN(ZMAXTIME(:), -(ZB_RG(:)+ZRGT(:))/ZA_RG(:))
- END WHERE
+ DO JL=1, IMICRO
+ ZW1D(JL)=MAX(0., -SIGN(1., ZA_RV(JL)+1.E-20)) * & ! WHERE(ZA_RV(:)<-1.E-20)
+ &MAX(0., -SIGN(1., XRTMIN(1)-ZRVT(JL))) ! WHERE(ZRVT(:)>XRTMIN(1))
+ ZMAXTIME(JL)=(1.-ZW1D(JL)) * ZMAXTIME(JL) + &
+ &ZW1D(JL) * MIN(ZMAXTIME(JL), -(ZB_RV(JL)+ZRVT(JL))/MIN(ZA_RV(JL), -1.E-20))
+
+ ZW1D(JL)=MAX(0., -SIGN(1., ZA_RC(JL)+1.E-20)) * & ! WHERE(ZA_RC(:)<-1.E-20)
+ &MAX(0., -SIGN(1., XRTMIN(2)-ZRCT(JL))) ! WHERE(ZRCT(:)>XRTMIN(2))
+ ZMAXTIME(JL)=(1.-ZW1D(JL)) * ZMAXTIME(JL) + &
+ &ZW1D(JL) * MIN(ZMAXTIME(JL), -(ZB_RC(JL)+ZRCT(JL))/MIN(ZA_RC(JL), -1.E-20))
+
+ ZW1D(JL)=MAX(0., -SIGN(1., ZA_RR(JL)+1.E-20)) * & ! WHERE(ZA_RR(:)<-1.E-20)
+ &MAX(0., -SIGN(1., XRTMIN(3)-ZRRT(JL))) ! WHERE(ZRRT(:)>XRTMIN(3))
+ ZMAXTIME(JL)=(1.-ZW1D(JL)) * ZMAXTIME(JL) + &
+ &ZW1D(JL) * MIN(ZMAXTIME(JL), -(ZB_RR(JL)+ZRRT(JL))/MIN(ZA_RR(JL), -1.E-20))
+
+ ZW1D(JL)=MAX(0., -SIGN(1., ZA_RI(JL)+1.E-20)) * & ! WHERE(ZI_RV(:)<-1.E-20)
+ &MAX(0., -SIGN(1., XRTMIN(4)-ZRIT(JL))) ! WHERE(ZRIT(:)>XRTMIN(4))
+ ZMAXTIME(JL)=(1.-ZW1D(JL)) * ZMAXTIME(JL) + &
+ &ZW1D(JL) * MIN(ZMAXTIME(JL), -(ZB_RI(JL)+ZRIT(JL))/MIN(ZA_RI(JL), -1.E-20))
+
+ ZW1D(JL)=MAX(0., -SIGN(1., ZA_RS(JL)+1.E-20)) * & ! WHERE(ZA_RS(:)<-1.E-20)
+ &MAX(0., -SIGN(1., XRTMIN(5)-ZRST(JL))) ! WHERE(ZRST(:)>XRTMIN(5))
+ ZMAXTIME(JL)=(1.-ZW1D(JL)) * ZMAXTIME(JL) + &
+ &ZW1D(JL) * MIN(ZMAXTIME(JL), -(ZB_RS(JL)+ZRST(JL))/MIN(ZA_RS(JL), -1.E-20))
+
+ ZW1D(JL)=MAX(0., -SIGN(1., ZA_RG(JL)+1.E-20)) * & ! WHERE(ZA_RG(:)<-1.E-20)
+ &MAX(0., -SIGN(1., XRTMIN(6)-ZRGT(JL))) ! WHERE(ZRGT(:)>XRTMIN(6))
+ ZMAXTIME(JL)=(1.-ZW1D(JL)) * ZMAXTIME(JL) + &
+ &ZW1D(JL) * MIN(ZMAXTIME(JL), -(ZB_RG(JL)+ZRGT(JL))/MIN(ZA_RG(JL), -1.E-20))
+ ENDDO
+
IF(KRR==7) THEN
- WHERE(ZA_RH(:)<-1.E-20 .AND. ZRHT(:)>XRTMIN(7))
- ZMAXTIME(:)=MIN(ZMAXTIME(:), -(ZB_RH(:)+ZRHT(:))/ZA_RH(:))
- END WHERE
+ DO JL=1, IMICRO
+ ZW1D(JL)=MAX(0., -SIGN(1., ZA_RH(JL)+1.E-20)) * & ! WHERE(ZA_RH(:)<-1.E-20)
+ &MAX(0., -SIGN(1., XRTMIN(7)-ZRHT(JL))) ! WHERE(ZRHT(:)>XRTMIN(7))
+ ZMAXTIME(JL)=(1.-ZW1D(JL)) * ZMAXTIME(JL) + &
+ &ZW1D(JL) * MIN(ZMAXTIME(JL), -(ZB_RH(JL)+ZRHT(JL))/MIN(ZA_RH(JL), -1.E-20))
+ ENDDO
ENDIF
!We stop when the end of the timestep is reached
- WHERE(PTSTEP-ZTIME(:)-ZMAXTIME(:)<=0.)
- LLCOMPUTE(:)=.FALSE.
- ENDWHERE
+ ZCOMPUTE(:)=ZCOMPUTE(:) * MAX(0., -SIGN(1., ZTIME(:)+ZMAXTIME(:)-PTSTEP))
!We must recompute tendencies when the end of the sub-timestep is reached
IF(XTSTEP_TS/=0.) THEN
- WHERE(IITER(:)<INB_ITER_MAX .AND. ZTIME(:)+ZMAXTIME(:)>ZTIME_LASTCALL(:)+ZTSTEP)
- ZMAXTIME(:)=ZTIME_LASTCALL(:)-ZTIME(:)+ZTSTEP
- LLCOMPUTE(:)=.FALSE.
- ENDWHERE
+ DO JL=1, IMICRO
+ ZW1D(JL)=MAX(0., -SIGN(1., IITER(JL)-INB_ITER_MAX+0.)) * & ! WHERE(IITER(:)<INB_ITER_MAX)
+ &MAX(0., -SIGN(1., ZTIME_LASTCALL(JL)+ZTSTEP-ZTIME(JL)-ZMAXTIME(JL))) ! WHERE(ZTIME(:)+ZMAXTIME(:)>ZTIME_LASTCALL(:)+ZTSTEP)
+ ZMAXTIME(JL)=(1.-ZW1D(JL)) * ZMAXTIME(JL) + &
+ &ZW1D(JL) * (ZTIME_LASTCALL(JL)-ZTIME(JL)+ZTSTEP)
+ ZCOMPUTE(JL)=ZCOMPUTE(JL) * (1. - ZW1D(JL))
+ ENDDO
ENDIF
!We must recompute tendencies when the maximum allowed change is reached
!When a specy is missing, only the external tendencies can be active and we do not want to recompute
!the microphysical tendencies when external tendencies are negative (results won't change because specy was already missing)
IF(XMRSTEP/=0.) THEN
- ZTIME_THRESHOLD(:)=-1.
- WHERE(IITER(:)<INB_ITER_MAX .AND. ABS(ZA_RV(:))>1.E-20)
- ZTIME_THRESHOLD(:)=(SIGN(1., ZA_RV(:))*XMRSTEP+Z0RVT(:)-ZRVT(:)-ZB_RV(:))/ZA_RV(:)
- ENDWHERE
- WHERE(ZTIME_THRESHOLD(:)>=0. .AND. ZTIME_THRESHOLD(:)<ZMAXTIME(:) .AND. &
- &(ZRVT(:)>XRTMIN(1) .OR. ZA_RV(:)>0.))
- ZMAXTIME(:)=MIN(ZMAXTIME(:), ZTIME_THRESHOLD(:))
- LLCOMPUTE(:)=.FALSE.
- ENDWHERE
-
- ZTIME_THRESHOLD(:)=-1.
- WHERE(IITER(:)<INB_ITER_MAX .AND. ABS(ZA_RC(:))>1.E-20)
- ZTIME_THRESHOLD(:)=(SIGN(1., ZA_RC(:))*XMRSTEP+Z0RCT(:)-ZRCT(:)-ZB_RC(:))/ZA_RC(:)
- ENDWHERE
- WHERE(ZTIME_THRESHOLD(:)>=0. .AND. ZTIME_THRESHOLD(:)<ZMAXTIME(:) .AND. &
- &(ZRCT(:)>XRTMIN(2) .OR. ZA_RC(:)>0.))
- ZMAXTIME(:)=MIN(ZMAXTIME(:), ZTIME_THRESHOLD(:))
- LLCOMPUTE(:)=.FALSE.
- ENDWHERE
-
- ZTIME_THRESHOLD(:)=-1.
- WHERE(IITER(:)<INB_ITER_MAX .AND. ABS(ZA_RR(:))>1.E-20)
- ZTIME_THRESHOLD(:)=(SIGN(1., ZA_RR(:))*XMRSTEP+Z0RRT(:)-ZRRT(:)-ZB_RR(:))/ZA_RR(:)
- ENDWHERE
- WHERE(ZTIME_THRESHOLD(:)>=0. .AND. ZTIME_THRESHOLD(:)<ZMAXTIME(:) .AND. &
- &(ZRRT(:)>XRTMIN(3) .OR. ZA_RR(:)>0.))
- ZMAXTIME(:)=MIN(ZMAXTIME(:), ZTIME_THRESHOLD(:))
- LLCOMPUTE(:)=.FALSE.
- ENDWHERE
-
- ZTIME_THRESHOLD(:)=-1.
- WHERE(IITER(:)<INB_ITER_MAX .AND. ABS(ZA_RI(:))>1.E-20)
- ZTIME_THRESHOLD(:)=(SIGN(1., ZA_RI(:))*XMRSTEP+Z0RIT(:)-ZRIT(:)-ZB_RI(:))/ZA_RI(:)
- ENDWHERE
- WHERE(ZTIME_THRESHOLD(:)>=0. .AND. ZTIME_THRESHOLD(:)<ZMAXTIME(:) .AND. &
- &(ZRIT(:)>XRTMIN(4) .OR. ZA_RI(:)>0.))
- ZMAXTIME(:)=MIN(ZMAXTIME(:), ZTIME_THRESHOLD(:))
- LLCOMPUTE(:)=.FALSE.
- ENDWHERE
-
- ZTIME_THRESHOLD(:)=-1.
- WHERE(IITER(:)<INB_ITER_MAX .AND. ABS(ZA_RS(:))>1.E-20)
- ZTIME_THRESHOLD(:)=(SIGN(1., ZA_RS(:))*XMRSTEP+Z0RST(:)-ZRST(:)-ZB_RS(:))/ZA_RS(:)
- ENDWHERE
- WHERE(ZTIME_THRESHOLD(:)>=0. .AND. ZTIME_THRESHOLD(:)<ZMAXTIME(:) .AND. &
- &(ZRST(:)>XRTMIN(5) .OR. ZA_RS(:)>0.))
- ZMAXTIME(:)=MIN(ZMAXTIME(:), ZTIME_THRESHOLD(:))
- LLCOMPUTE(:)=.FALSE.
- ENDWHERE
-
- ZTIME_THRESHOLD(:)=-1.
- WHERE(IITER(:)<INB_ITER_MAX .AND. ABS(ZA_RG(:))>1.E-20)
- ZTIME_THRESHOLD(:)=(SIGN(1., ZA_RG(:))*XMRSTEP+Z0RGT(:)-ZRGT(:)-ZB_RG(:))/ZA_RG(:)
- ENDWHERE
- WHERE(ZTIME_THRESHOLD(:)>=0. .AND. ZTIME_THRESHOLD(:)<ZMAXTIME(:) .AND. &
- &(ZRGT(:)>XRTMIN(6) .OR. ZA_RG(:)>0.))
- ZMAXTIME(:)=MIN(ZMAXTIME(:), ZTIME_THRESHOLD(:))
- LLCOMPUTE(:)=.FALSE.
- ENDWHERE
+ DO JL=1, IMICRO
+ ZW1D(JL)=MAX(0., -SIGN(1., IITER(JL)-INB_ITER_MAX+0.)) * & ! WHERE(IITER(:)<INB_ITER_MAX)
+ &MAX(0., -SIGN(1., 1.E-20-ABS(ZA_RV(JL)))) ! WHERE(ABS(ZA_RV(:))>1.E-20)
+ ZTIME_THRESHOLD(JL)=(1.-ZW1D(JL))*(-1.) + &
+ &ZW1D(JL)*(SIGN(1., ZA_RV(JL))*XMRSTEP+Z0RVT(JL)-ZRVT(JL)-ZB_RV(JL))/ &
+ &SIGN(MAX(ABS(ZA_RV(JL)), 1.E-20), ZA_RV(JL))
+ ZW1D(JL)=MAX(0., SIGN(1., ZTIME_THRESHOLD(JL))) * & !WHERE(ZTIME_THRESHOLD(:)>=0.)
+ &MAX(0., -SIGN(1., ZTIME_THRESHOLD(JL)-ZMAXTIME(JL))) * & !WHERE(ZTIME_THRESHOLD(:)<ZMAXTIME(:))
+ &MIN(1., MAX(0., -SIGN(1., XRTMIN(6)-ZRVT(JL))) + & !WHERE(ZRVT(:)>XRTMIN(6)) .OR.
+ &MAX(0., -SIGN(1., -ZA_RV(JL)))) !WHERE(ZA_RV(:)>0.)
+ ZMAXTIME(JL)=(1.-ZW1D(JL)) * ZMAXTIME(JL) + &
+ &ZW1D(JL)*MIN(ZMAXTIME(JL), ZTIME_THRESHOLD(JL))
+ ZCOMPUTE(JL)=ZCOMPUTE(JL) * (1. - ZW1D(JL))
+
+ ZW1D(JL)=MAX(0., -SIGN(1., IITER(JL)-INB_ITER_MAX+0.)) * & ! WHERE(IITER(:)<INB_ITER_MAX)
+ &MAX(0., -SIGN(1., 1.E-20-ABS(ZA_RC(JL)))) ! WHERE(ABS(ZA_RC(:))>1.E-20)
+ ZTIME_THRESHOLD(JL)=(1.-ZW1D(JL))*(-1.) + &
+ &ZW1D(JL)*(SIGN(1., ZA_RC(JL))*XMRSTEP+Z0RCT(JL)-ZRCT(JL)-ZB_RC(JL))/ &
+ &SIGN(MAX(ABS(ZA_RC(JL)), 1.E-20), ZA_RC(JL))
+ ZW1D(JL)=MAX(0., SIGN(1., ZTIME_THRESHOLD(JL))) * & !WHERE(ZTIME_THRESHOLD(:)>=0.)
+ &MAX(0., -SIGN(1., ZTIME_THRESHOLD(JL)-ZMAXTIME(JL))) * & !WHERE(ZTIME_THRESHOLD(:)<ZMAXTIME(:))
+ &MIN(1., MAX(0., -SIGN(1., XRTMIN(6)-ZRCT(JL))) + & !WHERE(ZRCT(:)>XRTMIN(6)) .OR.
+ &MAX(0., -SIGN(1., -ZA_RC(JL)))) !WHERE(ZA_RC(:)>0.)
+ ZMAXTIME(JL)=(1.-ZW1D(JL)) * ZMAXTIME(JL) + &
+ &ZW1D(JL)*MIN(ZMAXTIME(JL), ZTIME_THRESHOLD(JL))
+ ZCOMPUTE(JL)=ZCOMPUTE(JL) * (1. - ZW1D(JL))
+
+ ZW1D(JL)=MAX(0., -SIGN(1., IITER(JL)-INB_ITER_MAX+0.)) * & ! WHERE(IITER(:)<INB_ITER_MAX)
+ &MAX(0., -SIGN(1., 1.E-20-ABS(ZA_RR(JL)))) ! WHERE(ABS(ZA_RR(:))>1.E-20)
+ ZTIME_THRESHOLD(JL)=(1.-ZW1D(JL))*(-1.) + &
+ &ZW1D(JL)*(SIGN(1., ZA_RR(JL))*XMRSTEP+Z0RRT(JL)-ZRRT(JL)-ZB_RR(JL))/ &
+ &SIGN(MAX(ABS(ZA_RR(JL)), 1.E-20), ZA_RR(JL))
+ ZW1D(JL)=MAX(0., SIGN(1., ZTIME_THRESHOLD(JL))) * & !WHERE(ZTIME_THRESHOLD(:)>=0.)
+ &MAX(0., -SIGN(1., ZTIME_THRESHOLD(JL)-ZMAXTIME(JL))) * & !WHERE(ZTIME_THRESHOLD(:)<ZMAXTIME(:))
+ &MIN(1., MAX(0., -SIGN(1., XRTMIN(6)-ZRRT(JL))) + & !WHERE(ZRRT(:)>XRTMIN(6)) .OR.
+ &MAX(0., -SIGN(1., -ZA_RR(JL)))) !WHERE(ZA_RR(:)>0.)
+ ZMAXTIME(JL)=(1.-ZW1D(JL)) * ZMAXTIME(JL) + &
+ &ZW1D(JL)*MIN(ZMAXTIME(JL), ZTIME_THRESHOLD(JL))
+ ZCOMPUTE(JL)=ZCOMPUTE(JL) * (1. - ZW1D(JL))
+
+ ZW1D(JL)=MAX(0., -SIGN(1., IITER(JL)-INB_ITER_MAX+0.)) * & ! WHERE(IITER(:)<INB_ITER_MAX)
+ &MAX(0., -SIGN(1., 1.E-20-ABS(ZA_RI(JL)))) ! WHERE(ABS(ZA_RI(:))>1.E-20)
+ ZTIME_THRESHOLD(JL)=(1.-ZW1D(JL))*(-1.) + &
+ &ZW1D(JL)*(SIGN(1., ZA_RI(JL))*XMRSTEP+Z0RIT(JL)-ZRIT(JL)-ZB_RI(JL))/ &
+ &SIGN(MAX(ABS(ZA_RI(JL)), 1.E-20), ZA_RI(JL))
+ ZW1D(JL)=MAX(0., SIGN(1., ZTIME_THRESHOLD(JL))) * & !WHERE(ZTIME_THRESHOLD(:)>=0.)
+ &MAX(0., -SIGN(1., ZTIME_THRESHOLD(JL)-ZMAXTIME(JL))) * & !WHERE(ZTIME_THRESHOLD(:)<ZMAXTIME(:))
+ &MIN(1., MAX(0., -SIGN(1., XRTMIN(6)-ZRIT(JL))) + & !WHERE(ZRIT(:)>XRTMIN(6)) .OR.
+ &MAX(0., -SIGN(1., -ZA_RI(JL)))) !WHERE(ZA_RI(:)>0.)
+ ZMAXTIME(JL)=(1.-ZW1D(JL)) * ZMAXTIME(JL) + &
+ &ZW1D(JL)*MIN(ZMAXTIME(JL), ZTIME_THRESHOLD(JL))
+ ZCOMPUTE(JL)=ZCOMPUTE(JL) * (1. - ZW1D(JL))
+
+ ZW1D(JL)=MAX(0., -SIGN(1., IITER(JL)-INB_ITER_MAX+0.)) * & ! WHERE(IITER(:)<INB_ITER_MAX)
+ &MAX(0., -SIGN(1., 1.E-20-ABS(ZA_RS(JL)))) ! WHERE(ABS(ZA_RS(:))>1.E-20)
+ ZTIME_THRESHOLD(JL)=(1.-ZW1D(JL))*(-1.) + &
+ &ZW1D(JL)*(SIGN(1., ZA_RS(JL))*XMRSTEP+Z0RST(JL)-ZRST(JL)-ZB_RS(JL))/ &
+ &SIGN(MAX(ABS(ZA_RS(JL)), 1.E-20), ZA_RS(JL))
+ ZW1D(JL)=MAX(0., SIGN(1., ZTIME_THRESHOLD(JL))) * & !WHERE(ZTIME_THRESHOLD(:)>=0.)
+ &MAX(0., -SIGN(1., ZTIME_THRESHOLD(JL)-ZMAXTIME(JL))) * & !WHERE(ZTIME_THRESHOLD(:)<ZMAXTIME(:))
+ &MIN(1., MAX(0., -SIGN(1., XRTMIN(6)-ZRST(JL))) + & !WHERE(ZRST(:)>XRTMIN(6)) .OR.
+ &MAX(0., -SIGN(1., -ZA_RS(JL)))) !WHERE(ZA_RS(:)>0.)
+ ZMAXTIME(JL)=(1.-ZW1D(JL)) * ZMAXTIME(JL) + &
+ &ZW1D(JL)*MIN(ZMAXTIME(JL), ZTIME_THRESHOLD(JL))
+ ZCOMPUTE(JL)=ZCOMPUTE(JL) * (1. - ZW1D(JL))
+
+ ZW1D(JL)=MAX(0., -SIGN(1., IITER(JL)-INB_ITER_MAX+0.)) * & ! WHERE(IITER(:)<INB_ITER_MAX)
+ &MAX(0., -SIGN(1., 1.E-20-ABS(ZA_RG(JL)))) ! WHERE(ABS(ZA_RG(:))>1.E-20)
+ ZTIME_THRESHOLD(JL)=(1.-ZW1D(JL))*(-1.) + &
+ &ZW1D(JL)*(SIGN(1., ZA_RG(JL))*XMRSTEP+Z0RGT(JL)-ZRGT(JL)-ZB_RG(JL))/ &
+ &SIGN(MAX(ABS(ZA_RG(JL)), 1.E-20), ZA_RG(JL))
+ ZW1D(JL)=MAX(0., SIGN(1., ZTIME_THRESHOLD(JL))) * & !WHERE(ZTIME_THRESHOLD(:)>=0.)
+ &MAX(0., -SIGN(1., ZTIME_THRESHOLD(JL)-ZMAXTIME(JL))) * & !WHERE(ZTIME_THRESHOLD(:)<ZMAXTIME(:))
+ &MIN(1., MAX(0., -SIGN(1., XRTMIN(6)-ZRGT(JL))) + & !WHERE(ZRGT(:)>XRTMIN(6)) .OR.
+ &MAX(0., -SIGN(1., -ZA_RG(JL)))) !WHERE(ZA_RG(:)>0.)
+ ZMAXTIME(JL)=(1.-ZW1D(JL)) * ZMAXTIME(JL) + &
+ &ZW1D(JL)*MIN(ZMAXTIME(JL), ZTIME_THRESHOLD(JL))
+ ZCOMPUTE(JL)=ZCOMPUTE(JL) * (1. - ZW1D(JL))
+ ENDDO
IF(KRR==7) THEN
- ZTIME_THRESHOLD(:)=-1.
- WHERE(IITER(:)<INB_ITER_MAX .AND. ABS(ZA_RH(:))>1.E-20)
- ZTIME_THRESHOLD(:)=(SIGN(1., ZA_RH(:))*XMRSTEP+Z0RHT(:)-ZRHT(:)-ZB_RH(:))/ZA_RH(:)
- ENDWHERE
- WHERE(ZTIME_THRESHOLD(:)>=0. .AND. ZTIME_THRESHOLD(:)<ZMAXTIME(:) .AND. &
- &(ZRHT(:)>XRTMIN(7) .OR. ZA_RH(:)>0.))
- ZMAXTIME(:)=MIN(ZMAXTIME(:), ZTIME_THRESHOLD(:))
- LLCOMPUTE(:)=.FALSE.
- ENDWHERE
+ DO JL=1, IMICRO
+ ZW1D(JL)=MAX(0., -SIGN(1., IITER(JL)-INB_ITER_MAX+0.)) * & ! WHERE(IITER(:)<INB_ITER_MAX)
+ &MAX(0., -SIGN(1., 1.E-20-ABS(ZA_RH(JL)))) ! WHERE(ABS(ZA_RH(:))>1.E-20)
+ ZTIME_THRESHOLD(JL)=(1.-ZW1D(JL))*(-1.) + &
+ &ZW1D(JL)*(SIGN(1., ZA_RH(JL))*XMRSTEP+Z0RHT(JL)-ZRHT(JL)-ZB_RH(JL))/ &
+ &SIGN(MAX(ABS(ZA_RH(JL)), 1.E-20), ZA_RH(JL))
+ ZW1D(JL)=MAX(0., SIGN(1., ZTIME_THRESHOLD(JL))) * & !WHERE(ZTIME_THRESHOLD(:)>=0.)
+ &MAX(0., -SIGN(1., ZTIME_THRESHOLD(JL)-ZMAXTIME(JL))) * & !WHERE(ZTIME_THRESHOLD(:)<ZMAXTIME(:))
+ &MIN(1., MAX(0., -SIGN(1., XRTMIN(6)-ZRHT(JL))) + & !WHERE(ZRHT(:)>XRTMIN(6)) .OR.
+ &MAX(0., -SIGN(1., -ZA_RH(JL)))) !WHERE(ZA_RH(:)>0.)
+ ZMAXTIME(JL)=(1.-ZW1D(JL)) * ZMAXTIME(JL) + &
+ &ZW1D(JL)*MIN(ZMAXTIME(JL), ZTIME_THRESHOLD(JL))
+ ZCOMPUTE(JL)=ZCOMPUTE(JL) * (1. - ZW1D(JL))
+ ENDDO
ENDIF
- WHERE(IITER(:)<INB_ITER_MAX .AND. MAX(ABS(ZB_RV(:)), ABS(ZB_RC(:)), ABS(ZB_RR(:)), ABS(ZB_RI(:)), &
- ABS(ZB_RS(:)), ABS(ZB_RG(:)), ABS(ZB_RH(:)))>XMRSTEP)
- ZMAXTIME(:)=0.
- LLCOMPUTE(:)=.FALSE.
- ENDWHERE
+ DO JL=1, IMICRO
+ ZW1D(JL)=MAX(ABS(ZB_RV(JL)), ABS(ZB_RC(JL)), ABS(ZB_RR(JL)), ABS(ZB_RI(JL)), &
+ &ABS(ZB_RS(JL)), ABS(ZB_RG(JL)), ABS(ZB_RH(JL)))
+ ZW1D(JL)=MAX(0., -SIGN(1., IITER(JL)-INB_ITER_MAX+0.)) * & !WHERE(IITER(:)<INB_ITER_MAX)
+ &MAX(0., -SIGN(1., XMRSTEP-ZW1D(JL))) !WHERE(ZW1D(:)>XMRSTEP)
+ ZMAXTIME(JL)=(1.-ZW1D(JL))*ZMAXTIME(JL)
+ ZCOMPUTE(JL)=ZCOMPUTE(JL) * (1. - ZW1D(JL))
+ ENDDO
ENDIF
!
!*** 4.3 New values of variables for next iteration
!
- ZTHT=ZTHT+ZA_TH(:)*ZMAXTIME(:)+ZB_TH(:)
- ZRVT=ZRVT+ZA_RV(:)*ZMAXTIME(:)+ZB_RV(:)
- ZRCT=ZRCT+ZA_RC(:)*ZMAXTIME(:)+ZB_RC(:)
- ZRRT=ZRRT+ZA_RR(:)*ZMAXTIME(:)+ZB_RR(:)
- ZRIT=ZRIT+ZA_RI(:)*ZMAXTIME(:)+ZB_RI(:)
- ZRST=ZRST+ZA_RS(:)*ZMAXTIME(:)+ZB_RS(:)
- ZRGT=ZRGT+ZA_RG(:)*ZMAXTIME(:)+ZB_RG(:)
- IF(KRR==7) ZRHT=ZRHT+ZA_RH(:)*ZMAXTIME(:)+ZB_RH(:)
- WHERE(ZRIT(:)==0.)
- ZCIT(:) = 0.
- END WHERE
+ DO JL=1, IMICRO
+ ZTHT(JL)=ZTHT(JL)+ZA_TH(JL)*ZMAXTIME(JL)+ZB_TH(JL)
+ ZRVT(JL)=ZRVT(JL)+ZA_RV(JL)*ZMAXTIME(JL)+ZB_RV(JL)
+ ZRCT(JL)=ZRCT(JL)+ZA_RC(JL)*ZMAXTIME(JL)+ZB_RC(JL)
+ ZRRT(JL)=ZRRT(JL)+ZA_RR(JL)*ZMAXTIME(JL)+ZB_RR(JL)
+ ZRIT(JL)=ZRIT(JL)+ZA_RI(JL)*ZMAXTIME(JL)+ZB_RI(JL)
+ ZRST(JL)=ZRST(JL)+ZA_RS(JL)*ZMAXTIME(JL)+ZB_RS(JL)
+ ZRGT(JL)=ZRGT(JL)+ZA_RG(JL)*ZMAXTIME(JL)+ZB_RG(JL)
+ ZCIT(JL)=ZCIT(JL) * MAX(0., -SIGN(1., -ZRIT(JL))) ! WHERE(ZRIT(:)==0.) ZCIT(:) = 0.
+ ENDDO
+ IF(KRR==7) ZRHT(:)=ZRHT(:)+ZA_RH(:)*ZMAXTIME(:)+ZB_RH(:)
!
!*** 4.4 Mixing ratio change due to each process
!
@@ -1045,11 +1160,19 @@ IF(IMICRO>0) THEN
ZHLC_LCF3D(:,:,:)=0.
ZHLC_HRC3D(:,:,:)=0.
ZHLC_LRC3D(:,:,:)=0.
+ ZHLI_HCF3D(:,:,:)=0.
+ ZHLI_LCF3D(:,:,:)=0.
+ ZHLI_HRI3D(:,:,:)=0.
+ ZHLI_LRI3D(:,:,:)=0.
DO JL=1,IMICRO
ZHLC_HCF3D(I1(JL), I2(JL), I3(JL)) = ZHLC_HCF(JL)
ZHLC_LCF3D(I1(JL), I2(JL), I3(JL)) = ZHLC_LCF(JL)
ZHLC_HRC3D(I1(JL), I2(JL), I3(JL)) = ZHLC_HRC(JL)
ZHLC_LRC3D(I1(JL), I2(JL), I3(JL)) = ZHLC_LRC(JL)
+ ZHLI_LCF3D(I1(JL), I2(JL), I3(JL)) = ZHLI_LCF(JL)
+ ZHLI_HCF3D(I1(JL), I2(JL), I3(JL)) = ZHLI_HCF(JL)
+ ZHLI_HRI3D(I1(JL), I2(JL), I3(JL)) = ZHLI_HRI(JL)
+ ZHLI_LRI3D(I1(JL), I2(JL), I3(JL)) = ZHLI_LRI(JL)
PCIT(I1(JL), I2(JL), I3(JL)) = ZCIT(JL)
END DO
ELSE
@@ -1058,6 +1181,10 @@ ELSE
ZHLC_LCF3D(:,:,:)=0.
ZHLC_HRC3D(:,:,:)=0.
ZHLC_LRC3D(:,:,:)=0.
+ ZHLI_HCF3D(:,:,:)=0.
+ ZHLI_LCF3D(:,:,:)=0.
+ ZHLI_HRI3D(:,:,:)=0.
+ ZHLI_LRI3D(:,:,:)=0.
PCIT(:,:,:) = 0.
ENDIF
IF(OWARM) THEN
@@ -1071,24 +1198,29 @@ ENDIF
!* 6. COMPUTES THE SLOW COLD PROCESS SOURCES OUTSIDE OF ODMICRO POINTS
! ----------------------------------------------------------------
!
-CALL ICE4_NUCLEATION_WRAPPER(IIT, IJT, IKT, .NOT. ODMICRO, &
+CALL ICE4_NUCLEATION_WRAPPER(KIT, KJT, KKT, .NOT. ODMICRO, &
PTHT, PPABST, PRHODREF, PEXN, ZZ_LSFACT/PEXN, ZT, &
PRVT, &
PCIT, ZZ_RVHENI_MR)
-ZZ_LSFACT(:,:,:)=ZZ_LSFACT(:,:,:)/PEXNREF(:,:,:)
-ZZ_LVFACT(:,:,:)=ZZ_LVFACT(:,:,:)/PEXNREF(:,:,:)
-ZZ_RVHENI(:,:,:) = MIN(PRVS(:,:,:), ZZ_RVHENI_MR(:,:,:)/PTSTEP)
-PRIS(:,:,:)=PRIS(:,:,:)+ZZ_RVHENI(:,:,:)
-PRVS(:,:,:)=PRVS(:,:,:)-ZZ_RVHENI(:,:,:)
-PTHS(:,:,:)=PTHS(:,:,:) + ZZ_RVHENI(:,:,:)*ZZ_LSFACT(:,:,:)
-
+DO JK = 1, KKT
+ DO JJ = 1, KJT
+ DO JI = 1, KIT
+ ZZ_LSFACT(JI,JJ,JK)=ZZ_LSFACT(JI,JJ,JK)/PEXNREF(JI,JJ,JK)
+ ZZ_LVFACT(JI,JJ,JK)=ZZ_LVFACT(JI,JJ,JK)/PEXNREF(JI,JJ,JK)
+ ZZ_RVHENI(JI,JJ,JK) = MIN(PRVS(JI,JJ,JK), ZZ_RVHENI_MR(JI,JJ,JK)/PTSTEP)
+ PRIS(JI,JJ,JK)=PRIS(JI,JJ,JK)+ZZ_RVHENI(JI,JJ,JK)
+ PRVS(JI,JJ,JK)=PRVS(JI,JJ,JK)-ZZ_RVHENI(JI,JJ,JK)
+ PTHS(JI,JJ,JK)=PTHS(JI,JJ,JK) + ZZ_RVHENI(JI,JJ,JK)*ZZ_LSFACT(JI,JJ,JK)
+ ENDDO
+ ENDDO
+ENDDO
+!
if ( lbu_enable ) then
!Note: there is an other contribution for HENU later
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_add( tbudgets(NBUDGET_RI), 'HENU', zz_rvheni(:, :, :) * prhodj(:, :, :) )
end if
-
!-------------------------------------------------------------------------------
!
!* 7. UNPACKING AND TOTAL TENDENCIES
@@ -1101,14 +1233,16 @@ end if
!
IF(GEXT_TEND) THEN
!Z..T variables contain the exeternal tendency, we substract it
- ZRVT(:) = ZRVT(:) - ZEXT_RV(:) * PTSTEP
- ZRCT(:) = ZRCT(:) - ZEXT_RC(:) * PTSTEP
- ZRRT(:) = ZRRT(:) - ZEXT_RR(:) * PTSTEP
- ZRIT(:) = ZRIT(:) - ZEXT_RI(:) * PTSTEP
- ZRST(:) = ZRST(:) - ZEXT_RS(:) * PTSTEP
- ZRGT(:) = ZRGT(:) - ZEXT_RG(:) * PTSTEP
+ DO JL=1, IMICRO
+ ZRVT(JL) = ZRVT(JL) - ZEXT_RV(JL) * PTSTEP
+ ZRCT(JL) = ZRCT(JL) - ZEXT_RC(JL) * PTSTEP
+ ZRRT(JL) = ZRRT(JL) - ZEXT_RR(JL) * PTSTEP
+ ZRIT(JL) = ZRIT(JL) - ZEXT_RI(JL) * PTSTEP
+ ZRST(JL) = ZRST(JL) - ZEXT_RS(JL) * PTSTEP
+ ZRGT(JL) = ZRGT(JL) - ZEXT_RG(JL) * PTSTEP
+ ZTHT(JL) = ZTHT(JL) - ZEXT_TH(JL) * PTSTEP
+ ENDDO
IF (KRR==7) ZRHT(:) = ZRHT(:) - ZEXT_RH(:) * PTSTEP
- ZTHT(:) = ZTHT(:) - ZEXT_TH(:) * PTSTEP
ENDIF
!Tendencies computed from difference between old state and new state (can be negative)
ZW_RVS(:,:,:) = 0.
@@ -1155,7 +1289,7 @@ if ( lbu_enable ) then
end if
!We correct negativities with conservation
-CALL CORRECT_NEGATIVITIES(KRR, ZW_RVS, ZW_RCS, ZW_RRS, &
+CALL CORRECT_NEGATIVITIES(KIT, KJT, KKT, KRR, ZW_RVS, ZW_RCS, ZW_RRS, &
&ZW_RIS, ZW_RSS, ZW_RGS, &
&ZW_THS, ZZ_LVFACT, ZZ_LSFACT, ZW_RHS)
@@ -1507,16 +1641,20 @@ ENDIF
!
!*** 7.3 Final tendencies
!
-PRVS(:,:,:) = ZW_RVS(:,:,:)
-PRCS(:,:,:) = ZW_RCS(:,:,:)
-PRRS(:,:,:) = ZW_RRS(:,:,:)
-PRIS(:,:,:) = ZW_RIS(:,:,:)
-PRSS(:,:,:) = ZW_RSS(:,:,:)
-PRGS(:,:,:) = ZW_RGS(:,:,:)
-IF (KRR==7) THEN
- PRHS(:,:,:) = ZW_RHS(:,:,:)
-ENDIF
-PTHS(:,:,:) = ZW_THS(:,:,:)
+DO JK = 1, KKT
+ DO JJ = 1, KJT
+ DO JI = 1, KIT
+ PRVS(JI,JJ,JK) = ZW_RVS(JI,JJ,JK)
+ PRCS(JI,JJ,JK) = ZW_RCS(JI,JJ,JK)
+ PRRS(JI,JJ,JK) = ZW_RRS(JI,JJ,JK)
+ PRIS(JI,JJ,JK) = ZW_RIS(JI,JJ,JK)
+ PRSS(JI,JJ,JK) = ZW_RSS(JI,JJ,JK)
+ PRGS(JI,JJ,JK) = ZW_RGS(JI,JJ,JK)
+ PTHS(JI,JJ,JK) = ZW_THS(JI,JJ,JK)
+ ENDDO
+ ENDDO
+ENDDO
+IF (KRR==7) PRHS(:,:,:) = ZW_RHS(:,:,:)
!
!-------------------------------------------------------------------------------
!
@@ -1543,22 +1681,22 @@ IF(LSEDIM_AFTER) THEN
IF(HSEDIM=='STAT') THEN
!SR: It *seems* that we must have two separate calls for ifort
IF(KRR==7) THEN
- CALL ICE4_SEDIMENTATION_STAT(IIB, IIE, IIT, IJB, IJE, IJT, IKB, IKE, IKTB, IKTE, IKT, KKL, &
+ CALL ICE4_SEDIMENTATION_STAT(IIB, IIE, KIT, IJB, IJE, KJT, IKB, IKE, IKTB, IKTE, KKT, KKL, &
&PTSTEP, KRR, OSEDIC, LDEPOSC, XVDEPOSC, PDZZ, &
&PRHODREF, PPABST, PTHT, PRHODJ, &
&PRCS, PRCS*PTSTEP, PRRS, PRRS*PTSTEP, PRIS, PRIS*PTSTEP,&
&PRSS, PRSS*PTSTEP, PRGS, PRGS*PTSTEP,&
&PINPRC, PINDEP, PINPRR, ZINPRI, PINPRS, PINPRG, &
- &PSEA, PTOWN, &
+ &PSEA=PSEA, PTOWN=PTOWN, &
&PINPRH=PINPRH, PRHT=PRHS*PTSTEP, PRHS=PRHS, PFPR=PFPR)
ELSE
- CALL ICE4_SEDIMENTATION_STAT(IIB, IIE, IIT, IJB, IJE, IJT, IKB, IKE, IKTB, IKTE, IKT, KKL, &
+ CALL ICE4_SEDIMENTATION_STAT(IIB, IIE, KIT, IJB, IJE, KJT, IKB, IKE, IKTB, IKTE, KKT, KKL, &
&PTSTEP, KRR, OSEDIC, LDEPOSC, XVDEPOSC, PDZZ,&
&PRHODREF, PPABST, PTHT, PRHODJ, &
&PRCS, PRCS*PTSTEP, PRRS, PRRS*PTSTEP, PRIS, PRIS*PTSTEP,&
&PRSS, PRSS*PTSTEP, PRGS, PRGS*PTSTEP,&
&PINPRC, PINDEP, PINPRR, ZINPRI, PINPRS, PINPRG, &
- &PSEA, PTOWN, &
+ &PSEA=PSEA, PTOWN=PTOWN, &
&PFPR=PFPR)
ENDIF
PINPRS(:,:) = PINPRS(:,:) + ZINPRI(:,:)
@@ -1566,20 +1704,20 @@ IF(LSEDIM_AFTER) THEN
ELSEIF(HSEDIM=='SPLI') THEN
!SR: It *seems* that we must have two separate calls for ifort
IF(KRR==7) THEN
- CALL ICE4_SEDIMENTATION_SPLIT(IIB, IIE, IIT, IJB, IJE, IJT, IKB, IKE, IKTB, IKTE, IKT, KKL, &
+ CALL ICE4_SEDIMENTATION_SPLIT(IIB, IIE, KIT, IJB, IJE, KJT, IKB, IKE, IKTB, IKTE, KKT, KKL, &
&PTSTEP, KRR, OSEDIC, LDEPOSC, XVDEPOSC, PDZZ, &
&PRHODREF, PPABST, PTHT, PRHODJ, &
&PRCS, PRCT, PRRS, PRRT, PRIS, PRIT, PRSS, PRST, PRGS, PRGT,&
&PINPRC, PINDEP, PINPRR, ZINPRI, PINPRS, PINPRG, &
- &PSEA, PTOWN, &
+ &PSEA=PSEA, PTOWN=PTOWN, &
&PINPRH=PINPRH, PRHT=PRHT, PRHS=PRHS, PFPR=PFPR)
ELSE
- CALL ICE4_SEDIMENTATION_SPLIT(IIB, IIE, IIT, IJB, IJE, IJT, IKB, IKE, IKTB, IKTE, IKT, KKL, &
+ CALL ICE4_SEDIMENTATION_SPLIT(IIB, IIE, KIT, IJB, IJE, KJT, IKB, IKE, IKTB, IKTE, KKT, KKL, &
&PTSTEP, KRR, OSEDIC, LDEPOSC, XVDEPOSC, PDZZ, &
&PRHODREF, PPABST, PTHT, PRHODJ, &
&PRCS, PRCT, PRRS, PRRT, PRIS, PRIT, PRSS, PRST, PRGS, PRGT,&
&PINPRC, PINDEP, PINPRR, ZINPRI, PINPRS, PINPRG, &
- &PSEA, PTOWN, &
+ &PSEA=PSEA, PTOWN=PTOWN, &
&PFPR=PFPR)
ENDIF
PINPRS(:,:) = PINPRS(:,:) + ZINPRI(:,:)
@@ -1593,7 +1731,7 @@ IF(LSEDIM_AFTER) THEN
! will be still active and will lead to negative values.
! We could prevent the algorithm to not consume too much a specie, instead we apply
! a correction here.
- CALL CORRECT_NEGATIVITIES(KRR, PRVS, PRCS, PRRS, &
+ CALL CORRECT_NEGATIVITIES(KIT, KJT, KKT, KRR, PRVS, PRCS, PRRS, &
&PRIS, PRSS, PRGS, &
&PTHS, ZZ_LVFACT, ZZ_LSFACT, PRHS)
ELSE
@@ -1615,96 +1753,130 @@ IF(LSEDIM_AFTER) THEN
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)
+ IF (PRESENT(PRHS)) THEN
+ CALL ICE4_RAINFR_VERT(IIB, IIE, KIT, IJB, IJE, KJT, IKB, IKE, KKT, KKL, PRAINFR, PRRS(:,:,:)*PTSTEP, &
+ &PRSS(:,:,:)*PTSTEP, PRGS(:,:,:)*PTSTEP, PRHS(:,:,:)*PTSTEP)
+ ELSE
+ CALL ICE4_RAINFR_VERT(IIB, IIE, KIT, IJB, IJE, KJT, IKB, IKE, KKT, KKL, PRAINFR, PRRS(:,:,:)*PTSTEP, &
+ &PRSS(:,:,:)*PTSTEP, PRGS(:,:,:)*PTSTEP)
+ ENDIF
ENDIF
!
!
CONTAINS
!
- SUBROUTINE CORRECT_NEGATIVITIES(KRR, PRV, PRC, PRR, &
+ SUBROUTINE CORRECT_NEGATIVITIES(KIT, KJT, KKT, KRR, PRV, PRC, PRR, &
&PRI, PRS, PRG, &
&PTH, PLVFACT, PLSFACT, PRH)
!
IMPLICIT NONE
!
- INTEGER, INTENT(IN) :: KRR
- REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRV, PRC, PRR, PRI, PRS, PRG, PTH
- REAL, DIMENSION(:,:,:), INTENT(IN) :: PLVFACT, PLSFACT
- REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(INOUT) :: PRH
+ INTEGER, INTENT(IN) :: KIT, KJT, KKT, KRR
+ REAL, DIMENSION(KIT, KJT, KKT), INTENT(INOUT) :: PRV, PRC, PRR, PRI, PRS, PRG, PTH
+ REAL, DIMENSION(KIT, KJT, KKT), INTENT(IN) :: PLVFACT, PLSFACT
+ REAL, DIMENSION(KIT, KJT, KKT), OPTIONAL, INTENT(INOUT) :: PRH
+ !
+ REAL, DIMENSION(KIT, KJT, KKT) :: ZW
+ INTEGER :: JI, JJ, JK
!
- REAL, DIMENSION(SIZE(PRV,1), SIZE(PRV,2), SIZE(PRV,3)) :: ZW
!
!We correct negativities with conservation
! 1) deal with negative values for mixing ratio, except for vapor
- WHERE(PRC(:,:,:)<0.)
- PRV(:,:,:)=PRV(:,:,:)+PRC(:,:,:)
- PTH(:,:,:)=PTH(:,:,:)-PRC(:,:,:)*PLVFACT(:,:,:)
- PRC(:,:,:)=0.
- ENDWHERE
- WHERE(PRR(:,:,:)<0.)
- PRV(:,:,:)=PRV(:,:,:)+PRR(:,:,:)
- PTH(:,:,:)=PTH(:,:,:)-PRR(:,:,:)*PLVFACT(:,:,:)
- PRR(:,:,:)=0.
- ENDWHERE
- WHERE(PRI(:,:,:)<0.)
- PRV(:,:,:)=PRV(:,:,:)+PRI(:,:,:)
- PTH(:,:,:)=PTH(:,:,:)-PRI(:,:,:)*PLSFACT(:,:,:)
- PRI(:,:,:)=0.
- ENDWHERE
- WHERE(PRS(:,:,:)<0.)
- PRV(:,:,:)=PRV(:,:,:)+PRS(:,:,:)
- PTH(:,:,:)=PTH(:,:,:)-PRS(:,:,:)*PLSFACT(:,:,:)
- PRS(:,:,:)=0.
- ENDWHERE
- WHERE(PRG(:,:,:)<0.)
- PRV(:,:,:)=PRV(:,:,:)+PRG(:,:,:)
- PTH(:,:,:)=PTH(:,:,:)-PRG(:,:,:)*PLSFACT(:,:,:)
- PRG(:,:,:)=0.
- ENDWHERE
+ DO JK = 1, KKT
+ DO JJ = 1, KJT
+ DO JI = 1, KIT
+ ZW(JI,JJ,JK) =PRC(JI,JJ,JK)-MAX(PRC(JI,JJ,JK), 0.)
+ PRV(JI,JJ,JK)=PRV(JI,JJ,JK)+ZW(JI,JJ,JK)
+ PTH(JI,JJ,JK)=PTH(JI,JJ,JK)-ZW(JI,JJ,JK)*PLVFACT(JI,JJ,JK)
+ PRC(JI,JJ,JK)=PRC(JI,JJ,JK)-ZW(JI,JJ,JK)
+
+ ZW(JI,JJ,JK) =PRR(JI,JJ,JK)-MAX(PRR(JI,JJ,JK), 0.)
+ PRV(JI,JJ,JK)=PRV(JI,JJ,JK)+ZW(JI,JJ,JK)
+ PTH(JI,JJ,JK)=PTH(JI,JJ,JK)-ZW(JI,JJ,JK)*PLVFACT(JI,JJ,JK)
+ PRR(JI,JJ,JK)=PRR(JI,JJ,JK)-ZW(JI,JJ,JK)
+
+ ZW(JI,JJ,JK) =PRI(JI,JJ,JK)-MAX(PRI(JI,JJ,JK), 0.)
+ PRV(JI,JJ,JK)=PRV(JI,JJ,JK)+ZW(JI,JJ,JK)
+ PTH(JI,JJ,JK)=PTH(JI,JJ,JK)-ZW(JI,JJ,JK)*PLSFACT(JI,JJ,JK)
+ PRI(JI,JJ,JK)=PRI(JI,JJ,JK)-ZW(JI,JJ,JK)
+
+ ZW(JI,JJ,JK) =PRS(JI,JJ,JK)-MAX(PRS(JI,JJ,JK), 0.)
+ PRV(JI,JJ,JK)=PRV(JI,JJ,JK)+ZW(JI,JJ,JK)
+ PTH(JI,JJ,JK)=PTH(JI,JJ,JK)-ZW(JI,JJ,JK)*PLSFACT(JI,JJ,JK)
+ PRS(JI,JJ,JK)=PRS(JI,JJ,JK)-ZW(JI,JJ,JK)
+
+ ZW(JI,JJ,JK) =PRG(JI,JJ,JK)-MAX(PRG(JI,JJ,JK), 0.)
+ PRV(JI,JJ,JK)=PRV(JI,JJ,JK)+ZW(JI,JJ,JK)
+ PTH(JI,JJ,JK)=PTH(JI,JJ,JK)-ZW(JI,JJ,JK)*PLSFACT(JI,JJ,JK)
+ PRG(JI,JJ,JK)=PRG(JI,JJ,JK)-ZW(JI,JJ,JK)
+ ENDDO
+ ENDDO
+ ENDDO
+
IF(KRR==7) THEN
- WHERE(PRH(:,:,:)<0.)
- PRV(:,:,:)=PRV(:,:,:)+PRH(:,:,:)
- PTH(:,:,:)=PTH(:,:,:)-PRH(:,:,:)*PLSFACT(:,:,:)
- PRH(:,:,:)=0.
- ENDWHERE
+ DO JK = 1, KKT
+ DO JJ = 1, KJT
+ DO JI = 1, KIT
+ ZW(JI,JJ,JK) =PRH(JI,JJ,JK)-MAX(PRH(JI,JJ,JK), 0.)
+ PRV(JI,JJ,JK)=PRV(JI,JJ,JK)+ZW(JI,JJ,JK)
+ PTH(JI,JJ,JK)=PTH(JI,JJ,JK)-ZW(JI,JJ,JK)*PLSFACT(JI,JJ,JK)
+ PRH(JI,JJ,JK)=PRH(JI,JJ,JK)-ZW(JI,JJ,JK)
+ ENDDO
+ ENDDO
+ ENDDO
ENDIF
+
! 2) deal with negative vapor mixing ratio
- WHERE(PRV(:,:,:)<0. .AND. PRC(:,:,:)+PRI(:,:,:)>0.)
- ! for rc and ri, we keep ice fraction constant
- ZW(:,:,:)=MIN(1., -PRV(:,:,:)/(PRC(:,:,:)+PRI(:,:,:))) ! Proportion of rc+ri to convert into rv
- PTH(:,:,:)=PTH(:,:,:)-ZW(:,:,:)*(PRC(:,:,:)*PLVFACT(:,:,:)+PRI(:,:,:)*PLSFACT(:,:,:))
- PRV(:,:,:)=PRV(:,:,:)+ZW(:,:,:)*(PRC(:,:,:)+PRI(:,:,:))
- PRC(:,:,:)=(1.-ZW(:,:,:))*PRC(:,:,:)
- PRI(:,:,:)=(1.-ZW(:,:,:))*PRI(:,:,:)
- ENDWHERE
- WHERE(PRV(:,:,:)<0. .AND. PRR(:,:,:)>0.)
- ZW(:,:,:)=MIN(PRR(:,:,:), -PRV(:,:,:)) ! Quantity of rr to convert into rv
- PRV(:,:,:)=PRV(:,:,:)+ZW(:,:,:)
- PRR(:,:,:)=PRR(:,:,:)-ZW(:,:,:)
- PTH(:,:,:)=PTH(:,:,:)-ZW(:,:,:)*PLVFACT(:,:,:)
- ENDWHERE
- WHERE(PRV(:,:,:)<0. .AND. PRS(:,:,:)>0.)
- ZW(:,:,:)=MIN(PRS(:,:,:), -PRV(:,:,:)) ! Quantity of rs to convert into rv
- PRV(:,:,:)=PRV(:,:,:)+ZW(:,:,:)
- PRS(:,:,:)=PRS(:,:,:)-ZW(:,:,:)
- PTH(:,:,:)=PTH(:,:,:)-ZW(:,:,:)*PLSFACT(:,:,:)
- ENDWHERE
- WHERE(PRV(:,:,:)<0. .AND. PRG(:,:,:)>0.)
- ZW(:,:,:)=MIN(PRG(:,:,:), -PRV(:,:,:)) ! Quantity of rg to convert into rv
- PRV(:,:,:)=PRV(:,:,:)+ZW(:,:,:)
- PRG(:,:,:)=PRG(:,:,:)-ZW(:,:,:)
- PTH(:,:,:)=PTH(:,:,:)-ZW(:,:,:)*PLSFACT(:,:,:)
- ENDWHERE
+
+ DO JK = 1, KKT
+ DO JJ = 1, KJT
+ DO JI = 1, KIT
+ ! for rc and ri, we keep ice fraction constant
+ ZW(JI,JJ,JK)=MIN(1., MAX(XRTMIN(1)-PRV(JI,JJ,JK), 0.) / &
+ &MAX(PRC(JI,JJ,JK)+PRI(JI,JJ,JK), 1.E-20)) ! Proportion of rc+ri to convert into rv
+ PTH(JI,JJ,JK)=PTH(JI,JJ,JK)-ZW(JI,JJ,JK)* &
+ &(PRC(JI,JJ,JK)*PLVFACT(JI,JJ,JK)+PRI(JI,JJ,JK)*PLSFACT(JI,JJ,JK))
+ PRV(JI,JJ,JK)=PRV(JI,JJ,JK)+ZW(JI,JJ,JK)*(PRC(JI,JJ,JK)+PRI(JI,JJ,JK))
+ PRC(JI,JJ,JK)=(1.-ZW(JI,JJ,JK))*PRC(JI,JJ,JK)
+ PRI(JI,JJ,JK)=(1.-ZW(JI,JJ,JK))*PRI(JI,JJ,JK)
+
+ ZW(JI,JJ,JK)=MIN(MAX(PRR(JI,JJ,JK), 0.), &
+ &MAX(XRTMIN(1)-PRV(JI,JJ,JK), 0.)) ! Quantity of rr to convert into rv
+ PRV(JI,JJ,JK)=PRV(JI,JJ,JK)+ZW(JI,JJ,JK)
+ PRR(JI,JJ,JK)=PRR(JI,JJ,JK)-ZW(JI,JJ,JK)
+ PTH(JI,JJ,JK)=PTH(JI,JJ,JK)-ZW(JI,JJ,JK)*PLVFACT(JI,JJ,JK)
+
+ ZW(JI,JJ,JK)=MIN(MAX(PRS(JI,JJ,JK), 0.), &
+ &MAX(XRTMIN(1)-PRV(JI,JJ,JK), 0.)) ! Quantity of rs to convert into rv
+ PRV(JI,JJ,JK)=PRV(JI,JJ,JK)+ZW(JI,JJ,JK)
+ PRS(JI,JJ,JK)=PRS(JI,JJ,JK)-ZW(JI,JJ,JK)
+ PTH(JI,JJ,JK)=PTH(JI,JJ,JK)-ZW(JI,JJ,JK)*PLSFACT(JI,JJ,JK)
+
+ ZW(JI,JJ,JK)=MIN(MAX(PRG(JI,JJ,JK), 0.), &
+ &MAX(XRTMIN(1)-PRV(JI,JJ,JK), 0.)) ! Quantity of rg to convert into rv
+ PRV(JI,JJ,JK)=PRV(JI,JJ,JK)+ZW(JI,JJ,JK)
+ PRG(JI,JJ,JK)=PRG(JI,JJ,JK)-ZW(JI,JJ,JK)
+ PTH(JI,JJ,JK)=PTH(JI,JJ,JK)-ZW(JI,JJ,JK)*PLSFACT(JI,JJ,JK)
+ ENDDO
+ ENDDO
+ ENDDO
+
IF(KRR==7) THEN
- WHERE(PRV(:,:,:)<0. .AND. PRH(:,:,:)>0.)
- ZW(:,:,:)=MIN(PRH(:,:,:), -PRV(:,:,:)) ! Quantity of rh to convert into rv
- PRV(:,:,:)=PRV(:,:,:)+ZW(:,:,:)
- PRH(:,:,:)=PRH(:,:,:)-ZW(:,:,:)
- PTH(:,:,:)=PTH(:,:,:)-ZW(:,:,:)*PLSFACT(:,:,:)
- ENDWHERE
+ DO JK = 1, KKT
+ DO JJ = 1, KJT
+ DO JI = 1, KIT
+ ZW(JI,JJ,JK)=MIN(MAX(PRH(JI,JJ,JK), 0.), &
+ &MAX(XRTMIN(1)-PRV(JI,JJ,JK), 0.)) ! Quantity of rh to convert into rv
+ PRV(JI,JJ,JK)=PRV(JI,JJ,JK)+ZW(JI,JJ,JK)
+ PRH(JI,JJ,JK)=PRH(JI,JJ,JK)-ZW(JI,JJ,JK)
+ PTH(JI,JJ,JK)=PTH(JI,JJ,JK)-ZW(JI,JJ,JK)*PLSFACT(JI,JJ,JK)
+ ENDDO
+ ENDDO
+ ENDDO
ENDIF
!
!
END SUBROUTINE CORRECT_NEGATIVITIES
+!
END SUBROUTINE RAIN_ICE_RED
diff --git a/src/MNH/read_exsegn.f90 b/src/MNH/read_exsegn.f90
index 5d1bb1470..b238faa9a 100644
--- a/src/MNH/read_exsegn.f90
+++ b/src/MNH/read_exsegn.f90
@@ -299,6 +299,7 @@ END MODULE MODI_READ_EXSEG_n
! P. Wautelet 09/03/2021: move some chemistry initializations to ini_nsv
! P. Wautelet 10/03/2021: move scalar variable name initializations to ini_nsv
! R. Honnert 23/04/2021: add ADAP mixing length and delete HRIO and BOUT from CMF_UPDRAFT
+! S. Riette 11/05/2021 HighLow cloud
!------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -869,7 +870,11 @@ CALL TEST_NAM_VAR(ILUOUT,'CLBCY(2)',CLBCY(2),'CYCL','WALL','OPEN')
CALL TEST_NAM_VAR(ILUOUT,'CTURBDIM',CTURBDIM,'1DIM','3DIM')
CALL TEST_NAM_VAR(ILUOUT,'CTURBLEN',CTURBLEN,'DELT','BL89','RM17','DEAR','BLKR','ADAP')
CALL TEST_NAM_VAR(ILUOUT,'CTOM',CTOM,'NONE','TM06')
-CALL TEST_NAM_VAR(ILUOUT,'CSUBG_AUCV',CSUBG_AUCV,'NONE','CLFR','SIGM','PDF')
+CALL TEST_NAM_VAR(ILUOUT,'CSUBG_AUCV',CSUBG_AUCV,'NONE','CLFR','SIGM','PDF','ADJU')
+CALL TEST_NAM_VAR(ILUOUT,'CSUBG_AUCV_RI',CSUBG_AUCV_RI,'NONE','CLFR','ADJU')
+CALL TEST_NAM_VAR(ILUOUT,'CCONDENS',CCONDENS,'CB02','GAUS')
+CALL TEST_NAM_VAR(ILUOUT,'CLAMBDA3',CLAMBDA3,'CB','NONE')
+CALL TEST_NAM_VAR(ILUOUT,'CSUBG_MF_PDF',CSUBG_MF_PDF,'NONE','TRIANGLE')
!
CALL TEST_NAM_VAR(ILUOUT,'CCH_TDISCRETIZATION',CCH_TDISCRETIZATION, &
'SPLIT ','CENTER ','LAGGED ')
diff --git a/src/MNH/resolved_cloud.f90 b/src/MNH/resolved_cloud.f90
index 6d4e94f46..9de88ea5b 100644
--- a/src/MNH/resolved_cloud.f90
+++ b/src/MNH/resolved_cloud.f90
@@ -23,6 +23,7 @@ INTERFACE
PSOLORG,PMI, &
PSPEEDC, PSPEEDR, PSPEEDS, PSPEEDG, PSPEEDH, &
PINDEP, PSUPSAT, PNACT, PNPRO,PSSPRO, PRAINFR, &
+ PHLC_HRC, PHLC_HCF, PHLI_HRI, PHLI_HCF, &
PSEA,PTOWN )
!
USE MODD_IO, ONLY: TFILEDATA
@@ -132,8 +133,12 @@ REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PNACT !concentrtaion d'aérosols a
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PNPRO !concentrtaion d'aérosols activés au temps t
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSSPRO !sursat
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRAINFR ! Rain fraction
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PSEA ! Land Sea mask
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PTOWN ! Town fraction
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PHLC_HRC !HighLow liquid content
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PHLC_HCF !HighLow liquid cloud fraction
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PHLI_HRI !HighLow ice content
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PHLI_HCF !HighLow ice clous fraction
+REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PSEA ! Land Sea mask
+REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PTOWN ! Town fraction
!
END SUBROUTINE RESOLVED_CLOUD
END INTERFACE
@@ -156,6 +161,7 @@ END MODULE MODI_RESOLVED_CLOUD
PSOLORG,PMI, &
PSPEEDC, PSPEEDR, PSPEEDS, PSPEEDG, PSPEEDH, &
PINDEP, PSUPSAT, PNACT, PNPRO,PSSPRO, PRAINFR, &
+ PHLC_HRC, PHLC_HCF, PHLI_HRI, PHLI_HCF, &
PSEA,PTOWN )
! ##########################################################################
!
@@ -294,6 +300,7 @@ USE MODD_PARAM_LIMA, ONLY: LCOLD, LRAIN, LWARM, XCONC_CCN_TOT, NMOD_CCN, NMO
YRTMIN=>XRTMIN, YCTMIN=>XCTMIN
USE MODD_RAIN_ICE_DESCR, ONLY: XRTMIN
USE MODD_SALT, ONLY: LSALT
+USE MODD_TURB_n, ONLY: CSUBG_AUCV_RI, CCONDENS, CLAMBDA3, CSUBG_MF_PDF
!
USE MODE_ll
use mode_sources_neg_correct, only: Sources_neg_correct
@@ -423,8 +430,12 @@ REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PNACT !concentrtaion d'aérosols a
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PNPRO !concentrtaion d'aérosols activés au temps t
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSSPRO !sursat
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRAINFR ! Rain fraction
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PSEA ! Land Sea mask
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PTOWN ! Town fraction
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PHLC_HRC !HighLow liquid content
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PHLC_HCF !HighLow liquid cloud fraction
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PHLI_HRI !HighLow ice content
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PHLI_HCF !HighLow ice clous fraction
+REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PSEA ! Land Sea mask
+REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PTOWN ! Town fraction
!
!
!* 0.2 Declarations of local variables :
@@ -725,17 +736,20 @@ SELECT CASE ( HCLOUD )
ENDDO
ZZZ = MZF( PZZ )
IF(LRED .AND. LADJ_BEFORE) THEN
- CALL ICE_ADJUST (1,IKU,1, KRR, CFRAC_ICE_ADJUST, 'ADJU', &
- OSUBG_COND, OSIGMAS, PTSTEP,PSIGQSAT, &
- PRHODJ, PEXNREF, PSIGS, PMFCONV, PPABST, ZZZ, &
- ZEXN, PCF_MF,PRC_MF,PRI_MF, &
+ CALL ICE_ADJUST (1, IKU, 1, KRR, CFRAC_ICE_ADJUST, CCONDENS, CLAMBDA3, &
+ 'ADJU', OSUBG_COND, OSIGMAS, CSUBG_MF_PDF, &
+ PTSTEP, PSIGQSAT, &
+ PRHODJ, PEXNREF, PRHODREF, PSIGS, PMFCONV, PPABST, ZZZ, &
+ ZEXN, PCF_MF, PRC_MF, PRI_MF, &
PRV=PRS(:,:,:,1)*PTSTEP, PRC=PRS(:,:,:,2)*PTSTEP, &
PRVS=PRS(:,:,:,1), PRCS=PRS(:,:,:,2), &
PTH=PTHS*PTSTEP, PTHS=PTHS, PSRCS=PSRCS, PCLDFR=PCLDFR, &
PRR=PRS(:,:,:,3)*PTSTEP, &
PRI=PRS(:,:,:,4)*PTSTEP, PRIS=PRS(:,:,:,4), &
PRS=PRS(:,:,:,5)*PTSTEP, &
- PRG=PRS(:,:,:,6)*PTSTEP )
+ PRG=PRS(:,:,:,6)*PTSTEP, &
+ PHLC_HRC=PHLC_HRC, PHLC_HCF=PHLC_HCF, &
+ PHLI_HRI=PHLI_HRI, PHLI_HCF=PHLI_HCF )
ENDIF
IF (LRED) THEN
LLMICRO(:,:,:)=PRT(:,:,:,2)>XRTMIN(2) .OR. &
@@ -749,16 +763,20 @@ SELECT CASE ( HCLOUD )
PRS(:,:,:,4)>ZRSMIN(4) .OR. &
PRS(:,:,:,5)>ZRSMIN(5) .OR. &
PRS(:,:,:,6)>ZRSMIN(6)
- CALL RAIN_ICE_RED ( OSEDIC,CSEDIM, HSUBG_AUCV, OWARM,1,IKU,1, &
+ CALL RAIN_ICE_RED (SIZE(PTHT, 1), SIZE(PTHT, 2), SIZE(PTHT, 3), COUNT(LLMICRO), &
+ OSEDIC, CSEDIM, HSUBG_AUCV, CSUBG_AUCV_RI, &
+ OWARM,1,IKU,1, &
PTSTEP, KRR, LLMICRO, ZEXN, &
ZDZZ, PRHODJ, PRHODREF, PEXNREF, PPABST, PCIT,PCLDFR,&
+ PHLC_HRC, PHLC_HCF, PHLI_HRI, PHLI_HCF, &
PTHT, PRT(:,:,:,1), PRT(:,:,:,2), &
PRT(:,:,:,3), PRT(:,:,:,4), &
PRT(:,:,:,5), PRT(:,:,:,6), &
PTHS, PRS(:,:,:,1), PRS(:,:,:,2), PRS(:,:,:,3), &
PRS(:,:,:,4), PRS(:,:,:,5), PRS(:,:,:,6), &
PINPRC,PINPRR, PINPRR3D, PEVAP3D, &
- PINPRS, PINPRG, PSIGS, PINDEP, PRAINFR, PSEA,PTOWN, PFPR=ZFPR)
+ PINPRS, PINPRG, PINDEP, PRAINFR, PSIGS, &
+ PSEA,PTOWN, PFPR=ZFPR )
ELSE
CALL RAIN_ICE ( OSEDIC,CSEDIM, HSUBG_AUCV, OWARM,1,IKU,1, &
KSPLITR, PTSTEP, KRR, &
@@ -777,17 +795,20 @@ SELECT CASE ( HCLOUD )
!
!
IF (.NOT. LRED .OR. (LRED .AND. LADJ_AFTER) ) THEN
- 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, &
- PRV=PRS(:,:,:,1)*PTSTEP, PRC=PRS(:,:,:,2)*PTSTEP, &
- PRVS=PRS(:,:,:,1), PRCS=PRS(:,:,:,2), &
- PTH=PTHS*PTSTEP, PTHS=PTHS, PSRCS=PSRCS, PCLDFR=PCLDFR, &
- PRR=PRS(:,:,:,3)*PTSTEP, &
- PRI=PRS(:,:,:,4)*PTSTEP, PRIS=PRS(:,:,:,4), &
- PRS=PRS(:,:,:,5)*PTSTEP, &
- PRG=PRS(:,:,:,6)*PTSTEP )
+ CALL ICE_ADJUST (1, IKU, 1, KRR, CFRAC_ICE_ADJUST, CCONDENS, CLAMBDA3, &
+ 'CDEPI', OSUBG_COND, OSIGMAS, CSUBG_MF_PDF, &
+ PTSTEP, PSIGQSAT, &
+ PRHODJ, PEXNREF, PRHODREF, PSIGS, PMFCONV, PPABST, ZZZ, &
+ ZEXN, PCF_MF, PRC_MF, PRI_MF, &
+ PRV=PRS(:,:,:,1)*PTSTEP, PRC=PRS(:,:,:,2)*PTSTEP, &
+ PRVS=PRS(:,:,:,1), PRCS=PRS(:,:,:,2), &
+ PTH=PTHS*PTSTEP, PTHS=PTHS, PSRCS=PSRCS, PCLDFR=PCLDFR, &
+ PRR=PRS(:,:,:,3)*PTSTEP, &
+ PRI=PRS(:,:,:,4)*PTSTEP, PRIS=PRS(:,:,:,4), &
+ PRS=PRS(:,:,:,5)*PTSTEP, &
+ PRG=PRS(:,:,:,6)*PTSTEP, &
+ PHLC_HRC=PHLC_HRC, PHLC_HCF=PHLC_HCF, &
+ PHLI_HRI=PHLI_HRI, PHLI_HCF=PHLI_HCF )
END IF
deallocate( zexn )
@@ -808,18 +829,21 @@ SELECT CASE ( HCLOUD )
ENDDO
ZZZ = MZF( PZZ )
IF(LRED .AND. LADJ_BEFORE) THEN
- CALL ICE_ADJUST (1,IKU,1, KRR, CFRAC_ICE_ADJUST, 'ADJU', &
- OSUBG_COND, OSIGMAS, PTSTEP,PSIGQSAT, &
- PRHODJ, PEXNREF, PSIGS, PMFCONV, PPABST, ZZZ, &
- ZEXN, PCF_MF,PRC_MF,PRI_MF, &
- PRV=PRS(:,:,:,1)*PTSTEP, PRC=PRS(:,:,:,2)*PTSTEP, &
- PRVS=PRS(:,:,:,1), PRCS=PRS(:,:,:,2), &
- PTH=PTHS*PTSTEP, PTHS=PTHS, PSRCS=PSRCS, PCLDFR=PCLDFR, &
- PRR=PRS(:,:,:,3)*PTSTEP, &
- PRI=PRS(:,:,:,4)*PTSTEP, PRIS=PRS(:,:,:,4), &
- PRS=PRS(:,:,:,5)*PTSTEP, &
- PRG=PRS(:,:,:,6)*PTSTEP, &
- PRH=PRS(:,:,:,7)*PTSTEP )
+ CALL ICE_ADJUST (1, IKU, 1, KRR, CFRAC_ICE_ADJUST, CCONDENS, CLAMBDA3, &
+ 'ADJU', OSUBG_COND, OSIGMAS, CSUBG_MF_PDF, &
+ PTSTEP, PSIGQSAT, &
+ PRHODJ, PEXNREF, PRHODREF, PSIGS, PMFCONV, PPABST, ZZZ, &
+ ZEXN, PCF_MF, PRC_MF, PRI_MF, &
+ PRV=PRS(:,:,:,1)*PTSTEP, PRC=PRS(:,:,:,2)*PTSTEP, &
+ PRVS=PRS(:,:,:,1), PRCS=PRS(:,:,:,2), &
+ PTH=PTHS*PTSTEP, PTHS=PTHS, PSRCS=PSRCS, PCLDFR=PCLDFR, &
+ PRR=PRS(:,:,:,3)*PTSTEP, &
+ PRI=PRS(:,:,:,4)*PTSTEP, PRIS=PRS(:,:,:,4), &
+ PRS=PRS(:,:,:,5)*PTSTEP, &
+ PRG=PRS(:,:,:,6)*PTSTEP, &
+ PRH=PRS(:,:,:,7)*PTSTEP, &
+ PHLC_HRC=PHLC_HRC, PHLC_HCF=PHLC_HCF, &
+ PHLI_HRI=PHLI_HRI, PHLI_HCF=PHLI_HCF )
ENDIF
IF (LRED) THEN
LLMICRO(:,:,:)=PRT(:,:,:,2)>XRTMIN(2) .OR. &
@@ -835,16 +859,19 @@ SELECT CASE ( HCLOUD )
PRS(:,:,:,5)>ZRSMIN(5) .OR. &
PRS(:,:,:,6)>ZRSMIN(6) .OR. &
PRS(:,:,:,7)>ZRSMIN(7)
- CALL RAIN_ICE_RED ( OSEDIC,CSEDIM, HSUBG_AUCV, OWARM,1,IKU,1, &
- PTSTEP, KRR, LLMICRO, ZEXN, &
+ CALL RAIN_ICE_RED (SIZE(PTHT, 1), SIZE(PTHT, 2), SIZE(PTHT, 3), COUNT(LLMICRO), &
+ OSEDIC, CSEDIM, HSUBG_AUCV, CSUBG_AUCV_RI,&
+ OWARM, 1, IKU, 1, &
+ PTSTEP, KRR, LLMICRO, ZEXN, &
ZDZZ, PRHODJ, PRHODREF, PEXNREF, PPABST, PCIT, PCLDFR,&
+ PHLC_HRC, PHLC_HCF, PHLI_HRI, PHLI_HCF,&
PTHT, PRT(:,:,:,1), PRT(:,:,:,2), &
PRT(:,:,:,3), PRT(:,:,:,4), &
PRT(:,:,:,5), PRT(:,:,:,6), &
PTHS, PRS(:,:,:,1), PRS(:,:,:,2), PRS(:,:,:,3), &
PRS(:,:,:,4), PRS(:,:,:,5), PRS(:,:,:,6), &
PINPRC, PINPRR, PINPRR3D, PEVAP3D, &
- PINPRS, PINPRG, PSIGS, PINDEP, PRAINFR, PSEA, PTOWN, &
+ PINPRS, PINPRG, PINDEP, PRAINFR, PSIGS, PSEA, PTOWN, &
PRT(:,:,:,7), PRS(:,:,:,7), PINPRH, PFPR=ZFPR )
ELSE
CALL RAIN_ICE ( OSEDIC,CSEDIM, HSUBG_AUCV, OWARM,1,IKU,1, &
@@ -866,18 +893,21 @@ 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, 'CDEPI', &
- OSUBG_COND, OSIGMAS, PTSTEP,PSIGQSAT, &
- PRHODJ, PEXNREF, PSIGS, PMFCONV, PPABST, ZZZ, &
- ZEXN, PCF_MF,PRC_MF,PRI_MF, &
- PRV=PRS(:,:,:,1)*PTSTEP, PRC=PRS(:,:,:,2)*PTSTEP, &
- PRVS=PRS(:,:,:,1), PRCS=PRS(:,:,:,2), &
- PTH=PTHS*PTSTEP, PTHS=PTHS, PSRCS=PSRCS, PCLDFR=PCLDFR, &
- PRR=PRS(:,:,:,3)*PTSTEP, &
- PRI=PRS(:,:,:,4)*PTSTEP, PRIS=PRS(:,:,:,4), &
- PRS=PRS(:,:,:,5)*PTSTEP, &
- PRG=PRS(:,:,:,6)*PTSTEP, &
- PRH=PRS(:,:,:,7)*PTSTEP )
+ CALL ICE_ADJUST (1, IKU, 1, KRR, CFRAC_ICE_ADJUST, CCONDENS, CLAMBDA3, &
+ 'CDEPI', OSUBG_COND, OSIGMAS, CSUBG_MF_PDF, &
+ PTSTEP, PSIGQSAT, &
+ PRHODJ, PEXNREF, PRHODREF, PSIGS, PMFCONV, PPABST, ZZZ, &
+ ZEXN, PCF_MF, PRC_MF, PRI_MF, &
+ PRV=PRS(:,:,:,1)*PTSTEP, PRC=PRS(:,:,:,2)*PTSTEP, &
+ PRVS=PRS(:,:,:,1), PRCS=PRS(:,:,:,2), &
+ PTH=PTHS*PTSTEP, PTHS=PTHS, PSRCS=PSRCS, PCLDFR=PCLDFR, &
+ PRR=PRS(:,:,:,3)*PTSTEP, &
+ PRI=PRS(:,:,:,4)*PTSTEP, PRIS=PRS(:,:,:,4), &
+ PRS=PRS(:,:,:,5)*PTSTEP, &
+ PRG=PRS(:,:,:,6)*PTSTEP, &
+ PRH=PRS(:,:,:,7)*PTSTEP, &
+ PHLC_HRC=PHLC_HRC, PHLC_HCF=PHLC_HCF, &
+ PHLI_HRI=PHLI_HRI, PHLI_HCF=PHLI_HCF )
END IF
deallocate( zexn )
--
GitLab