diff --git a/src/MNH/advection_metsv.f90 b/src/MNH/advection_metsv.f90
index 8473c5a3b9f58609ef24a788a49f2153056a0380..9b5ae514068e386a8fd592e8a7549774048ab10d 100644
--- a/src/MNH/advection_metsv.f90
+++ b/src/MNH/advection_metsv.f90
@@ -9,8 +9,8 @@
!
INTERFACE
SUBROUTINE ADVECTION_METSV (TPFILE, HUVW_ADV_SCHEME, &
- HMET_ADV_SCHEME,HSV_ADV_SCHEME, HCLOUD, KSPLIT, &
- OSPLIT_CFL, PSPLIT_CFL, OCFL_WRIT, &
+ HMET_ADV_SCHEME,HSV_ADV_SCHEME, HCLOUD, HELEC, &
+ KSPLIT, OSPLIT_CFL, PSPLIT_CFL, OCFL_WRIT, &
HLBCX, HLBCY, KRR, KSV, TPDTCUR, PTSTEP, &
PUT, PVT, PWT, PTHT, PRT, PTKET, PSVT, PPABST, &
PTHVREF, PRHODJ, PDXX, PDYY, PDZZ, PDZX, PDZY, &
@@ -25,6 +25,7 @@ CHARACTER(LEN=6), INTENT(IN) :: HMET_ADV_SCHEME, & ! Control of the
HSV_ADV_SCHEME, & ! scheme applied
HUVW_ADV_SCHEME
CHARACTER (LEN=4), INTENT(IN) :: HCLOUD ! Kind of cloud parameterization
+CHARACTER (LEN=4), INTENT(IN) :: HELEC ! Kind of cloud electricity parameterization
!
INTEGER, INTENT(INOUT):: KSPLIT ! Number of time splitting
! for PPM advection
@@ -64,8 +65,8 @@ END INTERFACE
END MODULE MODI_ADVECTION_METSV
! ##########################################################################
SUBROUTINE ADVECTION_METSV (TPFILE, HUVW_ADV_SCHEME, &
- HMET_ADV_SCHEME,HSV_ADV_SCHEME, HCLOUD, KSPLIT, &
- OSPLIT_CFL, PSPLIT_CFL, OCFL_WRIT, &
+ HMET_ADV_SCHEME,HSV_ADV_SCHEME, HCLOUD, HELEC, &
+ KSPLIT, OSPLIT_CFL, PSPLIT_CFL, OCFL_WRIT, &
HLBCX, HLBCY, KRR, KSV, TPDTCUR, PTSTEP, &
PUT, PVT, PWT, PTHT, PRT, PTKET, PSVT, PPABST, &
PTHVREF, PRHODJ, PDXX, PDYY, PDZZ, PDZX, PDZY, &
@@ -140,6 +141,7 @@ END MODULE MODI_ADVECTION_METSV
! P. Wautelet 11/06/2020: bugfix: correct PRSVS array indices
! P. Wautelet + Benoît Vié 06/2020: improve removal of negative scalar variables + adapt the corresponding budgets
! P. Wautelet 30/06/2020: move removal of negative scalar variables to Sources_neg_correct
+! C. Barthe 08/02/2022: add HELEC in arguments of Sources_neg_correct
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -191,6 +193,7 @@ CHARACTER(LEN=6), INTENT(IN) :: HMET_ADV_SCHEME, & ! Control of the
HSV_ADV_SCHEME, & ! scheme applied
HUVW_ADV_SCHEME
CHARACTER (LEN=4), INTENT(IN) :: HCLOUD ! Kind of cloud parameterization
+CHARACTER (LEN=4), INTENT(IN) :: HELEC ! Kind of cloud electricity parameterization
!
INTEGER, INTENT(INOUT):: KSPLIT ! Number of time splitting
! for PPM advection
@@ -712,7 +715,7 @@ if ( lbudget_sv) then
end if
! Remove non-physical negative values (unnecessary in a perfect world) + corresponding budgets
-call Sources_neg_correct( hcloud, 'NEADV', krr, ptstep, ppabst, ptht, prt, prths, prrs, prsvs )
+call Sources_neg_correct( hcloud, helec, 'NEADV', krr, ptstep, ppabst, ptht, prt, prths, prrs, prsvs )
!-------------------------------------------------------------------------------
!
diff --git a/src/MNH/boundaries.f90 b/src/MNH/boundaries.f90
index 04860f27e0b15748eb3c9d075427d97f3dc803b9..91597d8be0029568c74e22c0888d87487b33b386 100644
--- a/src/MNH/boundaries.f90
+++ b/src/MNH/boundaries.f90
@@ -186,8 +186,7 @@ USE MODD_CONF
USE MODD_TURB_n, ONLY : XTKEMIN
USE MODD_DUST
USE MODD_GRID_n, ONLY : XZZ
-USE MODD_ELEC_DESCR
-USE MODD_ELEC_n
+USE MODD_ELEC_n, ONLY : XCION_POS_FW, XCION_NEG_FW
#ifdef MNH_FOREFIRE
USE MODD_FOREFIRE, ONLY : LFOREFIRE
#endif
diff --git a/src/MNH/compute_lambda.f90 b/src/MNH/compute_lambda.f90
new file mode 100644
index 0000000000000000000000000000000000000000..3d0ecce76a3ea1b9ef88bb639f64d51da0e8fb5d
--- /dev/null
+++ b/src/MNH/compute_lambda.f90
@@ -0,0 +1,224 @@
+!
+! ##########################
+ MODULE MODI_COMPUTE_LAMBDA
+! ##########################
+!
+INTERFACE
+ SUBROUTINE COMPUTE_LAMBDA (KID, KMOMENT, KSIZE, &
+ PRHO, PRTMIN, PRX, PCX, PLBDX)
+!
+INTEGER, INTENT(IN) :: KID ! nb of the hydrometeor category
+INTEGER, INTENT(IN) :: KMOMENT ! nb of moments of the microphysics scheme
+INTEGER, INTENT(IN) :: KSIZE
+REAL, INTENT(IN) :: PRTMIN
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHO ! reference density
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PRX ! Mixing ratio
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PCX ! Nb concentration
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PLBDX ! Slope parameter of the distribution
+!
+END SUBROUTINE COMPUTE_LAMBDA
+END INTERFACE
+END MODULE MODI_COMPUTE_LAMBDA
+!
+!
+! #########################################################
+ SUBROUTINE COMPUTE_LAMBDA (KID, KMOMENT, KSIZE, &
+ PRHO, PRTMIN, PRX, PCX, PLBDX)
+! #########################################################
+!
+! Purpose : compute lambda, the slope parameter of the distribution
+! - for 1-moment species: lbda_x = [(rho r_x) / (a_x C_x G(b/alpha))]^(1/(x-b))
+! - for 2-moment species: lbda_x = [(rho r_x) / (a_x N_x G(b/alpha))]^(-1/b)
+!
+! AUTHOR
+! ------
+! C. Barthe * LAERO *
+!
+! MODIFICATIONS
+! -------------
+! Original June 2022
+! C. Barthe 12/07/23 adapt the code for LIMA2
+!
+!------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_PARAM_n, ONLY: CCLOUD
+USE MODD_RAIN_ICE_DESCR_n, ONLY: XLBC_I=>XLBC, XLBR_I=>XLBR, XLBI_I=>XLBI, XLBS_I=>XLBS, XLBG_I=>XLBG, XLBH_I=>XLBH, &
+ XLBEXC_I=>XLBEXC, XLBEXR_I=>XLBEXR, XLBEXI_I=>XLBEXI, XLBEXS_I=>XLBEXS, &
+ XLBEXG_I=>XLBEXG, XLBEXH_I=>XLBEXH, &
+ XLBDAS_MAX_I=>XLBDAS_MAX, &
+ XCCR_I=>XCCR, XCCS_I=>XCCS, XCCG_I=>XCCG, XCCH_I=>XCCH, &
+ XCXS_I=>XCXS, XCXG_I=>XCXG, XCXH_I=>XCXH
+USE MODD_ELEC_DESCR, ONLY: XCXR_I=>XCXR
+USE MODD_PARAM_LIMA_WARM, ONLY: XLBC_L=>XLBC, XLBR_L=>XLBR, XLBEXC_L=>XLBEXC, XLBEXR_L=>XLBEXR, &
+ XCXR_L=>XCXR, XCCR_L=>XCCR
+USE MODD_PARAM_LIMA_COLD, ONLY: XLBI_L=>XLBI, XLBS_L=>XLBS, XLBEXI_L=>XLBEXI, XLBEXS_L=>XLBEXS, &
+ XLBDAS_MAX_L=>XLBDAS_MAX, &
+ XCXS_L=>XCXS, XCCS_L=>XCCS
+USE MODD_PARAM_LIMA_MIXED, ONLY: XLBG_L=>XLBG, XLBH_L=>XLBH, XLBEXG_L=>XLBEXG, XLBEXH_L=>XLBEXH, &
+ XCXG_L=>XCXG, XCCG_L=>XCCG, XCXH_L=>XCXH, XCCH_L=>XCCH
+!
+USE MODI_MOMG
+!
+IMPLICIT NONE
+!
+!* 0.1 Declaration of dummy arguments
+!
+INTEGER, INTENT(IN) :: KID ! nb of the hydrometeor category
+INTEGER, INTENT(IN) :: KMOMENT ! nb of moments of the microphysics scheme
+INTEGER, INTENT(IN) :: KSIZE
+REAL, INTENT(IN) :: PRTMIN
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHO ! reference density
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PRX ! Mixing ratio
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PCX ! Nb concentration
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PLBDX ! Slope parameter of the distribution
+!
+!* 0.2 Declaration of local variables
+!
+REAL :: ZRTMIN, ZLBX, ZLBEX, ZLBDAX_MAX, ZCCX, ZCXX
+!
+!---------------------------------------------------------------------------------
+!
+!* 1. PRELIMINARIES
+! -------------
+!
+ZRTMIN = PRTMIN
+!
+IF (KID == 2) THEN
+ IF (CCLOUD == 'LIMA' .AND. KMOMENT == 2) THEN
+ ZLBX = XLBC_L
+ ZLBEX = XLBEXC_L
+! ELSE
+! print*, 'ERROR: the computation of lambda_c is not available if c is 1-moment species'
+ END IF
+ELSE IF (KID == 3) THEN
+ IF (CCLOUD == 'LIMA') THEN
+ ZLBX = XLBR_L
+ ZLBEX = XLBEXR_L
+ IF (KMOMENT == 1) THEN
+ ZCCX = XCCR_L
+ ZCXX = XCXR_L
+ END IF
+ ELSE IF (CCLOUD(1:3) == 'ICE') THEN
+ ZLBX = XLBR_I
+ ZLBEX = XLBEXR_I
+ ZCCX = XCCR_I
+ ZCXX = XCXR_I
+ ELSE
+ PRINT*, 'ERROR: something wrong with the computation of lambda_r'
+ END IF
+ELSE IF (KID == 4) THEN
+ IF (CCLOUD == 'LIMA') THEN
+ ZLBX = XLBI_L
+ ZLBEX = XLBEXI_L
+ ELSE IF (CCLOUD(1:3) == 'ICE') THEN
+ ZLBX = XLBI_I
+ ZLBEX = XLBEXI_I
+ ELSE
+ PRINT*, 'ERROR: something wrong with the computation of lambda_i'
+ END IF
+ELSE IF (KID == 5) THEN
+ IF (CCLOUD == 'LIMA') THEN
+ ZLBX = XLBS_L
+ ZLBEX = XLBEXS_L
+ ZLBDAX_MAX = XLBDAS_MAX_L
+ IF (KMOMENT == 1) THEN
+ ZCCX = XCCS_L
+ ZCXX = XCXS_L
+ END IF
+ ELSE IF (CCLOUD(1:3) == 'ICE') THEN
+ ZLBX = XLBS_I
+ ZLBEX = XLBEXS_I
+ ZLBDAX_MAX = XLBDAS_MAX_I
+ ZCCX = XCCS_I
+ ZCXX = XCXS_I
+ ELSE
+ PRINT*, 'ERROR: something wrong with the computation of lambda_s'
+ END IF
+ELSE IF (KID == 6) THEN
+ IF (CCLOUD == 'LIMA') THEN ! .AND. KMOMENT == 1) THEN
+ ZLBX = XLBG_L
+ ZLBEX = XLBEXG_L
+ IF (KMOMENT == 1) THEN
+ ZCCX = XCCG_L
+ ZCXX = XCXG_L
+ END IF
+ ELSE IF (CCLOUD(1:3) == 'ICE') THEN
+ ZLBX = XLBG_I
+ ZLBEX = XLBEXG_I
+ ZCCX = XCCG_I
+ ZCXX = XCXG_I
+ ELSE
+ PRINT*, 'ERROR: something wrong with the computation of lambda_g'
+ END IF
+ELSE IF (KID == 7) THEN
+ IF (CCLOUD == 'LIMA') THEN ! .AND. KMOMENT == 1) THEN
+ ZLBX = XLBH_L
+ ZLBEX = XLBEXH_L
+ IF (KMOMENT == 1) THEN
+ ZCCX = XCCH_L
+ ZCXX = XCXH_L
+ END IF
+ ELSE IF (CCLOUD(1:3) == 'ICE') THEN
+ ZLBX = XLBH_I
+ ZLBEX = XLBEXH_I
+ ZCCX = XCCH_I
+ ZCXX = XCXH_I
+ ELSE
+ PRINT*, 'ERROR: something wrong with the computation of lambda_h'
+ END IF
+END IF
+!
+PLBDX(:) = 0. !1.E10
+!
+!
+!* 2. COMPUTE LBDA_x FOR 2-MOMENT SPECIES
+! -----------------------------------
+!
+IF (KMOMENT == 2) THEN
+ WHERE (PRX(:) > ZRTMIN .AND. PCX(:) > 0.)
+ PLBDX(:) = (ZLBX * PCX(:) / PRX(:))**ZLBEX
+ END WHERE
+ IF (KID == 5) PLBDX(:) = MIN(ZLBDAX_MAX, PLBDX(:))
+!
+!
+!* 3. COMPUTE LBDA_x and N_x FOR 1-MOMENT SPECIES
+! -------------------------------------------
+!
+ELSE IF (KMOMENT == 1) THEN
+!
+!* 3.1 Special case of cloud droplets
+!
+ IF (KID == 2) THEN
+! print*, 'computation of lambda_c in 1-moment configuration not treated'
+!
+!* 3.2 Special case of ice crystals
+!
+ ELSE IF (KID == 4) THEN
+! formulation utilisee dans rain_ice_fast_ri
+ WHERE (PRX(:) > ZRTMIN .AND. PCX(:) > 0.0)
+ PLBDX(:) = ZLBX * (PRHO(:) * PRX(:) / PCX(:))**ZLBEX
+ ENDWHERE
+!
+!* 3.3 Special case of snow
+!
+ ELSE IF (KID == 5) THEN
+! limitation of lbdas
+ WHERE (PRX(:) > ZRTMIN)
+ PLBDX(:) = MIN(200000., ZLBX * (PRHO(:) * PRX(:))**ZLBEX)
+ PCX(:) = ZCCX * PLBDX(:)**ZCXX / PRHO(:)
+ ENDWHERE
+!
+!* 3.4 Computation for all other hydrometeors
+!
+ ELSE
+ WHERE (PRX(:) > ZRTMIN)
+ PLBDX(:) = ZLBX * (PRHO(:) * PRX(:))**ZLBEX
+ PCX(:) = ZCCX * PLBDX(:)**ZCXX / PRHO(:)
+ ENDWHERE
+ END IF
+END IF
+!
+END SUBROUTINE COMPUTE_LAMBDA
diff --git a/src/MNH/compute_lambda_3d.f90 b/src/MNH/compute_lambda_3d.f90
new file mode 100644
index 0000000000000000000000000000000000000000..93457a2d3537e0532dfb8d5d23724c70c1aedece
--- /dev/null
+++ b/src/MNH/compute_lambda_3d.f90
@@ -0,0 +1,222 @@
+!
+! #############################
+ MODULE MODI_COMPUTE_LAMBDA_3D
+! #############################
+!
+INTERFACE
+ SUBROUTINE COMPUTE_LAMBDA_3D (KID, KMOMENT, &
+ PRHO, PRTMIN, PRX, PCX, PLBDX)
+!
+INTEGER, INTENT(IN) :: KID ! nb of the hydrometeor category
+INTEGER, INTENT(IN) :: KMOMENT ! nb of moments of the microphysics scheme
+REAL, INTENT(IN) :: PRTMIN
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHO ! reference density
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRX ! Mixing ratio
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCX ! Nb concentration
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PLBDX ! Slope parameter of the distribution
+!
+END SUBROUTINE COMPUTE_LAMBDA_3D
+END INTERFACE
+END MODULE MODI_COMPUTE_LAMBDA_3D
+!
+!
+! #########################################################
+ SUBROUTINE COMPUTE_LAMBDA_3D (KID, KMOMENT, &
+ PRHO, PRTMIN, PRX, PCX, PLBDX)
+! #########################################################
+!
+! Purpose : compute lambda, the slope parameter of the distribution
+! - for 1-moment species: lbda_x = [(rho r_x) / (a_x C_x G(b/alpha))]^(1/(x-b))
+! - for 2-moment species: lbda_x = [(rho r_x) / (a_x N_x G(b/alpha))]^(-1/b)
+!
+! AUTHOR
+! ------
+! C. Barthe * LAERO *
+!
+! MODIFICATIONS
+! -------------
+! Original September 2023
+!
+!------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_PARAM_n, ONLY: CCLOUD
+USE MODD_RAIN_ICE_DESCR_n, ONLY: XLBC_I=>XLBC, XLBR_I=>XLBR, XLBI_I=>XLBI, XLBS_I=>XLBS, XLBG_I=>XLBG, XLBH_I=>XLBH, &
+ XLBEXC_I=>XLBEXC, XLBEXR_I=>XLBEXR, XLBEXI_I=>XLBEXI, XLBEXS_I=>XLBEXS, &
+ XLBEXG_I=>XLBEXG, XLBEXH_I=>XLBEXH, &
+ XLBDAS_MAX_I=>XLBDAS_MAX, &
+ XCCR_I=>XCCR, XCCS_I=>XCCS, XCCG_I=>XCCG, XCCH_I=>XCCH, &
+ XCXS_I=>XCXS, XCXG_I=>XCXG, XCXH_I=>XCXH
+USE MODD_ELEC_DESCR, ONLY: XCXR_I=>XCXR
+USE MODD_PARAM_LIMA_WARM, ONLY: XLBC_L=>XLBC, XLBR_L=>XLBR, XLBEXC_L=>XLBEXC, XLBEXR_L=>XLBEXR, &
+ XCXR_L=>XCXR, XCCR_L=>XCCR
+USE MODD_PARAM_LIMA_COLD, ONLY: XLBI_L=>XLBI, XLBS_L=>XLBS, XLBEXI_L=>XLBEXI, XLBEXS_L=>XLBEXS, &
+ XLBDAS_MAX_L=>XLBDAS_MAX, &
+ XCXS_L=>XCXS, XCCS_L=>XCCS
+USE MODD_PARAM_LIMA_MIXED, ONLY: XLBG_L=>XLBG, XLBH_L=>XLBH, XLBEXG_L=>XLBEXG, XLBEXH_L=>XLBEXH, &
+ XCXG_L=>XCXG, XCCG_L=>XCCG, XCXH_L=>XCXH, XCCH_L=>XCCH
+!
+USE MODI_MOMG
+!
+IMPLICIT NONE
+!
+!* 0.1 Declaration of dummy arguments
+!
+INTEGER, INTENT(IN) :: KID ! nb of the hydrometeor category
+INTEGER, INTENT(IN) :: KMOMENT ! nb of moments of the microphysics scheme
+REAL, INTENT(IN) :: PRTMIN
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHO ! reference density
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRX ! Mixing ratio
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCX ! Nb concentration
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PLBDX ! Slope parameter of the distribution
+!
+!* 0.2 Declaration of local variables
+!
+REAL :: ZRTMIN, ZLBX, ZLBEX, ZLBDAX_MAX, ZCCX, ZCXX
+!
+!---------------------------------------------------------------------------------
+!
+!* 1. PRELIMINARIES
+! -------------
+!
+ZRTMIN = PRTMIN
+!
+IF (KID == 2) THEN
+ IF (CCLOUD == 'LIMA' .AND. KMOMENT == 2) THEN
+ ZLBX = XLBC_L
+ ZLBEX = XLBEXC_L
+! ELSE
+! print*, 'ERROR: the computation of lambda_c is not available if c is 1-moment species'
+ END IF
+ELSE IF (KID == 3) THEN
+ IF (CCLOUD == 'LIMA') THEN
+ ZLBX = XLBR_L
+ ZLBEX = XLBEXR_L
+ IF (KMOMENT == 1) THEN
+ ZCCX = XCCR_L
+ ZCXX = XCXR_L
+ END IF
+ ELSE IF (CCLOUD(1:3) == 'ICE') THEN
+ ZLBX = XLBR_I
+ ZLBEX = XLBEXR_I
+ ZCCX = XCCR_I
+ ZCXX = XCXR_I
+ ELSE
+ PRINT*, 'ERROR: something wrong with the computation of lambda_r'
+ END IF
+ELSE IF (KID == 4) THEN
+ IF (CCLOUD == 'LIMA') THEN
+ ZLBX = XLBI_L
+ ZLBEX = XLBEXI_L
+ ELSE IF (CCLOUD(1:3) == 'ICE') THEN
+ ZLBX = XLBI_I
+ ZLBEX = XLBEXI_I
+ ELSE
+ PRINT*, 'ERROR: something wrong with the computation of lambda_i'
+ END IF
+ELSE IF (KID == 5) THEN
+ IF (CCLOUD == 'LIMA') THEN
+ ZLBX = XLBS_L
+ ZLBEX = XLBEXS_L
+ ZLBDAX_MAX = XLBDAS_MAX_L
+ IF (KMOMENT == 1) THEN
+ ZCCX = XCCS_L
+ ZCXX = XCXS_L
+ END IF
+ ELSE IF (CCLOUD(1:3) == 'ICE') THEN
+ ZLBX = XLBS_I
+ ZLBEX = XLBEXS_I
+ ZLBDAX_MAX = XLBDAS_MAX_I
+ ZCCX = XCCS_I
+ ZCXX = XCXS_I
+ ELSE
+ PRINT*, 'ERROR: something wrong with the computation of lambda_s'
+ END IF
+ELSE IF (KID == 6) THEN
+ IF (CCLOUD == 'LIMA') THEN ! .AND. KMOMENT == 1) THEN
+ ZLBX = XLBG_L
+ ZLBEX = XLBEXG_L
+ IF (KMOMENT == 1) THEN
+ ZCCX = XCCG_L
+ ZCXX = XCXG_L
+ END IF
+ ELSE IF (CCLOUD(1:3) == 'ICE') THEN
+ ZLBX = XLBG_I
+ ZLBEX = XLBEXG_I
+ ZCCX = XCCG_I
+ ZCXX = XCXG_I
+ ELSE
+ PRINT*, 'ERROR: something wrong with the computation of lambda_g'
+ END IF
+ELSE IF (KID == 7) THEN
+ IF (CCLOUD == 'LIMA') THEN ! .AND. KMOMENT == 1) THEN
+ ZLBX = XLBH_L
+ ZLBEX = XLBEXH_L
+ IF (KMOMENT == 1) THEN
+ ZCCX = XCCH_L
+ ZCXX = XCXH_L
+ END IF
+ ELSE IF (CCLOUD(1:3) == 'ICE') THEN
+ ZLBX = XLBH_I
+ ZLBEX = XLBEXH_I
+ ZCCX = XCCH_I
+ ZCXX = XCXH_I
+ ELSE
+ PRINT*, 'ERROR: something wrong with the computation of lambda_h'
+ END IF
+END IF
+!
+PLBDX(:,:,:) = 0. !1.E10
+!
+!
+!* 2. COMPUTE LBDA_x FOR 2-MOMENT SPECIES
+! -----------------------------------
+!
+IF (KMOMENT == 2) THEN
+ WHERE (PRX(:,:,:) > ZRTMIN .AND. PCX(:,:,:) > 0.)
+ PLBDX(:,:,:) = (ZLBX * PCX(:,:,:) / PRX(:,:,:))**ZLBEX
+ END WHERE
+ IF (KID == 5) PLBDX(:,:,:) = MIN(ZLBDAX_MAX, PLBDX(:,:,:))
+!
+!
+!* 3. COMPUTE LBDA_x and N_x FOR 1-MOMENT SPECIES
+! -------------------------------------------
+!
+ELSE IF (KMOMENT == 1) THEN
+!
+!* 3.1 Special case of cloud droplets
+!
+ IF (KID == 2) THEN
+! print*, 'computation of lambda_c in 1-moment configuration not treated'
+!
+!* 3.2 Special case of ice crystals
+!
+ ELSE IF (KID == 4) THEN
+! formulation utilisee dans rain_ice_fast_ri
+ WHERE (PRX(:,:,:) > ZRTMIN .AND. PCX(:,:,:) > 0.0)
+ PLBDX(:,:,:) = ZLBX * (PRHO(:,:,:) * PRX(:,:,:) / PCX(:,:,:))**ZLBEX
+ ENDWHERE
+!
+!* 3.3 Special case of snow
+!
+ ELSE IF (KID == 5) THEN
+! limitation of lbdas
+ WHERE (PRX(:,:,:) > ZRTMIN)
+! PLBDX(:,:,:) = MIN(ZLBDAX_MAX, ZLBX * (PRHO(:,:,:) * PRX(:,:,:))**ZLBEX)
+ PLBDX(:,:,:) = MIN(200000., ZLBX * (PRHO(:,:,:) * PRX(:,:,:))**ZLBEX)
+ PCX(:,:,:) = ZCCX * PLBDX(:,:,:)**ZCXX / PRHO(:,:,:)
+ ENDWHERE
+!
+!* 3.4 Computation for all other hydrometeors
+!
+ ELSE
+ WHERE (PRX(:,:,:) > ZRTMIN)
+ PLBDX(:,:,:) = ZLBX * (PRHO(:,:,:) * PRX(:,:,:))**ZLBEX
+ PCX(:,:,:) = ZCCX * PLBDX(:,:,:)**ZCXX / PRHO(:,:,:)
+ ENDWHERE
+ END IF
+END IF
+!
+END SUBROUTINE COMPUTE_LAMBDA_3D
diff --git a/src/MNH/elec_adjust.f90 b/src/MNH/elec_adjust.f90
new file mode 100644
index 0000000000000000000000000000000000000000..6c3de9ab315e937f7fe8b466a5d53971cb2f61bb
--- /dev/null
+++ b/src/MNH/elec_adjust.f90
@@ -0,0 +1,185 @@
+
+!-----------------------------------------------------------------
+! #######################
+ MODULE MODI_ELEC_ADJUST
+! #######################
+!
+INTERFACE
+!
+ SUBROUTINE ELEC_ADJUST (KRR, PRHODJ, HCLOUD, HBUNAME, &
+ PRC, PRI, PQC, PQI, &
+ PQCS, PQIS, PQPIS, PQNIS, PCND, PDEP)
+!
+INTEGER, INTENT(IN) :: KRR ! Number of moist variables
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ
+CHARACTER(LEN=4), INTENT(IN) :: HCLOUD ! Kind of microphysical scheme
+CHARACTER(len=*), INTENT(IN) :: HBUNAME ! Name of the budget
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRC ! Cloud water m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRI ! Cloud ice m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PQC ! Cloud water charge density to adjust
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PQI ! Cloud ice charge density to adjust
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PQCS ! Cloud water charge density source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PQIS ! Cloud ice charge density source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PQPIS ! Positive ion charge density source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PQNIS ! Negative ion charge density source
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCND ! Rate of condensation
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDEP ! Rate of sublimation
+!
+END SUBROUTINE ELEC_ADJUST
+!
+END INTERFACE
+!
+END MODULE MODI_ELEC_ADJUST
+
+! #############################################################
+ SUBROUTINE ELEC_ADJUST (KRR, PRHODJ, HCLOUD, HBUNAME, &
+ PRC, PRI, PQC, PQI, &
+ PQCS, PQIS, PQPIS, PQNIS, PCND, PDEP)
+! #############################################################
+!
+!!**** *ELEC_ADJUST* - compute the exchange of electric charges associated with
+!! condensation and sublimation of ice crystals.
+!! The capture of ions by cloud droplets and ice crystals is done
+!! in the ion_attach_elec routine.
+!!
+!! PURPOSE
+!! -------
+!! The purpose of this routine is to compute the fast microphysical sources
+!! through a saturation ajustement procedure in case of mixed-phase clouds.
+!!
+!!
+!!** METHOD
+!! ------
+!! The rate of charge exchanged is computed proportionnaly to the rate of mass
+!! exchanged during sublimation and condensation. The sublimation and condensation rates
+!! are computed in ICE3/4 or LIMA.
+!!
+!!
+!! AUTHOR
+!! ------
+!! C. Barthe * Laboratoire d'Aerologie*
+!!
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 01/09/2022
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+use modd_budget, only: lbudget_sv, NBUDGET_SV1, tbudgets
+!
+USE MODD_ELEC_DESCR, ONLY: XRTMIN_ELEC, XQTMIN, XFC, XFI, XECHARGE
+USE MODD_PARAM_LIMA_COLD, ONLY: XBI_L=>XBI
+USE MODD_RAIN_ICE_DESCR_n,ONLY: XRTMIN_I=>XRTMIN, XBI_I=>XBI
+USE MODD_PARAM_LIMA, ONLY: XRTMIN_L=>XRTMIN
+USE MODD_NSV, ONLY: NSV_ELECBEG
+!
+use mode_budget, only: Budget_store_init, Budget_store_end
+!
+IMPLICIT NONE
+!
+!
+!* 0.1 Declarations of dummy arguments
+!
+INTEGER, INTENT(IN) :: KRR ! Number of moist variables
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ
+CHARACTER(LEN=4), INTENT(IN) :: HCLOUD ! Kind of microphysical scheme
+CHARACTER(len=*), INTENT(IN) :: HBUNAME ! Name of the budget
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRC ! Cloud water m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRI ! Cloud ice m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PQC ! Cloud water charge density to adjust
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PQI ! Cloud ice charge density to adjust
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PQCS ! Cloud water charge density source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PQIS ! Cloud ice charge density source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PQPIS ! Positive ion charge density source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PQNIS ! Negative ion charge density source
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCND ! Rate of condensation
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDEP ! Rate of sublimation
+!
+!
+!* 0.2 Declarations of local variables :
+!
+REAL, DIMENSION(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3)) :: ZWELEC ! Work array
+REAL, DIMENSION(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3)) :: ZION_NUMBER ! Nb of elementary charge in hydrometeor charge
+REAL, DIMENSION(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3)) :: ZADD ! Ratio (0/1) of ZION_NUMBER to add to positive
+ ! or negative ion nb
+REAL :: ZBI
+REAL, DIMENSION(KRR) :: ZRTMIN
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. PRELIMINARIES
+! -------------
+!
+! choose the right parameters between ice3 and lima
+IF (HCLOUD(1:3) == 'ICE') THEN
+ ZRTMIN(1:KRR) = XRTMIN_I(1:KRR)
+ ZBI = XBI_I
+ELSE IF (HCLOUD == 'LIMA') THEN
+ ZRTMIN(1:KRR) = XRTMIN_L(1:KRR)
+ ZBI = XBI_L
+END IF
+!
+if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg ), trim( hbuname ), pqpis(:, :, :) * prhodj(:, :, :) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1), trim( hbuname ), pqcs(:, :, :) * prhodj(:, :, :) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3), trim( hbuname ), pqis(:, :, :) * prhodj(:, :, :) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + krr), trim( hbuname ), pqnis(:, :, :) * prhodj(:, :, :) )
+end if
+!
+!-------------------------------------------------------------------------------
+!
+!* 2. COMPUTE THE SOURCES FOR ELECTRIC CHARGES
+! ----------------------------------------
+!
+ZWELEC(:,:,:) = 0.
+!
+!* 2.1 Evaporation of cloud droplets
+!
+WHERE (ABS(PRC(:,:,:)) > XRTMIN_ELEC(2) .AND. &
+ ABS(PQC(:,:,:)) > XQTMIN(2) .AND. &
+ PCND(:,:,:) < -ZRTMIN(1))
+ ZWELEC(:,:,:) = (XFC / 3.) * (PQC(:,:,:) / PRC(:,:,:)) * (-PCND(:,:,:))
+ ! nb of elementary charges in hydrometeor charge
+ ZION_NUMBER(:,:,:) = ABS(ZWELEC(:,:,:)) / XECHARGE
+ ! ratio (0 or 1) of the number of ions to add to positive or negative ion number
+ ZADD(:,:,:) = 0.5 + SIGN(0.5, ZWELEC(:,:,:))
+ !
+ PQPIS(:,:,:) = PQPIS(:,:,:) + ZADD(:,:,:) * ZION_NUMBER(:,:,:)
+ PQNIS(:,:,:) = PQNIS(:,:,:) + (1. - ZADD(:,:,:)) * ZION_NUMBER(:,:,:)
+ PQCS(:,:,:) = PQCS(:,:,:) - ZWELEC(:,:,:)
+END WHERE
+!
+!
+!* 2.2 Sublimation of ice crystals
+!
+WHERE (ABS(PRI(:,:,:)) > XRTMIN_ELEC(4) .AND. &
+ ABS(PQI(:,:,:)) > XQTMIN(4) .AND. &
+ PDEP(:,:,:) < -ZRTMIN(1))
+ ZWELEC(:,:,:) = (XFI / ZBI) * (PQI(:,:,:) / PRI(:,:,:)) * (-PDEP(:,:,:))
+ ZION_NUMBER(:,:,:) = ABS(ZWELEC(:,:,:)) / XECHARGE
+ ZADD(:,:,:) = 0.5 + SIGN(0.5, ZWELEC(:,:,:))
+ !
+ PQPIS(:,:,:) = PQPIS(:,:,:) + ZADD(:,:,:) * ZION_NUMBER(:,:,:)
+ PQNIS(:,:,:) = PQNIS(:,:,:) + (1. - ZADD(:,:,:)) * ZION_NUMBER(:,:,:)
+ PQIS(:,:,:) = PQIS(:,:,:) - ZWELEC(:,:,:)
+END WHERE
+!
+!-------------------------------------------------------------------------------
+!
+!* 3. STORE THE BUDGET TERMS
+! ----------------------
+
+if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg ), trim( hbuname ), pqpis(:, :, :) * prhodj(:, :, :) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1), trim( hbuname ), pqcs(:, :, :) * prhodj(:, :, :) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3), trim( hbuname ), pqis(:, :, :) * prhodj(:, :, :) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + krr), trim( hbuname ), pqnis(:, :, :) * prhodj(:, :, :) )
+end if
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE ELEC_ADJUST
diff --git a/src/MNH/elec_compute_ex.f90 b/src/MNH/elec_compute_ex.f90
new file mode 100644
index 0000000000000000000000000000000000000000..7d73be9d7692c577b592f72b83b8edc804115c44
--- /dev/null
+++ b/src/MNH/elec_compute_ex.f90
@@ -0,0 +1,221 @@
+!
+! ###########################
+ MODULE MODI_ELEC_COMPUTE_EX
+! ###########################
+!
+INTERFACE
+ SUBROUTINE ELEC_COMPUTE_EX (KID, KMOMENT, KSIZE, &
+ PDUM, PRHO, PRTMIN, &
+ PRX, PQX, PEX, PLBDX, PCX)
+!
+INTEGER, INTENT(IN) :: KID ! nb of the hydrometeor category
+INTEGER, INTENT(IN) :: KMOMENT ! nb of moments of the microphysics scheme
+INTEGER, INTENT(IN) :: KSIZE
+REAL, INTENT(IN) :: PDUM ! =1. if mixing ratio
+ ! =timestep if source
+REAL, INTENT(IN) :: PRTMIN
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHO ! reference density
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PQX ! Electric charge
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PRX ! Mixing ratio
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PEX ! e coef of the q-D relation
+REAL, DIMENSION(KSIZE), OPTIONAL, INTENT(IN) :: PLBDX ! Slope parameter of the distribution
+REAL, DIMENSION(KSIZE), OPTIONAL, INTENT(IN) :: PCX ! Nb concentration
+!
+END SUBROUTINE ELEC_COMPUTE_EX
+END INTERFACE
+END MODULE MODI_ELEC_COMPUTE_EX
+!
+!
+! #######################################################
+ SUBROUTINE ELEC_COMPUTE_EX (KID, KMOMENT, KSIZE, &
+ PDUM, PRHO, PRTMIN, &
+ PRX, PQX, PEX, PLBDX, PCX )
+! #######################################################
+!
+! Purpose : update the parameter e_x in the relation q_x = e_x d**f_x
+! e_x = q_x/(N_x * M(f_x))
+!
+! AUTHOR
+! ------
+! C. Barthe * LAERO *
+!
+! MODIFICATIONS
+! -------------
+! Original June 2022
+!
+!------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_PARAM_n, ONLY : CCLOUD
+USE MODD_ELEC_PARAM, ONLY : XECMAX, XERMAX, XEIMAX, XESMAX, XEGMAX, XEHMAX, &
+ XFQUPDC, XFQUPDR, XFQUPDI, XEXFQUPDI, XFQUPDS, XFQUPDG, XFQUPDH
+USE MODD_ELEC_DESCR, ONLY : XCXR, XFC, XFR, XFI, XFS, XFG, XFH
+USE MODD_RAIN_ICE_DESCR_n, ONLY : XCXS_I=>XCXS, XCXG_I=>XCXG, XCXH_I=>XCXH
+USE MODD_PARAM_LIMA_COLD, ONLY : XCXS_L=>XCXS
+USE MODD_PARAM_LIMA_MIXED, ONLY : XCXG_L=>XCXG, XCXH_L=>XCXH, XALPHAH, XNUH
+USE MODD_PARAM_LIMA, ONLY : XALPHAC, XALPHAR, XALPHAI, XALPHAS, XALPHAG, &
+ XNUC, XNUR, XNUI, XNUS, XNUG
+!
+USE MODI_MOMG
+!
+IMPLICIT NONE
+!
+!* 0.1 Declaration of dummy arguments
+!
+INTEGER, INTENT(IN) :: KID ! nb of the hydrometeor category
+INTEGER, INTENT(IN) :: KMOMENT ! nb of moments of the microphysics scheme
+INTEGER, INTENT(IN) :: KSIZE
+REAL, INTENT(IN) :: PDUM ! =1. if mixing ratio
+ ! =timestep if source
+REAL, INTENT(IN) :: PRTMIN
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHO ! reference density
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PQX ! Electric charge
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PRX ! Mixing ratio
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PEX ! e coef of the q-D relation
+REAL, DIMENSION(KSIZE), OPTIONAL, INTENT(IN) :: PLBDX ! Slope parameter of the distribution
+REAL, DIMENSION(KSIZE), OPTIONAL, INTENT(IN) :: PCX ! Nb concentration
+!
+!* 0.2 Declaration of local variables
+!
+REAL :: ZRTMIN, ZFX, ZCX, ZEXMAX, ZFQUPDX, ZALPHAX, ZNUX
+!
+!---------------------------------------------------------------------------------
+!
+!* 1. PRELIMINARIES
+! -------------
+!
+ZRTMIN = PRTMIN / PDUM
+PEX(:) = 0.
+!
+IF (KID == 2) THEN ! parameters for cloud droplets
+ ZFX = XFC
+ ZEXMAX = XECMAX
+ IF (CCLOUD(1:3) == 'ICE') ZFQUPDX = XFQUPDC
+ IF (CCLOUD == 'LIMA') THEN
+ ZALPHAX = XALPHAC
+ ZNUX = XNUC
+ END IF
+ELSE IF (KID == 3) THEN ! parameters for raindrops
+ ZFX = XFR
+ ZCX = XCXR
+ ZEXMAX = XERMAX
+ IF (CCLOUD(1:3) == 'ICE') ZFQUPDX = XFQUPDR
+ IF (CCLOUD == 'LIMA' .AND. KMOMENT == 2) THEN
+ ZALPHAX = XALPHAR
+ ZNUX = XNUR
+ END IF
+ELSE IF (KID == 4) THEN ! parameters for ice crystals
+ ZFX = XFI
+ ZEXMAX = XEIMAX
+ IF (CCLOUD(1:3) == 'ICE') ZFQUPDX = XFQUPDI
+ IF (CCLOUD == 'LIMA' .AND. KMOMENT == 2) THEN
+ ZALPHAX = XALPHAI
+ ZNUX = XNUI
+ END IF
+ELSE IF (KID == 5) THEN ! parameters for snow/aggregates
+ ZFX = XFS
+ ZEXMAX = XESMAX
+ ZFQUPDX = XFQUPDS
+ IF (CCLOUD == 'LIMA' .AND. KMOMENT == 2) THEN
+ ZALPHAX = XALPHAS
+ ZNUX = XNUS
+ ELSE IF (CCLOUD == 'LIMA' .AND. KMOMENT == 1) THEN
+ ZCX = XCXS_L
+ ELSE IF (CCLOUD(1:3) == 'ICE') THEN
+ ZCX = XCXS_I
+ END IF
+ELSE IF (KID == 6) THEN ! parameters for graupel
+ ZFX = XFG
+ ZEXMAX = XEGMAX
+ ZFQUPDX = XFQUPDG
+ IF (CCLOUD == 'LIMA' .AND. KMOMENT == 2) THEN
+ ZALPHAX = XALPHAG
+ ZNUX = XNUG
+ ELSE IF (CCLOUD == 'LIMA' .AND. KMOMENT == 1) THEN
+ ZCX = XCXG_L
+ ELSE IF (CCLOUD(1:3) == 'ICE') THEN
+ ZCX = XCXG_I
+ END IF
+ELSE IF (KID == 7) THEN ! parameters for hail
+ ZFX = XFH
+ ZEXMAX = XEHMAX
+ ZFQUPDX = XFQUPDH
+ IF (CCLOUD == 'LIMA' .AND. KMOMENT == 2) THEN
+ ZALPHAX = XALPHAH
+ ZNUX = XNUH
+ ELSE IF (CCLOUD == 'LIMA' .AND. KMOMENT == 1) THEN
+ ZCX = XCXH_L
+ ELSE IF (CCLOUD(1:3) == 'ICE') THEN
+ ZCX = XCXH_I
+ END IF
+END IF
+!
+IF (CCLOUD == 'LIMA') THEN
+ IF (KID == 2) THEN
+ ZALPHAX = XALPHAC
+ ZNUX = XNUC
+ ELSE IF (KID == 3) THEN
+ ZALPHAX = XALPHAR
+ ZNUX = XNUR
+ ELSE IF (KID == 4) THEN
+ ZALPHAX = XALPHAI
+ ZNUX = XNUI
+ ELSE IF (KID == 5) THEN
+ ZALPHAX = XALPHAS
+ ZNUX = XNUS
+ ELSE IF (KID == 6) THEN
+ ZALPHAX = XALPHAG
+ ZNUX = XNUG
+ ELSE IF (KID == 7) THEN
+ ZALPHAX = XALPHAH
+ ZNUX = XNUH
+ END IF
+END IF
+!
+!
+!* 2. UPDATE E_x FOR 2-MOMENT SPECIES
+! -------------------------------
+!
+IF (KMOMENT == 2) THEN
+ WHERE (PRX(:) > ZRTMIN .AND. PCX(:) > 0.0)
+ PEX(:) = PDUM * PRHO(:) * PQX(:) * PLBDX(:)**ZFX / (PCX(:) * MOMG(ZALPHAX,ZNUX,ZFX))
+ ENDWHERE
+!
+!
+!* 3. UPDATE E_x FOR 1-MOMENT SPECIES
+! -------------------------------
+!
+ELSE IF (KMOMENT == 1) THEN
+!
+!* 3.1 Special case of cloud droplets
+!
+ IF (KID == 2) THEN
+ WHERE (PRX(:) > ZRTMIN)
+ PEX(:) = PDUM * PRHO(:) * PQX(:) / ZFQUPDX
+ PEX(:) = SIGN( MIN(ABS(PEX(:)), ZEXMAX), PEX(:))
+ ENDWHERE
+!
+!* 3.2 Special case of ice crystals
+!
+ ELSE IF (KID == 4) THEN
+ WHERE (PRX(:) > ZRTMIN .AND. PCX(:) > 0.0)
+ PEX(:) = PDUM * PRHO(:) * PQX(:) / &
+ ((PCX**(1 - XEXFQUPDI)) * ZFQUPDX * (PRHO(:) * &
+ PDUM * PRX(:))**XEXFQUPDI)
+ PEX(:) = SIGN( MIN(ABS(PEX(:)), ZEXMAX), PEX(:))
+ ENDWHERE
+!
+!* 3.3 Computation for all other hydrometeors
+!
+ ELSE
+ WHERE (PRX(:) > ZRTMIN .AND. PLBDX(:) > 0.)
+ PEX(:) = PDUM * PRHO(:) * PQX(:) / (ZFQUPDX * PLBDX(:)**(ZCX - ZFX))
+ PEX(:) = SIGN( MIN(ABS(PEX(:)), ZEXMAX), PEX(:))
+ ENDWHERE
+ END IF
+END IF
+!
+END SUBROUTINE ELEC_COMPUTE_EX
+
diff --git a/src/MNH/elec_tendencies.f90 b/src/MNH/elec_tendencies.f90
new file mode 100644
index 0000000000000000000000000000000000000000..10d01eb588659ead2f0687c558c85134a0fa0913
--- /dev/null
+++ b/src/MNH/elec_tendencies.f90
@@ -0,0 +1,3570 @@
+!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.
+!-----------------------------------------------------------------
+! ###########################
+ MODULE MODI_ELEC_TENDENCIES
+! ###########################
+!
+INTERFACE
+ SUBROUTINE ELEC_TENDENCIES (D, KRR, KMICRO, PTSTEP, ODMICRO, &
+ PRHODREF, PRHODJ, PZT, PCIT, &
+ PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
+ PQPIT, PQCT, PQRT, PQIT, PQST, PQGT, PQNIT, &
+ PQPIS, PQCS, PQRS, PQIS, PQSS, PQGS, PQNIS, &
+ PRVHENI, PRRHONG, PRIMLTC, &
+ PRCHONI, PRVDEPS, PRIAGGS, PRIAUTS, PRVDEPG, &
+ PRCAUTR, PRCACCR, PRREVAV, &
+ PRCRIMSS, PRCRIMSG, PRSRIMCG, PRRACCSS, PRRACCSG, PRSACCRG, &
+ PRSMLTG, PRICFRRG, PRRCFRIG, &
+ PRCWETG, PRIWETG, PRRWETG, PRSWETG, &
+ PRCDRYG, PRIDRYG, PRRDRYG, PRSDRYG, &
+ PRGMLTR, PRCBERI, &
+ PRCMLTSR, PRICFRR, & !- opt. param. for ICE3
+ PCCT, PCRT, PCST, PCGT, & !-- optional
+ PRVHENC, PRCHINC, PRVHONH, & !| parameters
+ PRRCVRC, PRICNVI, PRVDEPI, PRSHMSI, PRGHMGI, & !| for
+ PRICIBU, PRIRDSF, & !| LIMA
+ PRCCORR2, PRRCORR2, PRICORR2, & !--
+ PRWETGH, PRCWETH, PRIWETH, PRSWETH, PRGWETH, PRRWETH, & !-- optional
+ PRCDRYH, PRIDRYH, PRSDRYH, PRRDRYH, PRGDRYH, & !| parameters
+ PRHMLTR, PRDRYHG, & !| for
+ PRHT, PRHS, PCHT, PQHT, PQHS) !-- hail
+!
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+!
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+!
+INTEGER, INTENT(IN) :: KMICRO
+REAL, INTENT(IN) :: PTSTEP ! Double Time step
+ ! (single if cold start)
+INTEGER, INTENT(IN) :: KRR ! Number of moist variable
+!
+LOGICAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: ODMICRO ! mask to limit computation
+!
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PRHODREF! Reference density
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PZT ! Temperature (K)
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PCIT ! Pristine ice n.c. at t
+!
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PRVT ! Water vapor m.r. at t
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PRCT ! Cloud water m.r. at t
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PRRT ! Rain water m.r. at t
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PRIT ! Pristine ice m.r. at t
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PRGT ! Graupel/hail m.r. at t
+!
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PQPIT ! Positive ion (Nb/kg) at t
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PQNIT ! Negative ion (Nb/kg) at t
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PQCT ! Cloud water charge at t
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PQRT ! Raindrops charge at t
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PQIT ! Pristine ice charge at t
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PQST ! Snow/aggregates charge at t
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PQGT ! Graupel charge at t
+!
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(INOUT) :: PQPIS ! Positive ion (Nb/kg) source
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(INOUT) :: PQNIS ! Negative ion (Nb/kg) source
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(INOUT) :: PQCS ! Cloud water charge source
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(INOUT) :: PQRS ! Raindrops charge source
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(INOUT) :: PQIS ! Pristine ice charge source
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(INOUT) :: PQSS ! Snow/aggregates charge source
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(INOUT) :: PQGS ! Graupel charge source
+!
+! microphysics rates common to ICE3 and LIMA
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PRVHENI, & ! heterogeneous nucleation mixing ratio change (HIND for LIMA)
+ PRCHONI, & ! Homogeneous nucleation
+ PRRHONG, & ! Spontaneous freezing mixing ratio change
+ PRVDEPS, & ! Deposition on r_s,
+ PRIAGGS, & ! Aggregation on r_s
+ PRIAUTS, & ! Autoconversion of r_i for r_s production (CNVS for LIMA)
+ PRVDEPG, & ! Deposition on r_g
+ PRCAUTR, & ! Autoconversion of r_c for r_r production
+ PRCACCR, & ! Accretion of r_c for r_r production
+ PRREVAV, & ! Evaporation of r_r
+ PRIMLTC, & ! Cloud ice melting mixing ratio change
+ PRCBERI, & ! Bergeron-Findeisen effect
+ PRSMLTG, & ! Conversion-Melting of the aggregates
+ PRRACCSS, PRRACCSG, PRSACCRG, & ! Rain accretion onto the aggregates
+ PRCRIMSS, PRCRIMSG, PRSRIMCG, & ! Cloud droplet riming of the aggregates
+ PRICFRRG, PRRCFRIG, & ! Rain contact freezing
+ PRCWETG, PRIWETG, PRRWETG, PRSWETG, & ! Graupel wet growth
+ PRCDRYG, PRIDRYG, PRRDRYG, PRSDRYG, & ! Graupel dry growth
+ PRGMLTR ! Melting of the graupel
+! microphysics rates specific to ICE3 (knmoments==1)
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), OPTIONAL, INTENT(IN) :: PRCMLTSR,& ! Cld droplet collection onto aggregates by pos. temp.
+ PRICFRR ! Rain contact freezing (part of ice crystals converted to rain)
+! microphysics rates specific to LIMA (knmoments==2)
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), OPTIONAL, INTENT(IN) :: PRVHENC, & ! Cld droplet formation
+ PRCHINC, & ! Heterogeneous nucleation of coated IFN
+ PRVHONH, & ! Nucleation of haze
+ PRRCVRC, & ! Conversion of small drops into droplets
+ PRICNVI, & ! Conversion snow --> ice
+ PRVDEPI, & ! Deposition on r_i
+ PRSHMSI, PRGHMGI, & ! Hallett Mossop for snow and graupel
+ PRICIBU, & ! Collisional ice breakup
+ PRIRDSF, & ! Raindrop shattering by freezing
+ PRCCORR2, PRRCORR2, PRICORR2 ! Correction inside LIMA splitting
+! microphysics rates related to hail (krr == 7, lhail = .t.)
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), OPTIONAL, INTENT(IN) :: PRWETGH, & ! Conversion of graupel into hail
+ PRCWETH, PRIWETH, PRSWETH, PRGWETH, PRRWETH, & ! Dry growth of hail
+ PRCDRYH, PRIDRYH, PRSDRYH, PRRDRYH, PRGDRYH, & ! Wet growth of hail
+ PRHMLTR, & ! Melting of hail
+ PRDRYHG ! Conversion of hail into graupel
+!
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), OPTIONAL, INTENT(IN) :: PCCT ! Cloud droplets conc. at t
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), OPTIONAL, INTENT(IN) :: PCRT ! Raindrops conc. at t
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), OPTIONAL, INTENT(IN) :: PCST ! Snow conc. at t
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), OPTIONAL, INTENT(IN) :: PCGT ! Graupel conc. at t
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), OPTIONAL, INTENT(IN) :: PCHT ! Hail conc. at t
+!
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), OPTIONAL, INTENT(IN) :: PRHT ! Hail m.r. at t
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), OPTIONAL, INTENT(INOUT) :: PRHS ! Hail m.r. source
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), OPTIONAL, INTENT(IN) :: PQHT ! Hail charge at t
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), OPTIONAL, INTENT(INOUT) :: PQHS ! Hail charge source
+!
+END SUBROUTINE ELEC_TENDENCIES
+END INTERFACE
+END MODULE MODI_ELEC_TENDENCIES
+!
+!
+! #########################################################################################
+ SUBROUTINE ELEC_TENDENCIES (D, KRR, KMICRO, PTSTEP, ODMICRO, &
+ PRHODREF, PRHODJ, PZT, PCIT, &
+ PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
+ PQPIT, PQCT, PQRT, PQIT, PQST, PQGT, PQNIT, &
+ PQPIS, PQCS, PQRS, PQIS, PQSS, PQGS, PQNIS, &
+ PRVHENI, PRRHONG, PRIMLTC, &
+ PRCHONI, PRVDEPS, PRIAGGS, PRIAUTS, PRVDEPG, &
+ PRCAUTR, PRCACCR, PRREVAV, &
+ PRCRIMSS, PRCRIMSG, PRSRIMCG, PRRACCSS, PRRACCSG, PRSACCRG, &
+ PRSMLTG, PRICFRRG, PRRCFRIG, &
+ PRCWETG, PRIWETG, PRRWETG, PRSWETG, &
+ PRCDRYG, PRIDRYG, PRRDRYG, PRSDRYG, &
+ PRGMLTR, PRCBERI, &
+ PRCMLTSR, PRICFRR, & !- opt. param. for ICE3
+ PCCT, PCRT, PCST, PCGT, & !-- optional
+ PRVHENC, PRCHINC, PRVHONH, & !| parameters
+ PRRCVRC, PRICNVI, PRVDEPI, PRSHMSI, PRGHMGI, & !| for
+ PRICIBU, PRIRDSF, & !| LIMA
+ PRCCORR2, PRRCORR2, PRICORR2, & !--
+ PRWETGH, PRCWETH, PRIWETH, PRSWETH, PRGWETH, PRRWETH, & !-- optional
+ PRCDRYH, PRIDRYH, PRSDRYH, PRRDRYH, PRGDRYH, & !| parameters
+ PRHMLTR, PRDRYHG, & !| for
+ PRHT, PRHS, PCHT, PQHT, PQHS) !-- hail
+! ##########################################################################################
+!
+!!**** * - compute the explicit cloud electrification sources
+!!
+!! This routine is adapted from rain_ice_elec.f90.
+!! To avoid duplicated routines, the cloud electrification routine is now called
+!! at the end of the microphysics scheme but needs the microphysical tendencies as arguments.
+!! The sedimentation source for electric charges is treated separately.
+!!
+!! AUTHOR
+!! ------
+!! C. Barthe * LAERO *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original February 2022
+!!
+!! Modifications
+!! C. Barthe 12/04/2022 include electrification from LIMA
+!! C. Barthe 22/03/2023 5-6: take into account news from LIMA (Ns, Ng, Nh, CIBU and RDSF) and PHYEX
+!! C. Barthe 13/07/2023 5-6: Ns, Ng and Nh can be pronostic variables (LIMA2)
+!!
+!------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+use modd_budget, only: lbu_enable, &
+ lbudget_th, lbudget_rv, lbudget_rc, lbudget_rr, lbudget_ri, &
+ lbudget_rs, lbudget_rg, lbudget_rh, lbudget_sv, &
+ NBUDGET_TH, NBUDGET_RV, NBUDGET_RC, NBUDGET_RR, NBUDGET_RI, &
+ NBUDGET_RS, NBUDGET_RG, NBUDGET_RH, NBUDGET_SV1, &
+ tbudgets
+!
+USE MODD_CONF
+USE MODD_CST
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+USE MODD_ELEC_DESCR
+USE MODD_ELEC_n
+USE MODD_ELEC_PARAM
+USE MODD_LES
+USE MODE_ll
+USE MODD_NSV, ONLY: NSV_ELECBEG, NSV_ELECEND ! Scalar variables for budgets
+USE MODD_PARAMETERS
+USE MODD_PARAM_ICE_n
+USE MODD_PARAM_LIMA, ONLY: XALPHAI_L=>XALPHAI, XNUI_L=>XNUI, &
+ XCEXVT_L=>XCEXVT, XRTMIN_L=>XRTMIN, &
+ LCIBU, LRDSF, &
+ NMOM_C, NMOM_R, NMOM_I, NMOM_S, NMOM_G, NMOM_H
+USE MODD_PARAM_LIMA_COLD, ONLY: XAI_L=>XAI, XBI_L=>XBI, &
+ XDS_L=>XDS, XCXS_L=>XCXS, &
+ XCOLEXIS_L=>XCOLEXIS
+USE MODD_PARAM_LIMA_MIXED, ONLY: XDG_L=>XDG, XCXG_L=>XCXG, &
+ XCOLIG_L=>XCOLIG, XCOLEXIG_L=>XCOLEXIG, &
+ XCOLSG_L=>XCOLSG, XCOLEXSG_L=>XCOLEXSG, &
+ NGAMINC_L=>NGAMINC, &
+ NACCLBDAR_L=>NACCLBDAR, NACCLBDAS_L=>NACCLBDAS, &
+ XACCINTP1S_L=>XACCINTP1S, XACCINTP2S_L=>XACCINTP2S, &
+ XACCINTP1R_L=>XACCINTP1R, XACCINTP2R_L=>XACCINTP2R, &
+ NDRYLBDAR_L=>NDRYLBDAR, NDRYLBDAS_L=>NDRYLBDAS, &
+ NDRYLBDAG_L=>NDRYLBDAG, &
+ XDRYINTP1R_L=>XDRYINTP1R, XDRYINTP2R_L=>XDRYINTP2R, &
+ XDRYINTP1S_L=>XDRYINTP1S, XDRYINTP2S_L=>XDRYINTP2S, &
+ XDRYINTP1G_L=>XDRYINTP1G, XDRYINTP2G_L=>XDRYINTP2G, &
+ XRIMINTP1_L=>XRIMINTP1, XRIMINTP2_L=>XRIMINTP2
+
+USE MODD_PARAM_n, ONLY: CCLOUD
+USE MODD_RAIN_ICE_DESCR_n,ONLY: XCEXVT_I=>XCEXVT, XRTMIN_I=>XRTMIN, &
+ XALPHAI_I=>XALPHAI, XNUI_I=>XNUI, XAI_I=>XAI, XBI_I=>XBI, &
+ XDS_I=>XDS, XDG_I=>XDG, &
+ XCXS_I=>XCXS, XCXG_I=>XCXG
+USE MODD_RAIN_ICE_PARAM_n,ONLY: XCOLIS_I=>XCOLIS, XCOLEXIS_I=>XCOLEXIS, &
+ XCOLIG_I=>XCOLIG, XCOLEXIG_I=>XCOLEXIG, &
+ XCOLSG_I=>XCOLSG, XCOLEXSG_I=>XCOLEXSG, &
+ NGAMINC_I=>NGAMINC, &
+ NACCLBDAR_I=>NACCLBDAR, NACCLBDAS_I=>NACCLBDAS, &
+ XACCINTP1S_I=>XACCINTP1S, XACCINTP2S_I=>XACCINTP2S, &
+ XACCINTP1R_I=>XACCINTP1R, XACCINTP2R_I=>XACCINTP2R, &
+ NDRYLBDAR_I=>NDRYLBDAR, NDRYLBDAS_I=>NDRYLBDAS, &
+ NDRYLBDAG_I=>NDRYLBDAG, &
+ XDRYINTP1R_I=>XDRYINTP1R, XDRYINTP2R_I=>XDRYINTP2R, &
+ XDRYINTP1S_I=>XDRYINTP1S, XDRYINTP2S_I=>XDRYINTP2S, &
+ XDRYINTP1G_I=>XDRYINTP1G, XDRYINTP2G_I=>XDRYINTP2G, &
+ XRIMINTP1_I=>XRIMINTP1, XRIMINTP2_I=>XRIMINTP2
+USE MODD_REF, ONLY: XTHVREFZ
+!
+#ifdef MNH_PGI
+USE MODE_PACK_PGI
+#endif
+use mode_tools, only: Countjv
+use mode_budget, only: Budget_store_add, Budget_store_init, Budget_store_end
+!
+USE MODI_COMPUTE_LAMBDA
+USE MODI_ELEC_COMPUTE_EX
+USE MODI_MOMG
+!
+IMPLICIT NONE
+!
+!
+!* 0.1 Declaration of dummy arguments
+!
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+!
+INTEGER, INTENT(IN) :: KMICRO
+REAL, INTENT(IN) :: PTSTEP ! Double Time step
+ ! (single if cold start)
+INTEGER, INTENT(IN) :: KRR ! Number of moist variable
+!
+LOGICAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: ODMICRO ! mask to limit computation
+!
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PRHODREF! Reference density
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PZT ! Temperature (K)
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PCIT ! Pristine ice n.c. at t
+!
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PRVT ! Water vapor m.r. at t
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PRCT ! Cloud water m.r. at t
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PRRT ! Rain water m.r. at t
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PRIT ! Pristine ice m.r. at t
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PRGT ! Graupel/hail m.r. at t
+!
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PQPIT ! Positive ion (Nb/kg) at t
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PQNIT ! Negative ion (Nb/kg) at t
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PQCT ! Cloud water charge at t
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PQRT ! Raindrops charge at t
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PQIT ! Pristine ice charge at t
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PQST ! Snow/aggregates charge at t
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PQGT ! Graupel charge at t
+!
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(INOUT) :: PQPIS ! Positive ion (Nb/kg) source
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(INOUT) :: PQNIS ! Negative ion (Nb/kg) source
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(INOUT) :: PQCS ! Cloud water charge source
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(INOUT) :: PQRS ! Raindrops charge source
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(INOUT) :: PQIS ! Pristine ice charge source
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(INOUT) :: PQSS ! Snow/aggregates charge source
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(INOUT) :: PQGS ! Graupel charge source
+!
+! microphysics rates common to ICE3 and LIMA
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PRVHENI, & ! heterogeneous nucleation mixing ratio change (HIND for LIMA)
+ PRCHONI, & ! Homogeneous nucleation
+ PRRHONG, & ! Spontaneous freezing mixing ratio change
+ PRVDEPS, & ! Deposition on r_s,
+ PRIAGGS, & ! Aggregation on r_s
+ PRIAUTS, & ! Autoconversion of r_i for r_s production (CNVS for LIMA)
+ PRVDEPG, & ! Deposition on r_g
+ PRCAUTR, & ! Autoconversion of r_c for r_r production
+ PRCACCR, & ! Accretion of r_c for r_r production
+ PRREVAV, & ! Evaporation of r_r
+ PRIMLTC, & ! Cloud ice melting mixing ratio change
+ PRCBERI, & ! Bergeron-Findeisen effect
+ PRSMLTG, & ! Conversion-Melting of the aggregates
+ PRRACCSS, PRRACCSG, PRSACCRG, & ! Rain accretion onto the aggregates
+ PRCRIMSS, PRCRIMSG, PRSRIMCG, & ! Cloud droplet riming of the aggregates
+ PRICFRRG, PRRCFRIG, & ! Rain contact freezing
+ PRCWETG, PRIWETG, PRRWETG, PRSWETG, & ! Graupel wet growth
+ PRCDRYG, PRIDRYG, PRRDRYG, PRSDRYG, & ! Graupel dry growth
+ PRGMLTR ! Melting of the graupel
+! microphysics rates specific to ICE3 (knmoments==1)
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), OPTIONAL, INTENT(IN) :: PRCMLTSR,& ! Cld droplet collection onto aggregates by pos. temp.
+ PRICFRR ! Rain contact freezing (part of ice crystals converted to rain)
+! microphysics rates specific to LIMA (knmoments==2)
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), OPTIONAL, INTENT(IN) :: PRVHENC, & ! Cld droplet formation
+ PRCHINC, & ! Heterogeneous nucleation of coated IFN
+ PRVHONH, & ! Nucleation of haze
+ PRRCVRC, & ! Conversion of small drops into droplets
+ PRICNVI, & ! Conversion snow --> ice
+ PRVDEPI, & ! Deposition on r_i
+ PRSHMSI, PRGHMGI, & ! Hallett Mossop for snow and graupel
+ PRICIBU, & ! Collisional ice breakup
+ PRIRDSF, & ! Raindrop shattering by freezing
+ PRCCORR2, PRRCORR2, PRICORR2 ! Correction inside LIMA splitting
+! microphysics rates related to hail (krr == 7, lhail = .t.)
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), OPTIONAL, INTENT(IN) :: PRWETGH, & ! Conversion of graupel into hail
+ PRCWETH, PRIWETH, PRSWETH, PRGWETH, PRRWETH, & ! Dry growth of hail
+ PRCDRYH, PRIDRYH, PRSDRYH, PRRDRYH, PRGDRYH, & ! Wet growth of hail
+ PRHMLTR, & ! Melting of hail
+ PRDRYHG ! Conversion of hail into graupel
+!
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), OPTIONAL, INTENT(IN) :: PCCT ! Cloud droplets conc. at t
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), OPTIONAL, INTENT(IN) :: PCRT ! Raindrops conc. at t
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), OPTIONAL, INTENT(IN) :: PCST ! Snow conc. at t
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), OPTIONAL, INTENT(IN) :: PCGT ! Graupel conc. at t
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), OPTIONAL, INTENT(IN) :: PCHT ! Hail conc. at t
+!
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), OPTIONAL, INTENT(IN) :: PRHT ! Hail m.r. at t
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), OPTIONAL, INTENT(INOUT) :: PRHS ! Hail m.r. source
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), OPTIONAL, INTENT(IN) :: PQHT ! Hail charge at t
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), OPTIONAL, INTENT(INOUT) :: PQHS ! Hail charge source
+!
+!
+!* 0.2 Declaration of local variables
+!
+INTEGER :: II, JJ, JL ! Loop indexes
+INTEGER :: IIB, IIE, & ! Define the domain
+ IJB, IJE, & ! where the microphysical sources
+ IKB, IKE ! must be computed
+INTEGER :: IMICRO ! nb of pts where r_x > 0
+INTEGER, DIMENSION(KMICRO) :: I1
+INTEGER, DIMENSION(KMICRO) :: II1, II2, II3
+!
+LOGICAL, DIMENSION(KMICRO) :: GMASK ! Mask
+!REAL, DIMENSION(KMICRO) :: ZMASK ! to reduce
+INTEGER :: IGMASK ! the computation domain
+!
+REAL, DIMENSION(KMICRO) :: ZRHODREF ! Reference density
+REAL, DIMENSION(KMICRO) :: ZRHODJ ! RHO times Jacobian
+REAL, DIMENSION(KMICRO) :: ZZT ! Temperature
+!
+REAL, DIMENSION(KMICRO) :: ZRVT ! Water vapor m.r. at t
+REAL, DIMENSION(KMICRO) :: ZRCT ! Cloud water m.r. at t
+REAL, DIMENSION(KMICRO) :: ZRRT ! Rain water m.r. at t
+REAL, DIMENSION(KMICRO) :: ZRIT ! Pristine ice m.r. at t
+REAL, DIMENSION(KMICRO) :: ZRST ! Snow/aggregate m.r. at t
+REAL, DIMENSION(KMICRO) :: ZRGT ! Graupel m.r. at t
+REAL, DIMENSION(KMICRO) :: ZRHT ! Hail m.r. at t
+REAL, DIMENSION(KMICRO) :: ZCCT ! Cloud water conc. at t
+REAL, DIMENSION(KMICRO) :: ZCRT ! Raindrops conc. at t
+REAL, DIMENSION(KMICRO) :: ZCIT ! Pristine ice conc. at t
+REAL, DIMENSION(KMICRO) :: ZCST ! Snow/aggregate conc. at t
+REAL, DIMENSION(KMICRO) :: ZCGT ! Graupel conc. at t
+REAL, DIMENSION(KMICRO) :: ZCHT ! Hail conc. at t
+!
+REAL, DIMENSION(KMICRO) :: ZQPIT ! Positive ion (/kg) at t
+REAL, DIMENSION(KMICRO) :: ZQNIT ! Negative ion (/kg) at t
+REAL, DIMENSION(KMICRO) :: ZQCT ! Cloud water charge at t
+REAL, DIMENSION(KMICRO) :: ZQRT ! Raindrops charge at t
+REAL, DIMENSION(KMICRO) :: ZQIT ! Pristine ice charge at t
+REAL, DIMENSION(KMICRO) :: ZQST ! Snow/aggregate charge at t
+REAL, DIMENSION(KMICRO) :: ZQGT ! Graupel charge at t
+REAL, DIMENSION(KMICRO) :: ZQHT ! Hail charge at t
+!
+REAL, DIMENSION(KMICRO) :: ZQPIS ! Positive ion (/kg) source
+REAL, DIMENSION(KMICRO) :: ZQNIS ! Negative ion (/kg) source
+REAL, DIMENSION(KMICRO) :: ZQCS ! Cloud water charge source
+REAL, DIMENSION(KMICRO) :: ZQRS ! Raindrops charge source
+REAL, DIMENSION(KMICRO) :: ZQIS ! Pristine ice charge source
+REAL, DIMENSION(KMICRO) :: ZQSS ! Snow/aggregate charge source
+REAL, DIMENSION(KMICRO) :: ZQGS ! Graupel charge source
+REAL, DIMENSION(KMICRO) :: ZQHS ! Hail charge source
+!
+REAL, DIMENSION(KMICRO) :: ZLBDAC ! Slope parameter of the droplets distribution
+REAL, DIMENSION(KMICRO) :: ZLBDAR ! Slope parameter of the raindrop distribution
+REAL, DIMENSION(KMICRO) :: ZLBDAI ! Slope parameter of the pristine ice distribution
+REAL, DIMENSION(KMICRO) :: ZLBDAS ! Slope parameter of the aggregate distribution
+REAL, DIMENSION(KMICRO) :: ZLBDAG ! Slope parameter of the graupel distribution
+REAL, DIMENSION(KMICRO) :: ZLBDAH ! Slope parameter of the hail distribution
+!
+REAL, DIMENSION(KMICRO) :: ZECT !
+REAL, DIMENSION(KMICRO) :: ZERT ! e_x coef
+REAL, DIMENSION(KMICRO) :: ZEIT ! in the
+REAL, DIMENSION(KMICRO) :: ZEST ! q_x - D_x relation
+REAL, DIMENSION(KMICRO) :: ZEGT !
+REAL, DIMENSION(KMICRO) :: ZEHT !
+!
+LOGICAL, DIMENSION(KMICRO,4) :: GELEC ! Mask for non-inductive charging
+!
+REAL, DIMENSION(:), ALLOCATABLE :: ZDQ, ZDQ_IS, ZDQ_IG, ZDQ_SG
+!
+! Non-inductive charging process following Gardiner et al. (1995)
+REAL, DIMENSION(:), ALLOCATABLE :: ZDELTALWC ! Gap between LWC and a critical LWC
+REAL, DIMENSION(:), ALLOCATABLE :: ZFT ! Fct depending on temperature
+!
+! Non-inductive charging process following Saunders et al. (1991) / EW
+REAL, DIMENSION(:), ALLOCATABLE :: ZEW ! Effective liquid water content
+REAL, DIMENSION(:), ALLOCATABLE :: ZSAUNSK ! constant B
+REAL, DIMENSION(:), ALLOCATABLE :: ZSAUNIM ! d_i exponent
+REAL, DIMENSION(:), ALLOCATABLE :: ZSAUNIN ! v_g/s-v_i
+REAL, DIMENSION(:), ALLOCATABLE :: ZSAUNSM ! d_s exponent
+REAL, DIMENSION(:), ALLOCATABLE :: ZSAUNSN ! v_g-v_s
+REAL, DIMENSION(:), ALLOCATABLE :: ZFQIAGGS, ZFQIDRYGBS
+REAL, DIMENSION(:), ALLOCATABLE :: ZLBQSDRYGB1S, ZLBQSDRYGB2S, ZLBQSDRYGB3S
+!
+! Non-inductive charging process following Saunders and Peck (1998) / RAR
+REAL, DIMENSION(:), ALLOCATABLE :: ZRAR ! Rime accretion rate
+REAL, DIMENSION(:), ALLOCATABLE :: ZSAUNIM_IS ! d_i exponent
+REAL, DIMENSION(:), ALLOCATABLE :: ZSAUNIN_IS ! v_g/s-v_i
+REAL, DIMENSION(:), ALLOCATABLE :: ZSAUNIM_IG ! d_i exponent
+REAL, DIMENSION(:), ALLOCATABLE :: ZSAUNIN_IG ! v_g/s-v_i
+REAL, DIMENSION(:), ALLOCATABLE :: ZSAUNSK_SG ! constant B
+REAL, DIMENSION(:), ALLOCATABLE :: ZSAUNSM_SG ! d_s exponent
+REAL, DIMENSION(:), ALLOCATABLE :: ZSAUNSN_SG ! v_g-v_s
+!
+! Inductive charging process (Ziegler et al., 1991)
+REAL, DIMENSION(:), ALLOCATABLE :: ZEFIELDW ! Vertical component of the electric field
+!
+REAL, DIMENSION(KMICRO) :: ZLIMIT ! Used to limit the charge separated during NI process
+REAL, DIMENSION(KMICRO) :: ZQCOLIS ! Collection efficiency between ice and snow
+REAL, DIMENSION(KMICRO) :: ZQCOLIG ! Collection efficiency between ice and graupeln
+REAL, DIMENSION(KMICRO) :: ZQCOLSG ! Collection efficiency between snow and graupeln
+!
+REAL :: ZRHO00, ZCOR00 ! Surface reference air density
+REAL, DIMENSION(KMICRO) :: ZRHOCOR ! Density correction for fallspeed
+!
+INTEGER, DIMENSION(:), ALLOCATABLE :: IVEC1, IVEC2 ! Vectors of indices for interpolation
+REAL, DIMENSION(:), ALLOCATABLE :: ZVEC1, ZVEC2, ZVEC3 ! Work vectors for interpolation
+REAL, DIMENSION(:), ALLOCATABLE :: ZVECQ1, ZVECQ2, ZVECQ3, ZVECQ4 ! Work vectors for interpolation
+!
+REAL, DIMENSION(KMICRO) :: ZWQ, ZWQ_NI ! Work arrays
+REAL, DIMENSION(KMICRO) :: ZWQ1, ZWQ2, ZWQ3, ZWQ4 ! for
+REAL, DIMENSION(KMICRO,9) :: ZWQ5 ! charge transfer
+!
+! variables used to select between common parameters between ICEx and LIMA
+INTEGER :: IMOM_C, IMOM_R, IMOM_I, IMOM_S, IMOM_G, IMOM_H ! number of moments for each hydrometeor
+INTEGER :: IGAMINC, &
+ IACCLBDAR, IACCLBDAS, &
+ IDRYLBDAR, IDRYLBDAS, IDRYLBDAG
+!
+REAL :: ZCEXVT, &
+ ZALPHAI, ZNUI, ZAI, ZBI, ZDS, ZDG, ZCXS, ZCXG, &
+ ZCOLIS, ZCOLEXIS, ZCOLIG, ZCOLEXIG, ZCOLSG, ZCOLEXSG, &
+ ZACCINTP1S, ZACCINTP2S, ZACCINTP1R, ZACCINTP2R, &
+ ZDRYINTP1R, ZDRYINTP2R, ZDRYINTP1S, ZDRYINTP2S, &
+ ZDRYINTP1G, ZDRYINTP2G, &
+ ZRIMINTP1, ZRIMINTP2
+REAL, DIMENSION(:), ALLOCATABLE :: ZRTMIN
+!
+! microphysical tendencies have to be transformed in 1D arrays
+REAL, DIMENSION(KMICRO) :: ZRVHENI, ZRCHONI, ZRRHONG, ZRVDEPS, ZRIAGGS, &
+ ZRIAUTS, ZRVDEPG, ZRCAUTR, ZRCACCR, ZRREVAV, &
+ ZRIMLTC, ZRCBERI, ZRSMLTG, ZRRACCSS, ZRRACCSG, &
+ ZRSACCRG, ZRCRIMSS, ZRCRIMSG, ZRSRIMCG, ZRICFRRG, &
+ ZRRCFRIG, ZRCWETG, ZRIWETG, ZRRWETG, ZRSWETG, &
+ ZRCDRYG, ZRIDRYG, ZRRDRYG, ZRSDRYG, ZRGMLTR
+! optional microphysical tendencies
+REAL, DIMENSION(:), ALLOCATABLE :: ZRCMLTSR, ZRICFRR, ZRVHENC, ZRCHINC, ZRVHONH, &
+ ZRRCVRC, ZRICNVI, ZRVDEPI, ZRSHMSI, ZRGHMGI, &
+ ZRICIBU, ZRIRDSF, ZRCCORR2, ZRRCORR2, ZRICORR2, &
+ ZRWETGH, ZRCWETH, ZRIWETH, ZRSWETH, ZRGWETH, &
+ ZRRWETH, ZRCDRYH, ZRIDRYH, ZRSDRYH, ZRRDRYH, &
+ ZRGDRYH, ZRHMLTR, ZRDRYHG
+!
+!------------------------------------------------------------------
+!
+!* 1. INITIALIZATIONS
+! ---------------
+!
+!* 1.1 compute the loop bounds
+!
+IIB = D%NIB
+IIE = D%NIE
+IJB = D%NJB
+IJE = D%NJE
+IKB = D%NKB
+IKE = D%NKE
+!
+!
+!* 1.2 select parameters between ICEx and LIMA
+!
+IF (CCLOUD(1:3) == 'ICE') THEN
+ ZCEXVT = XCEXVT_I
+ IMOM_C = 1
+ IMOM_R = 1
+ IMOM_I = 2 ! Ni is diagnostic and always available
+ IMOM_S = 1
+ IMOM_G = 1
+ IF (KRR == 7) THEN
+ IMOM_H = 1
+ ELSE
+ IMOM_H = 0
+ END IF
+ELSE IF (CCLOUD == 'LIMA') THEN
+ ZCEXVT = XCEXVT_L
+ IMOM_C = NMOM_C
+ IMOM_R = NMOM_R
+ IMOM_I = 2 ! Ni is diagnostic and always available
+ IMOM_S = NMOM_S
+ IMOM_G = NMOM_G
+ IMOM_H = NMOM_H
+END IF
+!
+ZRHO00 = XP00 / (XRD * XTHVREFZ(IKB))
+ZCOR00 = ZRHO00**ZCEXVT
+!
+IF (LINDUCTIVE) ALLOCATE (ZEFIELDW(KMICRO))
+!
+!
+!* 1.3 packing
+!
+! optimization by looking for locations where
+! the microphysical fields are larger than a minimal value only !!!
+!
+IF (KMICRO >= 0) THEN
+ IMICRO = COUNTJV(ODMICRO(:,:,:), II1(:), II2(:), II3(:))
+ !
+ ! some microphysical tendencies are optional: the corresponding 1D arrays must be allocated
+ IF (CCLOUD(1:3) == 'ICE') THEN ! ICE3 scheme
+ ALLOCATE(ZRCMLTSR(IMICRO))
+ ALLOCATE(ZRICFRR(IMICRO))
+ END IF
+ IF (CCLOUD == 'LIMA') THEN ! LIMA scheme
+ ALLOCATE(ZRVHENC(IMICRO))
+ ALLOCATE(ZRCHINC(IMICRO))
+ ALLOCATE(ZRVHONH(IMICRO))
+ ALLOCATE(ZRRCVRC(IMICRO))
+ ALLOCATE(ZRICNVI(IMICRO))
+ ALLOCATE(ZRVDEPI(IMICRO))
+ ALLOCATE(ZRSHMSI(IMICRO))
+ ALLOCATE(ZRGHMGI(IMICRO))
+ ALLOCATE(ZRICIBU(IMICRO))
+ ALLOCATE(ZRIRDSF(IMICRO))
+ ALLOCATE(ZRCCORR2(IMICRO))
+ ALLOCATE(ZRRCORR2(IMICRO))
+ ALLOCATE(ZRICORR2(IMICRO))
+ END IF
+ IF (KRR == 7) THEN ! hail activated
+ ALLOCATE(ZRWETGH(IMICRO))
+ ALLOCATE(ZRCWETH(IMICRO))
+ ALLOCATE(ZRIWETH(IMICRO))
+ ALLOCATE(ZRSWETH(IMICRO))
+ ALLOCATE(ZRGWETH(IMICRO))
+ ALLOCATE(ZRRWETH(IMICRO))
+ ALLOCATE(ZRCDRYH(IMICRO))
+ ALLOCATE(ZRRDRYH(IMICRO))
+ ALLOCATE(ZRIDRYH(IMICRO))
+ ALLOCATE(ZRSDRYH(IMICRO))
+ ALLOCATE(ZRGDRYH(IMICRO))
+ ALLOCATE(ZRHMLTR(IMICRO))
+ ALLOCATE(ZRDRYHG(IMICRO))
+ END IF
+ !
+ DO JL = 1, IMICRO
+ ZZT(JL) = PZT(II1(JL),II2(JL),II3(JL))
+ ZRHODREF(JL) = PRHODREF(II1(JL),II2(JL),II3(JL))
+ ZRHOCOR(JL) = (ZRHO00 / ZRHODREF(JL))**ZCEXVT
+ ZRHODJ(JL) = PRHODJ(II1(JL),II2(JL),II3(JL))
+ !
+ ZCIT(JL) = PCIT(II1(JL),II2(JL),II3(JL))
+ IF (IMOM_C == 2) ZCCT(JL) = PCCT(II1(JL),II2(JL),II3(JL))
+ IF (IMOM_R == 2) ZCRT(JL) = PCRT(II1(JL),II2(JL),II3(JL))
+ IF (IMOM_S == 2) ZCST(JL) = PCST(II1(JL),II2(JL),II3(JL))
+ IF (IMOM_G == 2) ZCGT(JL) = PCGT(II1(JL),II2(JL),II3(JL))
+ IF (IMOM_H == 2) ZCHT(JL) = PCHT(II1(JL),II2(JL),II3(JL))
+ !
+ ZRVT(JL) = PRVT(II1(JL),II2(JL),II3(JL))
+ ZRCT(JL) = PRCT(II1(JL),II2(JL),II3(JL))
+ ZRRT(JL) = PRRT(II1(JL),II2(JL),II3(JL))
+ ZRIT(JL) = PRIT(II1(JL),II2(JL),II3(JL))
+ ZRST(JL) = PRST(II1(JL),II2(JL),II3(JL))
+ ZRGT(JL) = PRGT(II1(JL),II2(JL),II3(JL))
+ IF (KRR == 7) ZRHT(JL) = PRHT(II1(JL),II2(JL),II3(JL))
+ !
+ ZQPIT(JL) = PQPIT(II1(JL),II2(JL),II3(JL))
+ ZQNIT(JL) = PQNIT(II1(JL),II2(JL),II3(JL))
+ ZQCT(JL) = PQCT(II1(JL),II2(JL),II3(JL))
+ ZQRT(JL) = PQRT(II1(JL),II2(JL),II3(JL))
+ ZQIT(JL) = PQIT(II1(JL),II2(JL),II3(JL))
+ ZQST(JL) = PQST(II1(JL),II2(JL),II3(JL))
+ ZQGT(JL) = PQGT(II1(JL),II2(JL),II3(JL))
+ IF (KRR == 7) ZQHT(JL) = PQHT(II1(JL),II2(JL),II3(JL))
+ !
+ ZQPIS(JL) = PQPIS(II1(JL), II2(JL), II3(JL))
+ ZQNIS(JL) = PQNIS(II1(JL), II2(JL), II3(JL))
+ ZQCS(JL) = PQCS(II1(JL), II2(JL), II3(JL))
+ ZQRS(JL) = PQRS(II1(JL), II2(JL), II3(JL))
+ ZQIS(JL) = PQIS(II1(JL), II2(JL), II3(JL))
+ ZQSS(JL) = PQSS(II1(JL), II2(JL), II3(JL))
+ ZQGS(JL) = PQGS(II1(JL), II2(JL), II3(JL))
+ IF (KRR == 7) ZQHS(JL) = PQHS(II1(JL), II2(JL), II3(JL))
+ !
+ IF (LINDUCTIVE) ZEFIELDW(JL) = XEFIELDW(II1(JL), II2(JL), II3(JL))
+ !
+ ! microphysical tendencies
+ ZRVHENI(JL) = PRVHENI(II1(JL), II2(JL), II3(JL))
+ ZRRHONG(JL) = PRRHONG(II1(JL), II2(JL), II3(JL))
+ ZRIMLTC(JL) = PRIMLTC(II1(JL), II2(JL), II3(JL))
+ ZRCHONI(JL) = PRCHONI(II1(JL), II2(JL), II3(JL))
+ ZRVDEPS(JL) = PRVDEPS(II1(JL), II2(JL), II3(JL))
+ ZRIAGGS(JL) = PRIAGGS(II1(JL), II2(JL), II3(JL))
+ ZRIAUTS(JL) = PRIAUTS(II1(JL), II2(JL), II3(JL))
+ ZRVDEPG(JL) = PRVDEPG(II1(JL), II2(JL), II3(JL))
+ ZRCAUTR(JL) = PRCAUTR(II1(JL), II2(JL), II3(JL))
+ ZRCACCR(JL) = PRCACCR(II1(JL), II2(JL), II3(JL))
+ ZRREVAV(JL) = PRREVAV(II1(JL), II2(JL), II3(JL))
+ ZRCRIMSS(JL) = PRCRIMSS(II1(JL), II2(JL), II3(JL))
+ ZRCRIMSG(JL) = PRCRIMSG(II1(JL), II2(JL), II3(JL))
+ ZRSRIMCG(JL) = PRSRIMCG(II1(JL), II2(JL), II3(JL))
+ ZRRACCSS(JL) = PRRACCSS(II1(JL), II2(JL), II3(JL))
+ ZRRACCSG(JL) = PRRACCSG(II1(JL), II2(JL), II3(JL))
+ ZRSACCRG(JL) = PRSACCRG(II1(JL), II2(JL), II3(JL))
+ ZRSMLTG(JL) = PRSMLTG(II1(JL), II2(JL), II3(JL))
+ ZRICFRRG(JL) = PRICFRRG(II1(JL), II2(JL), II3(JL))
+ ZRRCFRIG(JL) = PRRCFRIG(II1(JL), II2(JL), II3(JL))
+ ZRCWETG(JL) = PRCWETG(II1(JL), II2(JL), II3(JL))
+ ZRIWETG(JL) = PRIWETG(II1(JL), II2(JL), II3(JL))
+ ZRRWETG(JL) = PRRWETG(II1(JL), II2(JL), II3(JL))
+ ZRSWETG(JL) = PRSWETG(II1(JL), II2(JL), II3(JL))
+ ZRCDRYG(JL) = PRCDRYG(II1(JL), II2(JL), II3(JL))
+ ZRIDRYG(JL) = PRIDRYG(II1(JL), II2(JL), II3(JL))
+ ZRRDRYG(JL) = PRRDRYG(II1(JL), II2(JL), II3(JL))
+ ZRSDRYG(JL) = PRSDRYG(II1(JL), II2(JL), II3(JL))
+ ZRGMLTR(JL) = PRGMLTR(II1(JL), II2(JL), II3(JL))
+ ZRCBERI(JL) = PRCBERI(II1(JL), II2(JL), II3(JL))
+ IF (CCLOUD(1:3) == 'ICE') THEN
+ ZRCMLTSR(JL) = PRCMLTSR(II1(JL), II2(JL), II3(JL))
+ ZRICFRR(JL) = PRICFRR(II1(JL), II2(JL), II3(JL))
+ END IF
+ IF (CCLOUD == 'LIMA') THEN
+ ZCST(JL) = PCST(II1(JL), II2(JL), II3(JL))
+ ZCGT(JL) = PCGT(II1(JL), II2(JL), II3(JL))
+ ZRVHENC(JL) = PRVHENC(II1(JL), II2(JL), II3(JL))
+ ZRCHINC(JL) = PRCHINC(II1(JL), II2(JL), II3(JL))
+ ZRVHONH(JL) = PRVHONH(II1(JL), II2(JL), II3(JL))
+ ZRRCVRC(JL) = PRRCVRC(II1(JL), II2(JL), II3(JL))
+ ZRICNVI(JL) = PRICNVI(II1(JL), II2(JL), II3(JL))
+ ZRVDEPI(JL) = PRVDEPI(II1(JL), II2(JL), II3(JL))
+ ZRSHMSI(JL) = PRSHMSI(II1(JL), II2(JL), II3(JL))
+ ZRGHMGI(JL) = PRGHMGI(II1(JL), II2(JL), II3(JL))
+ ZRICIBU(JL) = PRICIBU(II1(JL), II2(JL), II3(JL))
+ ZRIRDSF(JL) = PRIRDSF(II1(JL), II2(JL), II3(JL))
+ ZRCCORR2(JL) = PRCCORR2(II1(JL), II2(JL), II3(JL))
+ ZRRCORR2(JL) = PRRCORR2(II1(JL), II2(JL), II3(JL))
+ ZRICORR2(JL) = PRICORR2(II1(JL), II2(JL), II3(JL))
+ END IF
+ IF (KRR == 7) THEN
+ ZCHT(JL) = PCHT(II1(JL), II2(JL), II3(JL))
+ ZRWETGH(JL) = PRWETGH(II1(JL), II2(JL), II3(JL))
+ ZRCWETH(JL) = PRCWETH(II1(JL), II2(JL), II3(JL))
+ ZRIWETH(JL) = PRIWETH(II1(JL), II2(JL), II3(JL))
+ ZRSWETH(JL) = PRSWETH(II1(JL), II2(JL), II3(JL))
+ ZRGWETH(JL) = PRGWETH(II1(JL), II2(JL), II3(JL))
+ ZRRWETH(JL) = PRRWETH(II1(JL), II2(JL), II3(JL))
+ ZRCDRYH(JL) = PRCDRYH(II1(JL), II2(JL), II3(JL))
+ ZRRDRYH(JL) = PRRDRYH(II1(JL), II2(JL), II3(JL))
+ ZRIDRYH(JL) = PRIDRYH(II1(JL), II2(JL), II3(JL))
+ ZRSDRYH(JL) = PRSDRYH(II1(JL), II2(JL), II3(JL))
+ ZRGDRYH(JL) = PRGDRYH(II1(JL), II2(JL), II3(JL))
+ ZRHMLTR(JL) = PRHMLTR(II1(JL), II2(JL), II3(JL))
+ ZRDRYHG(JL) = PRDRYHG(II1(JL), II2(JL), II3(JL))
+ END IF
+ END DO
+ !
+ ZRHOCOR(:) = (ZRHO00 / ZRHODREF(:))**ZCEXVT
+!
+!
+!* 1.4 allocations for the non-inductive parameterizations
+!
+ IF (CNI_CHARGING == 'GARDI') THEN
+ ALLOCATE( ZDELTALWC(KMICRO) )
+ ALLOCATE( ZFT(KMICRO) )
+ END IF
+!
+ IF (CNI_CHARGING == 'SAUN1' .OR. CNI_CHARGING == 'SAUN2' .OR. &
+ CNI_CHARGING == 'TAKAH' .OR. &
+ CNI_CHARGING == 'BSMP1' .OR. CNI_CHARGING == 'BSMP2' .OR. &
+ CNI_CHARGING == 'TEEWC' .OR. CNI_CHARGING == 'TERAR') THEN
+ ALLOCATE( ZEW(KMICRO) )
+ END IF
+!
+ IF (CNI_CHARGING == 'SAUN1' .OR. CNI_CHARGING == 'SAUN2' .OR. &
+ CNI_CHARGING == 'TAKAH' .OR. CNI_CHARGING == 'TEEWC') THEN
+ ALLOCATE( ZDQ(KMICRO) )
+ END IF
+!
+ IF (CNI_CHARGING == 'SAUN1' .OR. CNI_CHARGING == 'SAUN2' .OR. &
+ CNI_CHARGING == 'TEEWC' ) THEN
+ ALLOCATE( ZSAUNSK(KMICRO) )
+ ALLOCATE( ZSAUNIM(KMICRO) )
+ ALLOCATE( ZSAUNIN(KMICRO) )
+ ALLOCATE( ZSAUNSM(KMICRO) )
+ ALLOCATE( ZSAUNSN(KMICRO) )
+ END IF
+!
+ IF (CNI_CHARGING == 'SAUN1' .OR. CNI_CHARGING == 'SAUN2' .OR. &
+ CNI_CHARGING == 'SAP98' .OR. &
+ CNI_CHARGING == 'BSMP1' .OR. CNI_CHARGING == 'BSMP2' .OR. &
+ CNI_CHARGING == 'TEEWC' .OR. CNI_CHARGING == 'TERAR') THEN
+ ALLOCATE( ZFQIAGGS(KMICRO) )
+ ALLOCATE( ZFQIDRYGBS(KMICRO) )
+ ALLOCATE( ZLBQSDRYGB1S(KMICRO) )
+ ALLOCATE( ZLBQSDRYGB2S(KMICRO) )
+ ALLOCATE( ZLBQSDRYGB3S(KMICRO) )
+ END IF
+!
+ IF (CNI_CHARGING == 'SAP98' .OR. CNI_CHARGING == 'TERAR' .OR. &
+ CNI_CHARGING == 'BSMP1' .OR. CNI_CHARGING == 'BSMP2') THEN
+ ALLOCATE( ZRAR(KMICRO) )
+ ALLOCATE( ZDQ_IS(KMICRO) )
+ ALLOCATE( ZDQ_IG(KMICRO) )
+ ALLOCATE( ZDQ_SG(KMICRO) )
+ ALLOCATE( ZSAUNIM_IS(KMICRO) )
+ ALLOCATE( ZSAUNIN_IS(KMICRO) )
+ ALLOCATE( ZSAUNIM_IG(KMICRO) )
+ ALLOCATE( ZSAUNIN_IG(KMICRO) )
+ ALLOCATE( ZSAUNSK_SG(KMICRO) )
+ ALLOCATE( ZSAUNSM_SG(KMICRO) )
+ ALLOCATE( ZSAUNSN_SG(KMICRO) )
+ END IF
+!
+!
+!* 1.5 select parameters between ICEx and LIMA
+!
+ ALLOCATE(ZRTMIN(KRR))
+ IF (CCLOUD(1:3) == 'ICE') THEN
+! in ini_rain_ice, xrtmin is initialized with dimension 6 (hail not activated) or 7 (hail activated)
+ ZRTMIN(1:KRR) = XRTMIN_I(1:KRR)
+ !
+ ZALPHAI = XALPHAI_I
+ ZNUI = XNUI_I
+ ZAI = XAI_I
+ ZBI = XBI_I
+ ZDS = XDS_I
+ ZDG = XDG_I
+ ZCXS = XCXS_I
+ ZCXG = XCXG_I
+ !
+ ZCOLIS = XCOLIS_I
+ ZCOLEXIS = XCOLEXIS_I
+ ZCOLIG = XCOLIG_I
+ ZCOLEXIG = XCOLEXIG_I
+ ZCOLSG = XCOLSG_I
+ ZCOLEXSG = XCOLEXSG_I
+ !
+ IGAMINC = NGAMINC_I
+ !
+ IACCLBDAR = NACCLBDAR_I
+ IACCLBDAS = NACCLBDAS_I
+ ZACCINTP1S = XACCINTP1S_I
+ ZACCINTP2S = XACCINTP2S_I
+ ZACCINTP1R = XACCINTP1R_I
+ ZACCINTP2R = XACCINTP2R_I
+ !
+ IDRYLBDAR = NDRYLBDAR_I
+ IDRYLBDAS = NDRYLBDAS_I
+ IDRYLBDAG = NDRYLBDAG_I
+ ZDRYINTP1R = XDRYINTP1R_I
+ ZDRYINTP2R = XDRYINTP2R_I
+ ZDRYINTP1S = XDRYINTP1S_I
+ ZDRYINTP2S = XDRYINTP2S_I
+ ZDRYINTP1G = XDRYINTP1G_I
+ ZDRYINTP2G = XDRYINTP2G_I
+ !
+ ZRIMINTP1 = XRIMINTP1_I
+ ZRIMINTP2 = XRIMINTP2_I
+ !
+ ELSE IF (CCLOUD == 'LIMA') THEN
+! in ini_lima, xrtmin is initialized with dimension 7
+ ZRTMIN(1:KRR) = XRTMIN_L(1:KRR)
+ !
+ ZALPHAI = XALPHAI_L
+ ZNUI = XNUI_L
+ ZAI = XAI_L
+ ZBI = XBI_L
+ ZDS = XDS_L
+ ZDG = XDG_L
+ ZCXS = XCXS_L
+ ZCXG = XCXG_L
+ !
+ ZCOLIS = 0.25 ! variable not defined in LIMA, the value of ICEx is used
+ ZCOLEXIS = XCOLEXIS_L
+ ZCOLIG = XCOLIG_L
+ ZCOLEXIG = XCOLEXIG_L
+ ZCOLSG = XCOLSG_L
+ ZCOLEXSG = XCOLEXSG_L
+ !
+ IGAMINC = NGAMINC_L
+ !
+ IACCLBDAR = NACCLBDAR_L
+ IACCLBDAS = NACCLBDAS_L
+ ZACCINTP1S = XACCINTP1S_L
+ ZACCINTP2S = XACCINTP2S_L
+ ZACCINTP1R = XACCINTP1R_L
+ ZACCINTP2R = XACCINTP2R_L
+ !
+ IDRYLBDAR = NDRYLBDAR_L
+ IDRYLBDAS = NDRYLBDAS_L
+ IDRYLBDAG = NDRYLBDAG_L
+ ZDRYINTP1R = XDRYINTP1R_L
+ ZDRYINTP2R = XDRYINTP2R_L
+ ZDRYINTP1S = XDRYINTP1S_L
+ ZDRYINTP2S = XDRYINTP2S_L
+ ZDRYINTP1G = XDRYINTP1G_L
+ ZDRYINTP2G = XDRYINTP2G_L
+ !
+ ZRIMINTP1 = XRIMINTP1_L
+ ZRIMINTP2 = XRIMINTP2_L
+ END IF
+!
+!
+!* 1.6 update the slope parameter of the distribution
+!* and compute N_x if necessary
+!
+ IF (CCLOUD(1:3) == 'ICE') ZCCT(:) = 0.
+ CALL COMPUTE_LAMBDA(2, IMOM_C, KMICRO, ZRHODREF, ZRTMIN(2), ZRCT, ZCCT, ZLBDAC)
+ CALL COMPUTE_LAMBDA(3, IMOM_R, KMICRO, ZRHODREF, ZRTMIN(3), ZRRT, ZCRT, ZLBDAR)
+ CALL COMPUTE_LAMBDA(4, IMOM_I, KMICRO, ZRHODREF, ZRTMIN(4), ZRIT, ZCIT, ZLBDAI)
+ CALL COMPUTE_LAMBDA(5, IMOM_S, KMICRO, ZRHODREF, ZRTMIN(5), ZRST, ZCST, ZLBDAS)
+ CALL COMPUTE_LAMBDA(6, IMOM_G, KMICRO, ZRHODREF, ZRTMIN(6), ZRGT, ZCGT, ZLBDAG)
+ IF (KRR == 7) CALL COMPUTE_LAMBDA(7, IMOM_H, KMICRO, ZRHODREF, ZRTMIN(7), ZRHT, ZCHT, ZLBDAH)
+!
+!
+!* 1.7 update the parameter e in the charge-diameter relationship
+!
+! Compute e_x at time t
+ IF (CCLOUD == 'LIMA') THEN
+ CALL ELEC_COMPUTE_EX(2, IMOM_C, KMICRO, 1., ZRHODREF, ZRTMIN(2), ZRCT, ZQCT, ZECT, PLBDX=ZLBDAC, PCX=ZCCT)
+ CALL ELEC_COMPUTE_EX(3, IMOM_R, KMICRO, 1., ZRHODREF, ZRTMIN(3), ZRRT, ZQRT, ZERT, PLBDX=ZLBDAR, PCX=ZCRT)
+ CALL ELEC_COMPUTE_EX(4, IMOM_I, KMICRO, 1., ZRHODREF, ZRTMIN(4), ZRIT, ZQIT, ZEIT, PLBDX=ZLBDAI, PCX=ZCIT)
+ CALL ELEC_COMPUTE_EX(5, IMOM_S, KMICRO, 1., ZRHODREF, ZRTMIN(5), ZRST, ZQST, ZEST, PLBDX=ZLBDAS, PCX=ZCST)
+ CALL ELEC_COMPUTE_EX(6, IMOM_G, KMICRO, 1., ZRHODREF, ZRTMIN(6), ZRGT, ZQGT, ZEGT, PLBDX=ZLBDAG, PCX=ZCGT)
+ IF (KRR == 7) CALL ELEC_COMPUTE_EX(7, IMOM_H, KMICRO, 1., ZRHODREF, ZRTMIN(7), ZRHT, ZQHT, ZEHT, PLBDX=ZLBDAH, PCX=ZCHT)
+ ELSE IF (CCLOUD(1:3) == 'ICE') THEN
+ CALL ELEC_COMPUTE_EX(2, 1, KMICRO, 1., ZRHODREF, ZRTMIN(2), ZRCT, ZQCT, ZECT)
+ CALL ELEC_COMPUTE_EX(3, 1, KMICRO, 1., ZRHODREF, ZRTMIN(3), ZRRT, ZQRT, ZERT, PLBDX=ZLBDAR)
+ CALL ELEC_COMPUTE_EX(4, 1, KMICRO, 1., ZRHODREF, ZRTMIN(4), ZRIT, ZQIT, ZEIT, PCX=ZCIT)
+ CALL ELEC_COMPUTE_EX(5, 1, KMICRO, 1., ZRHODREF, ZRTMIN(5), ZRST, ZQST, ZEST, PLBDX=ZLBDAS)
+ CALL ELEC_COMPUTE_EX(6, 1, KMICRO, 1., ZRHODREF, ZRTMIN(6), ZRGT, ZQGT, ZEGT, PLBDX=ZLBDAG)
+ IF (KRR == 7) CALL ELEC_COMPUTE_EX(7, 1, KMICRO, 1., ZRHODREF, ZRTMIN(7), ZRHT, ZQHT, ZEHT, PLBDX=ZLBDAH)
+ END IF
+!
+!
+!* 1.8 initialization for the non-inductive charging process
+!
+ SELECT CASE (CNI_CHARGING)
+ ! Initialization for the parameterization of Gardiner et al. (1995)
+ CASE ('GARDI')
+ CALL ELEC_INIT_NOIND_GARDI()
+ ! Save the effective water content
+ DO JL = 1, KMICRO
+ XEW(II1(JL),II2(JL),II3(JL)) = ZDELTALWC(JL) !
+ END DO
+ !
+ ! Initialization for the parameterizations of Saunders et al. (1991)
+ ! with and without anomalies, and Tsenova and Mitzeva (2009)
+ CASE ('SAUN1', 'SAUN2', 'TEEWC')
+ CALL ELEC_INIT_NOIND_EWC()
+ ! Save the effective water content
+ DO JL = 1, KMICRO
+ XEW(II1(JL),II2(JL),II3(JL)) = ZEW(JL) ! g/m3
+ END DO
+ !
+ ! Initialization for the parameterizations of Saunders and Peck (1998),
+ ! Brooks et al. (1997) and Tsenova and Mitzeva (2011)
+ CASE ('SAP98', 'BSMP1', 'BSMP2', 'TERAR')
+ CALL ELEC_INIT_NOIND_RAR()
+ ! Save the rime accretion rate (not recorded properly: 3 different RAR are computed !!!)
+ DO JL = 1, KMICRO
+ XEW(II1(JL),II2(JL),II3(JL)) = ZRAR(JL) ! g/m3
+ END DO
+ !
+ ! Initialization for the parameterization of Takahashi (1978)
+ CASE ('TAKAH')
+ CALL ELEC_INIT_NOIND_TAKAH()
+ ! Save the effective water content
+ DO JL = 1, KMICRO
+ XEW(II1(JL),II2(JL),II3(JL)) = ZEW(JL) ! g/m3
+ END DO
+ END SELECT
+!
+!
+!------------------------------------------------------------------
+!
+!* 2. COMPUTE THE SLOW COLD PROCESS SOURCES
+! -------------------------------------
+!
+!* 2.1 heterogeneous nucleation
+!
+! --> rien n'est fait pour l'elec pour le moment
+! ICE3/4 : rvheni/rvhind
+! LIMA : rvhenc, rchinc, rvhonh
+!
+!
+!* 2.2 spontaneous freezing (rhong)
+!
+ if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2 ), 'SFR', &
+ Unpack( zqrs(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'SFR', &
+ Unpack( zqgs(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ end if
+!
+ ZWQ(:) = 0.
+ WHERE (ZRRHONG(:) > 0. .AND. &
+ ZRRT(:) > XRTMIN_ELEC(3) .AND. ABS(ZQRT(:)) > XQTMIN(3))
+ ZWQ(:) = ZQRS(:)
+ !
+ ZQGS(:) = ZQGS(:) + ZQRS(:)
+ ZQRS(:) = 0.
+ END WHERE
+!
+ if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2 ), 'SFR', &
+ Unpack( zqrs(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'SFR', &
+ Unpack( zqgs(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ end if
+!
+!
+!* 2.3 cloud ice melting (rimltc)
+!
+ if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1 ), 'IMLT', &
+ Unpack( zqcs(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'IMLT', &
+ Unpack( zqis(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ end if
+!
+ WHERE (ZRIMLTC(:) > 0.)
+ ZQCS(:) = ZQCS(:) + ZQIS(:)
+ ZQIS(:) = 0.
+ END WHERE
+!
+ if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1 ), 'IMLT', &
+ Unpack( zqcs(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'IMLT', &
+ Unpack( zqis(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ end if
+!
+!
+!* 2.4 riming-conversion of the large sized aggregates into graupel ???
+! ancienne param => on calcule plutot cette tendance un peu plus loin ?
+!
+!
+!* 2.5 homogeneous nucleation (rchoni)
+!
+! CB : traitement different entre ice3 et lima --> a modifier eventuellement
+!
+ ZWQ(:) = 0.
+ WHERE (ZRCHONI(:) > 0. .AND. &
+ ZRCT(:) > XRTMIN_ELEC(2) .AND. &
+ ABS(ZQCT(:)) > XQTMIN(2) .AND. ABS(ZECT(:)) > XECMIN)
+ ZWQ(:) = XQHON * ZECT(:) * ZRCHONI(:)
+ ZWQ(:) = SIGN( MIN( ABS(ZQCT(:)/PTSTEP),ABS(ZWQ(:)) ),ZQCS(:) )
+ !
+ ZQIS(:) = ZQIS(:) + ZWQ(:)
+ ZQCS(:) = ZQCS(:) - ZWQ(:)
+ END WHERE
+!
+ if ( lbudget_sv ) then
+ call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1 ), 'HON', &
+ Unpack( -zwq(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'HON', &
+ Unpack( zwq(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ end if
+!
+!
+!* 2.6 deposition on snow/aggregates (rvdeps)
+!
+ if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg ), 'DEPS', &
+ Unpack( zqpis(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecend ), 'DEPS', &
+ Unpack( zqnis(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ end if
+!
+ ZWQ(:) = 0.
+ !
+ ! Only the sublimation of snow/aggregates is considered (negative part of PRVDEPS)
+ WHERE (ZRVDEPS(:) < 0. .AND. &
+ ZRST(:) > XRTMIN_ELEC(5) .AND. ABS(ZQST(:)) > XQTMIN(5))
+ ZWQ(:) = XCOEF_RQ_S * ZQST(:) * ZRVDEPS(:) / ZRST(:)
+ ZWQ(:) = SIGN( MIN( ABS(ZQST(:)/PTSTEP),ABS(ZWQ(:)) ),ZQSS(:) )
+ !
+ ZQSS(:) = ZQSS(:) - ZWQ(:)
+ ZQPIS(:) = ZQPIS(:) + MAX( 0.0,ZWQ(:)/XECHARGE )
+ ZQNIS(:) = ZQNIS(:) - MIN( 0.0,ZWQ(:)/XECHARGE )
+ END WHERE
+!
+ if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg ), 'DEPS', &
+ Unpack( zqpis(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecend ), 'DEPS', &
+ Unpack( zqnis(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 4 ), 'DEPS', &
+ Unpack( -zwq(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ end if
+!
+!
+!* 2.7 aggregation on snow/aggregates (riaggs)
+!
+ CALL COMPUTE_CHARGE_TRANSFER (ZRIAGGS, ZRIT, ZQIT, PTSTEP, &
+ XRTMIN_ELEC(4), XQTMIN(4), XCOEF_RQ_I, &
+ ZWQ, ZQIS, ZQSS)
+!
+ if ( lbudget_sv ) then
+ call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'AGGS', &
+ Unpack( -zwq(:), mask = odmicro(:, :, :), field = 0. ) )
+ call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 4 ), 'AGGS', &
+ Unpack( zwq(:), mask = odmicro(:, :, :), field = 0. ) )
+ end if
+!
+!
+!* 2.8 non-inductive charging during ice - snow collisions
+!
+ CALL ELEC_IAGGS_B()
+!
+ if ( lbudget_sv ) then
+ call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'NIIS', &
+ Unpack( -zwq_ni(:), mask = odmicro(:, :, :), field = 0. ) )
+ call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 4 ), 'NIIS', &
+ Unpack( zwq_ni(:), mask = odmicro(:, :, :), field = 0. ) )
+ end if
+!
+! Save the NI charging rate
+ DO JL = 1, KMICRO
+ XNI_IAGGS(II1(JL),II2(JL),II3(JL)) = ZWQ_NI(JL) * ZRHODREF(JL) ! C/m3/s
+ END DO
+!
+!
+!* 2.9 autoconversion of r_i for r_s production (riauts/ricnvs)
+!
+ CALL COMPUTE_CHARGE_TRANSFER (ZRIAUTS, ZRIT, ZQIT, PTSTEP, &
+ XRTMIN_ELEC(4), XQTMIN(4), XCOEF_RQ_I, &
+ ZWQ, ZQIS, ZQSS)
+!
+ if ( lbudget_sv ) then
+ call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'AUTS', &
+ Unpack( -zwq(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 4 ), 'AUTS', &
+ Unpack( zwq(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ end if
+!
+!
+!* 2.10 snow --> ice conversion (rscnvi)
+!
+ IF (CCLOUD == 'LIMA') THEN
+ CALL COMPUTE_CHARGE_TRANSFER (ZRICNVI, ZRST, ZQST, PTSTEP, &
+ XRTMIN_ELEC(5), XQTMIN(5), XCOEF_RQ_S, &
+ ZWQ, ZQSS, ZQIS)
+!
+ if ( lbudget_sv ) then
+ call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'CNVI', &
+ Unpack( zwq(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 4 ), 'CNVI', &
+ Unpack( -zwq(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ end if
+!
+!* 2.11 water vapor deposition on ice crystals (rvdepi)
+!
+ if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg ), 'SUBI', &
+ Unpack( zqpis(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecend ), 'SUBI', &
+ Unpack( zqnis(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ end if
+ !
+ ZWQ(:) = 0.
+ !
+ ! Only the sublimation of ice crystals is considered (negative part of PRVDEPI)
+ WHERE (ZRVDEPI(:) < 0. .AND. &
+ ZRIT(:) > XRTMIN_ELEC(4) .AND. ABS(ZQIT(:)) > XQTMIN(4))
+ ZWQ(:) = XCOEF_RQ_I * ZQIT(:) * ZRVDEPI(:) / ZRIT(:)
+ ZWQ(:) = SIGN( MIN( ABS(ZQIT(:)/PTSTEP),ABS(ZWQ(:)) ),ZQIS(:) )
+ !
+ ZQIS(:) = ZQIS(:) - ZWQ(:)
+ ZQPIS(:) = ZQPIS(:) + MAX( 0.0,ZWQ(:)/XECHARGE )
+ ZQNIS(:) = ZQNIS(:) - MIN( 0.0,ZWQ(:)/XECHARGE )
+ END WHERE
+!
+ if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg ), 'SUBI', &
+ Unpack( zqpis(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecend ), 'SUBI', &
+ Unpack( zqnis(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'SUBI', &
+ Unpack( -zwq(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ end if
+ END IF
+!
+!
+!* 2.12 water vapor deposition on graupel (rvdepg)
+!
+ if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg ), 'DEPG', &
+ Unpack( zqpis(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecend ), 'DEPG', &
+ Unpack( zqnis(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ end if
+!
+ ZWQ(:) = 0.
+ !
+ ! Only the sublimation of graupel is considered (negative part of PRVDEPG)
+ WHERE (ZRVDEPG(:) < 0. .AND. &
+ ZRGT(:) > XRTMIN_ELEC(6) .AND. ABS(ZQGT(:)) > XQTMIN(6))
+ ZWQ(:) = XCOEF_RQ_G * ZQGT(:) * ZRVDEPG(:) / ZRGT(:)
+ ZWQ(:) = SIGN( MIN( ABS(ZQGT(:)/PTSTEP),ABS(ZWQ(:)) ),ZQGS(:) )
+ !
+ ZQGS(:) = ZQGS(:) - ZWQ(:)
+ ZQPIS(:) = ZQPIS(:) + MAX( 0.0,ZWQ(:)/XECHARGE )
+ ZQNIS(:) = ZQNIS(:) - MIN( 0.0,ZWQ(:)/XECHARGE )
+ END WHERE
+!
+ if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg ), 'DEPG', &
+ Unpack( zqpis(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecend ), 'DEPG', &
+ Unpack( zqnis(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'DEPG', &
+ Unpack( -zwq(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ end if
+!
+!
+!------------------------------------------------------------------
+!
+!* 3. COMPUTE THE WARM PROCESS SOURCES
+! --------------------------------
+!
+!* 3.1 autoconversion of r_c for r_r production (rcautr)
+!
+ CALL COMPUTE_CHARGE_TRANSFER (ZRCAUTR, ZRCT, ZQCT, PTSTEP, &
+ XRTMIN_ELEC(2), XQTMIN(2), XCOEF_RQ_C, &
+ ZWQ, ZQCS, ZQRS)
+!
+ if ( lbudget_sv ) then
+ call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1 ), 'AUTO', &
+ Unpack( -zwq(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2 ), 'AUTO', &
+ Unpack( zwq(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ end if
+!
+!
+!* 3.2 accretion of r_c for r_r production (rcaccr)
+!
+ CALL COMPUTE_CHARGE_TRANSFER (ZRCACCR, ZRCT, ZQCT, PTSTEP, &
+ XRTMIN_ELEC(2), XQTMIN(2), XCOEF_RQ_C, &
+ ZWQ, ZQCS, ZQRS)
+!
+ if ( lbudget_sv ) then
+ call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1 ), 'ACCR', &
+ Unpack( -zwq(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2 ), 'ACCR', &
+ Unpack( zwq(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ end if
+!
+!
+!* 3.3 evaporation of raindrops (rrevav)
+!
+ if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg ), 'REVA', &
+ Unpack( zqpis(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecend ), 'REVA', &
+ Unpack( zqnis(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ end if
+!
+ ZWQ(:) = 0.
+ WHERE (ZRREVAV(:) > 0. .AND. &
+ ZRRT(:) > XRTMIN_ELEC(3) .AND. ABS(ZQRT(:)) > XQTMIN(3))
+ ZWQ(:) = XCOEF_RQ_R * ZQRT(:) * ZRREVAV(:) / ZRRT(:)
+ ZWQ(:) = SIGN( MIN( ABS(ZQRT(:)/PTSTEP),ABS(ZWQ(:)) ),ZQRS(:) )
+ !
+ ZQRS(:) = ZQRS(:) - ZWQ(:)
+ ZQPIS(:) = ZQPIS(:) + MAX( 0.0,ZWQ(:)/XECHARGE )
+ ZQNIS(:) = ZQNIS(:) - MIN( 0.0,ZWQ(:)/XECHARGE )
+ END WHERE
+!
+ if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg ), 'REVA', &
+ Unpack( zqpis(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecend ), 'REVA', &
+ Unpack( zqnis(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2 ), 'REVA', &
+ Unpack( -zwq(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ end if
+!
+!
+!* 3.4 conversion of drops to droplets (rrcvrc)
+!
+ IF (CCLOUD == 'LIMA') THEN
+ if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1 ), 'R2C1', &
+ Unpack( zqcs(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2 ), 'R2C1', &
+ Unpack( zqrs(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ end if
+!
+ CALL COMPUTE_CHARGE_TRANSFER (ZRRCVRC, ZRRT, ZQRT, PTSTEP, &
+ XRTMIN_ELEC(3), XQTMIN(3), XCOEF_RQ_R, &
+ ZWQ, ZQRS, ZQCS)
+!
+ if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1 ), 'R2C1', &
+ Unpack( zqcs(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2 ), 'R2C1', &
+ Unpack( zqrs(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ end if
+ END IF
+!
+!------------------------------------------------------------------
+!
+!* 4. COMPUTE THE FAST COLD PROCESS SOURCES FOR r_s
+! ---------------------------------------------
+!
+!* 4.1 cloud droplet riming of the aggregates
+!
+ if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1 ), 'RIM', &
+ Unpack( zqcs(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 4 ), 'RIM', &
+ Unpack( zqss(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'RIM', &
+ Unpack( zqgs(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ end if
+!
+!* 4.1.1 riming of the small sized aggregates (rcrimss)
+!
+ CALL COMPUTE_CHARGE_TRANSFER (ZRCRIMSS, ZRCT, ZQCT, PTSTEP, &
+ XRTMIN_ELEC(2), XQTMIN(2), XCOEF_RQ_C, &
+ ZWQ, ZQCS, ZQSS)
+!
+!
+!* 4.1.2 riming conversion of the large sized aggregates into graupel (rcrimsg)
+!
+ ZWQ(:) = 0.
+ WHERE (ZRCRIMSG(:) > 0. .AND. &
+ ZRCT(:) > XRTMIN_ELEC(2) .AND. ZRST(:) > XRTMIN_ELEC(5) .AND. &
+ ABS(ZQCT(:)) > XQTMIN(2))
+ ZWQ(:) = XCOEF_RQ_C * ZQCT(:) * ZRCRIMSG(:) / ZRCT(:) ! QCRIMSG
+ ZWQ(:) = SIGN( MIN( ABS(ZQCT(:)/PTSTEP),ABS(ZWQ(:)) ),ZQCS(:) )
+ !
+ ZQGS(:) = ZQGS(:) + ZWQ(:)
+ ZQCS(:) = ZQCS(:) - ZWQ(:)
+ END WHERE
+!
+!
+!* 4.1.3 riming conversion of the large sized aggregates into graupel (rsrimcg)
+!
+ GMASK(:) = .FALSE.
+ IGMASK = 0
+ DO JJ = 1, SIZE(GMASK)
+ IF (ZRSRIMCG(JJ) > 0. .AND. ZZT(JJ) < XTT .AND. &
+ ZRCT(JJ) > XRTMIN_ELEC(2) .AND. ZRST(JJ) > XRTMIN_ELEC(5) .AND. &
+ ZLBDAS(JJ) > 0.) THEN !++cb-- 12/07/23 condition ajoutee pour eviter log(0)
+ IGMASK = IGMASK + 1
+ I1(IGMASK) = JJ
+ GMASK(JJ) = .TRUE.
+ ELSE
+ GMASK(JJ) = .FALSE.
+ END IF
+ END DO
+ !
+ ALLOCATE(ZVEC1(IGMASK))
+ ALLOCATE(ZVEC2(IGMASK))
+ ALLOCATE(IVEC2(IGMASK))
+ !
+ ! select the ZLBDAS
+ DO JJ = 1, IGMASK
+ ZVEC1(JJ) = ZLBDAS(I1(JJ))
+ END DO
+ ! find the next lower indice for the ZLBDAS in the geometrical set of Lbda_s
+ ! used to tabulate some moments of the incomplete gamma function
+ ZVEC2(1:IGMASK) = MAX( 1.00001, MIN( REAL(IGAMINC)-0.00001, &
+ ZRIMINTP1 * LOG( ZVEC1(1:IGMASK) ) + ZRIMINTP2 ) )
+ IVEC2(1:IGMASK) = INT( ZVEC2(1:IGMASK) )
+ ZVEC2(1:IGMASK) = ZVEC2(1:IGMASK) - REAL( IVEC2(1:IGMASK) )
+ !
+ ! perform the linear interpolation of the normalized "XFS"-moment of
+ ! the incomplete gamma function
+ ZVEC1(1:IGMASK) = XGAMINC_RIM3( IVEC2(1:IGMASK)+1 ) * ZVEC2(1:IGMASK) &
+ - XGAMINC_RIM3( IVEC2(1:IGMASK) ) * (ZVEC2(1:IGMASK) - 1.0)
+ !
+ ZWQ(:) = 0.
+ DO JJ = 1, IGMASK
+ ZWQ(I1(JJ)) = ZVEC1(JJ)
+ END DO
+ !
+ DEALLOCATE(ZVEC1)
+ DEALLOCATE(ZVEC2)
+ DEALLOCATE(IVEC2)
+ !
+ ! riming-conversion of the large sized aggregates into graupeln (rsrimcg)
+ WHERE (ZRSRIMCG(:) > 0. .AND. &
+ ZRCT(:) > XRTMIN_ELEC(2) .AND. ZRST(:) > XRTMIN_ELEC(5) .AND. &
+ ABS(ZQCT(:)) > XQTMIN(2) .AND. ABS(ZEST(:)) > XESMIN)
+ ZWQ(:) = XQSRIMCG * ZEST(:) * ZCST(:) * & ! QSRIMCG
+ ZLBDAS(:)**XEXQSRIMCG * (1. - ZWQ(:)) / &
+ (PTSTEP * ZRHODREF(:))
+ ZWQ(:) = SIGN( MIN( ABS(ZQST(:)/PTSTEP),ABS(ZWQ(:)) ),ZQSS(:) )
+ !
+ ZQGS(:) = ZQGS(:) + ZWQ(:)
+ ZQSS(:) = ZQSS(:) - ZWQ(:)
+ END WHERE
+!
+ if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1 ), 'RIM', &
+ Unpack( zqcs(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 4 ), 'RIM', &
+ Unpack( zqss(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'RIM', &
+ Unpack( zqgs(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ end if
+!
+!
+!* 4.2 Hallett-Mossop ice multiplication process due to snow riming (rhmsi)
+!
+ IF (CCLOUD == 'LIMA') THEN
+ CALL COMPUTE_CHARGE_TRANSFER (ZRSHMSI, ZRST, ZQST, PTSTEP, &
+ XRTMIN_ELEC(4), XQTMIN(4), XCOEF_RQ_S, &
+ ZWQ, ZQSS, ZQIS)
+!
+ if ( lbudget_sv ) then
+ call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 4 ), 'HMS', &
+ Unpack( -zwq(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'HMS', &
+ Unpack( zwq(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ end if
+ END IF
+!
+!
+!* 4.3 Raindrop accretion onto the aggregates
+!
+ IGMASK = 0
+ DO JJ = 1, SIZE(GMASK)
+ IF (ZRRT(JJ) > ZRTMIN(3) .AND. ZLBDAR(JJ) > 0. .AND. &
+ ZRST(JJ) > ZRTMIN(5) .AND. ZLBDAS(JJ) > 0.) THEN
+ IGMASK = IGMASK + 1
+ I1(IGMASK) = JJ
+ GMASK(JJ) = .TRUE.
+ ELSE
+ GMASK(JJ) = .FALSE.
+ END IF
+ END DO
+ !
+ IF (IGMASK > 0) THEN
+ ALLOCATE(ZVEC1(IGMASK))
+ ALLOCATE(ZVEC2(IGMASK))
+ ALLOCATE(IVEC1(IGMASK))
+ ALLOCATE(IVEC2(IGMASK))
+ ALLOCATE(ZVECQ1(IGMASK))
+ ALLOCATE(ZVECQ2(IGMASK))
+ ALLOCATE(ZVECQ3(IGMASK))
+ !
+ ! select the (ZLBDAS,ZLBDAR) couplet
+ DO JJ = 1, IGMASK
+ ZVEC1(JJ) = ZLBDAS(I1(JJ))
+ ZVEC2(JJ) = ZLBDAR(I1(JJ))
+ END DO
+ !
+ ! find the next lower indice for the ZLBDAS and for the ZLBDAR in the geometrical
+ ! set of (Lbda_s,Lbda_r) couplet use to tabulate the kernels
+ ZVEC1(1:IGMASK) = MAX( 1.00001, MIN( REAL(IACCLBDAS)-0.00001, &
+ ZACCINTP1S * LOG( ZVEC1(1:IGMASK) ) + ZACCINTP2S ) )
+ IVEC1(1:IGMASK) = INT( ZVEC1(1:IGMASK) )
+ ZVEC1(1:IGMASK) = ZVEC1(1:IGMASK) - REAL( IVEC1(1:IGMASK) )
+ !
+ ZVEC2(1:IGMASK) = MAX( 1.00001, MIN( REAL(IACCLBDAR)-0.00001, &
+ ZACCINTP1R * LOG( ZVEC2(1:IGMASK) ) + ZACCINTP2R ) )
+ IVEC2(1:IGMASK) = INT( ZVEC2(1:IGMASK) )
+ ZVEC2(1:IGMASK) = ZVEC2(1:IGMASK) - REAL( IVEC2(1:IGMASK) )
+ !
+ ! perform the bilinear interpolation of the normalized kernels
+ ZVECQ1(:) = BI_LIN_INTP_V(XKER_Q_RACCSS, IVEC1, IVEC2, ZVEC1, ZVEC2, IGMASK)
+ ZVECQ2(:) = BI_LIN_INTP_V(XKER_Q_RACCS, IVEC1, IVEC2, ZVEC1, ZVEC2, IGMASK)
+ ZVECQ3(:) = BI_LIN_INTP_V(XKER_Q_SACCRG, IVEC1, IVEC2, ZVEC1, ZVEC2, IGMASK)
+ ZWQ1(:) = 0.
+ ZWQ2(:) = 0.
+ ZWQ3(:) = 0.
+ DO JJ = 1, IGMASK
+ ZWQ1(I1(JJ)) = ZVECQ1(JJ)
+ ZWQ2(I1(JJ)) = ZVECQ2(JJ)
+ ZWQ3(I1(JJ)) = ZVECQ3(JJ)
+ END DO
+!
+ DEALLOCATE(ZVEC1)
+ DEALLOCATE(ZVEC2)
+ DEALLOCATE(IVEC1)
+ DEALLOCATE(IVEC2)
+ DEALLOCATE(ZVECQ1)
+ DEALLOCATE(ZVECQ2)
+ DEALLOCATE(ZVECQ3)
+!
+!
+!* 4.3.1 raindrop accretion onto the small sized aggregates (rraccss)
+!
+ ZWQ4(:) = 0.
+ ZWQ5(:,:) = 0.
+ WHERE (ZRRACCSS(:) > 0. .AND. &
+ ZRRT(:) > XRTMIN_ELEC(3) .AND. ZRST(:) > XRTMIN_ELEC(5) .AND. &
+ ZCRT(:) > 0. .AND. ZCST(:) > 0. .AND. &
+ ZLBDAR(:) > 0. .AND. ZLBDAS(:) > 0. .AND. &
+ ABS(ZERT(:)) > XERMIN) ! and zzt(:) < xtt ?
+ ZWQ4(:) = XFQRACCS * ZERT(:) * ZRHOCOR(:) / (ZCOR00 * ZRHODREF(:)) * &
+ ZCRT(:) * ZCST(:) * &
+ (XLBQRACCS1 * ZLBDAR(:)**(-2.0 - XFR) + &
+ XLBQRACCS2 * ZLBDAR(:)**(-1.0 - XFR) * ZLBDAS(:)**(-1.0) + &
+ XLBQRACCS3 * ZLBDAR(:)**(-XFR) * ZLBDAS(:)**(-2.0))
+ ZWQ5(:,1) = ZWQ4(:) * ZWQ1(:) ! QRACCSS
+ ZWQ5(:,1) = SIGN( MIN( ABS(ZQRT(:)/PTSTEP),ABS(ZWQ5(:,1)) ),ZQRS(:) )
+ !
+ ZQRS(:) = ZQRS(:) - ZWQ5(:,1)
+ ZQSS(:) = ZQSS(:) + ZWQ5(:,1)
+ END WHERE
+!
+!
+!* 4.3.2 raindrop accretion-conversion of the large sized aggregates into graupel
+!* (rsaccrg & rraccsg)
+!
+ ZWQ5(:,2) = ZWQ2(:) * ZWQ4(:) ! QRACCS
+ WHERE (ZRRACCSG(:) > 0. .AND. &
+ ZRRT(:) > XRTMIN_ELEC(3) .AND. ZRST(:) > XRTMIN_ELEC(5) .AND. &
+ ZLBDAR(:) > 0. .AND. ZLBDAS(:) > 0.)
+ ZWQ5(:,3) = ZWQ5(:,2) - ZWQ5(:,1) ! QRACCSG
+ ZWQ5(:,3) = SIGN( MIN( ABS(ZQRT(:)/PTSTEP),ABS(ZWQ5(:,3)) ),ZQRS(:) )
+ !
+ ZQRS(:) = ZQRS(:) - ZWQ5(:,3)
+ ZQGS(:) = ZQGS(:) + ZWQ5(:,3)
+ END WHERE
+!
+ WHERE (ZRSACCRG(:) > 0. .AND. &
+ ZRRT(:) > XRTMIN_ELEC(3) .AND. ZRST(:) > XRTMIN_ELEC(5) .AND. &
+ ZCRT(:) > 0. .AND. ZCST(:) > 0. .AND. &
+ ZLBDAR(:) > 0. .AND. ZLBDAS(:) > 0. .AND. &
+ ABS(ZEST) > XESMIN)
+ ZWQ5(:,4) = ZWQ3(:) * XFQRACCS * ZEST(:) * &
+ ZRHOCOR(:) / (ZCOR00 * ZRHODREF(:)) * &
+ ZCRT(:) * ZCST(:) * &
+ (XLBQSACCRG1 * ZLBDAS(:)**(-2.0 - XFS) + &
+ XLBQSACCRG2 * ZLBDAS(:)**(-1.0 - XFS) * ZLBDAR(:)**(-1.0) + &
+ XLBQSACCRG3 * ZLBDAS(:)**(-XFS) * ZLBDAR(:)**(-2.0)) ! QSACCR
+ ZWQ5(:,4) = SIGN( MIN( ABS(ZQST(:)/PTSTEP),ABS(ZWQ5(:,4)) ),ZQSS(:) )
+ !
+ ZQSS(:) = ZQSS(:) - ZWQ5(:,4)
+ ZQGS(:) = ZQGS(:) + ZWQ5(:,4)
+ END WHERE
+ !
+ if ( lbudget_sv ) then
+ call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2 ), 'ACC', &
+ Unpack( (-zwq5(:,1) - zwq5(:,3)) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 4 ), 'ACC', &
+ Unpack( ( zwq5(:,1) - zwq5(:,4)) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'ACC', &
+ Unpack( ( zwq5(:,3) + zwq5(:,4)) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ end if
+ !
+ END IF ! end if igmask>0
+!
+!
+!* 4.4 conversion-melting of the aggregates (rsmltg)
+!
+ CALL COMPUTE_CHARGE_TRANSFER (ZRSMLTG, ZRST, ZQST, PTSTEP, &
+ XRTMIN_ELEC(5), XQTMIN(5), XCOEF_RQ_S, &
+ ZWQ, ZQSS, ZQGS)
+!
+ if ( lbudget_sv ) then
+ call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 4 ), 'CMEL', &
+ Unpack( -zwq(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'CMEL', &
+ Unpack( zwq(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ end if
+!
+!
+!* 4.5 cloud droplet collection onto aggregates by positive temperature (rcmltsr)
+!
+ IF (CCLOUD(1:3) == 'ICE') THEN
+ CALL COMPUTE_CHARGE_TRANSFER (ZRCMLTSR, ZRCT, ZQCT, PTSTEP, &
+ XRTMIN_ELEC(2), XQTMIN(2), XCOEF_RQ_C, &
+ ZWQ, ZQCS, ZQRS)
+!
+ if ( lbudget_sv ) then
+ call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1 ), 'CMEL', &
+ Unpack( -zwq(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2 ), 'CMEL', &
+ Unpack( zwq(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ end if
+ END IF
+!
+!
+!------------------------------------------------------------------
+!
+!* 5. COMPUTE THE FAST COLD PROCESS SOURCES FOR r_g
+! ---------------------------------------------
+!
+!* 5.1 rain contact freezing (ricfrrg, rrcfrig, ricfrr)
+!
+ if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2 ), 'CFRZ', &
+ Unpack( zqrs(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'CFRZ', &
+ Unpack( zqis(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'CFRZ', &
+ Unpack( zqgs(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ end if
+ !
+ ZWQ(:) = 0.
+ WHERE (ZRRCFRIG(:) > 0. .AND. &
+ ZRIT(:) > XRTMIN_ELEC(4) .AND. ZRRT(:) > XRTMIN_ELEC(3) .AND. &
+ ZCRT(:) > 0. .AND. &
+ ABS(ZERT(:)) > XERMIN .AND. ABS(ZQRT(:)) > XQTMIN(3))
+ ZWQ(:) = XQRCFRIG * ZLBDAR(:)**XEXQRCFRIG * ZCIT(:) * ZCRT(:) * &
+ ZERT(:) * ZRHOCOR(:) / (ZCOR00 * ZRHODREF(:)) ! QRCFRIG
+ ZWQ(:) = SIGN( MIN( ABS(ZQRT(:)/PTSTEP),ABS(ZWQ(:)) ),ZQRS(:) )
+ !
+ ZQGS(:) = ZQGS(:) + ZWQ(:)
+ ZQRS(:) = ZQRS(:) - ZWQ(:)
+ END WHERE
+ !
+ ZWQ(:) = 0.
+ WHERE (ZRICFRRG(:) > 0. .AND. &
+ ZRIT(:) > XRTMIN_ELEC(4) .AND. ZRRT(:) > XRTMIN_ELEC(3) .AND. &
+ ABS(ZQIT(:)) > XQTMIN(4))
+ ZWQ(:) = XCOEF_RQ_I * ZQIT(:) * ZRICFRRG(:) / ZRIT(:) ! QICFRRG
+ ZWQ(:) = SIGN( MIN( ABS(ZQIT(:)/PTSTEP),ABS(ZWQ(:)) ),ZQIS(:) )
+ !
+ ZQGS(:) = ZQGS(:) + ZWQ(:)
+ ZQIS(:) = ZQIS(:) - ZWQ(:)
+ ENDWHERE
+!
+!++CB-- 16/06/2022 il manque le traitement de qricfrr
+!
+ if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2 ), 'CFRZ', &
+ Unpack( zqrs(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'CFRZ', &
+ Unpack( zqis(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'CFRZ', &
+ Unpack( zqgs(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ end if
+!
+!
+!* 5.2 graupel dry growth (qcdryg, qrdryg, qidryg & qsdryg)
+!
+ ZWQ5(:,:) = 0.
+!
+!* 5.2.1 compute qcdryg
+!
+ WHERE (ZRCDRYG(:) > 0. .AND. &
+ ZRCT(:) > XRTMIN_ELEC(2) .AND. ZRGT(:) > XRTMIN_ELEC(6) .AND. &
+ ABS(ZQCT(:)) > XQTMIN(2))
+ ZWQ5(:,1) = XCOEF_RQ_C * ZQCT(:) * ZRCDRYG(:) / ZRCT(:)
+ ZWQ5(:,1) = SIGN( MIN( ABS(ZQCT(:)/PTSTEP),ABS(ZWQ5(:,1)) ),ZQCS(:) )
+ !
+ ZQCS(:) = ZQCS(:) - ZWQ5(:,1)
+ ZQGS(:) = ZQGS(:) + ZWQ5(:,1)
+ ENDWHERE
+!
+!
+!* 5.2.2 compute qidryg = qidryg_coal + qidryg_boun
+!
+ WHERE (ZRIDRYG(:) > 0. .AND. &
+ ZRIT(:) > XRTMIN_ELEC(4) .AND. ZRGT(:) > XRTMIN_ELEC(6) .AND. &
+ ABS(ZQIT(:)) > XQTMIN(4))
+ ZWQ5(:,2) = XCOEF_RQ_I * ZQIT(:) * ZRIDRYG(:) / ZRIT(:) ! QIDRYG_coal
+ ZWQ5(:,2) = SIGN( MIN( ABS(ZQIT(:)/PTSTEP),ABS(ZWQ5(:,2)) ),ZQIS(:) )
+ !
+ ZQIS(:) = ZQIS(:) - ZWQ5(:,2)
+ ZQGS(:) = ZQGS(:) + ZWQ5(:,2)
+ END WHERE
+!
+!
+!* 5.2.3 compute non-inductive charging durig ice - graupel collisions
+!
+ ! charge separation during collision between ice and graupel
+ CALL ELEC_IDRYG_B() ! QIDRYG_boun
+ !
+ if ( lbudget_sv ) then
+ call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'NIIG', &
+ Unpack( -zwq_ni(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'NIIG', &
+ Unpack( zwq_ni(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ end if
+ !
+ ! Save the NI charging rate
+ DO JL = 1, KMICRO
+ XNI_IDRYG(II1(JL),II2(JL),II3(JL)) = ZWQ_NI(JL) * ZRHODREF(JL) ! C/m3/s
+ END DO
+!
+!
+!* 5.2.4 compute qsdryg
+!
+ IGMASK = 0
+ DO JJ = 1, SIZE(GMASK)
+ IF (ZRST(JJ) > ZRTMIN(5) .AND. ZLBDAS(JJ) > 0. .AND. &
+ ZRGT(JJ) > ZRTMIN(6) .AND. ZLBDAG(JJ) > 0.) THEN
+ IGMASK = IGMASK + 1
+ I1(IGMASK) = JJ
+ GMASK(JJ) = .TRUE.
+ ELSE
+ GMASK(JJ) = .FALSE.
+ END IF
+ END DO
+ !
+ IF (IGMASK > 0) THEN
+ !
+ ALLOCATE(ZVEC1(IGMASK))
+ ALLOCATE(ZVEC2(IGMASK))
+ ALLOCATE(IVEC1(IGMASK))
+ ALLOCATE(IVEC2(IGMASK))
+ ALLOCATE(ZVECQ1(IGMASK))
+ ALLOCATE(ZVECQ2(IGMASK))
+ ALLOCATE(ZVECQ3(IGMASK))
+ ALLOCATE(ZVECQ4(IGMASK))
+ !
+ ! select the (ZLBDAG,ZLBDAS) couplet
+ DO JJ = 1, IGMASK
+ ZVEC1(JJ) = ZLBDAG(I1(JJ))
+ ZVEC2(JJ) = ZLBDAS(I1(JJ))
+ END DO
+ !
+ ! find the next lower indice for the ZLBDAG and for the ZLBDAS in the geometrical set
+ ! of (Lbda_g,Lbda_s) couplet use to tabulate the SDRYG-kernel
+ ZVEC1(1:IGMASK) = MAX(1.00001, MIN(REAL(IDRYLBDAG)-0.00001, &
+ ZDRYINTP1G*LOG(ZVEC1(1:IGMASK))+ZDRYINTP2G))
+ IVEC1(1:IGMASK) = INT(ZVEC1(1:IGMASK) )
+ ZVEC1(1:IGMASK) = ZVEC1(1:IGMASK) - REAL(IVEC1(1:IGMASK))
+ !
+ ZVEC2(1:IGMASK) = MAX(1.00001, MIN( REAL(IDRYLBDAS)-0.00001, &
+ ZDRYINTP1S*LOG(ZVEC2(1:IGMASK))+ZDRYINTP2S))
+ IVEC2(1:IGMASK) = INT(ZVEC2(1:IGMASK))
+ ZVEC2(1:IGMASK) = ZVEC2(1:IGMASK) - REAL(IVEC2(1:IGMASK))
+ !
+ ! perform the bilinear interpolation of the normalized QSDRYG-kernels
+ ! normalized Q-SDRYG-kernel
+ ZVECQ1(:) = BI_LIN_INTP_V(XKER_Q_SDRYG, IVEC1, IVEC2, ZVEC1, ZVEC2, IGMASK)
+ ZWQ5(:,3) = 0. ! normalement pas utile
+ DO JJ = 1, IGMASK
+ ZWQ5(I1(JJ),3) = ZVECQ1(JJ)
+ END DO
+ !
+ ! normalized Q-???-kernel
+ IF (CNI_CHARGING == 'TAKAH' .OR. CNI_CHARGING == 'SAUN1' .OR. &
+ CNI_CHARGING == 'SAUN2' .OR. CNI_CHARGING == 'SAP98' .OR. &
+ CNI_CHARGING == 'GARDI' .OR. &
+ CNI_CHARGING == 'BSMP1' .OR. CNI_CHARGING == 'BSMP2' .OR. &
+ CNI_CHARGING == 'TEEWC' .OR. CNI_CHARGING == 'TERAR') THEN
+ ZVECQ2(:) = BI_LIN_INTP_V(XKER_Q_LIMSG, IVEC1, IVEC2, ZVEC1, ZVEC2, IGMASK)
+ ZWQ5(:,4) = 0. ! normalement pas utile
+ DO JJ = 1, IGMASK
+ ZWQ5(I1(JJ),4) = ZVECQ2(JJ)
+ END DO
+ END IF
+ !
+ ! normalized Q-SDRYG-bouncing kernel
+ IF (CNI_CHARGING == 'TAKAH' .OR. CNI_CHARGING == 'HELFA' .OR. &
+ CNI_CHARGING == 'GARDI') THEN
+ ZVECQ3(:) = BI_LIN_INTP_V(XKER_Q_SDRYGB,IVEC1,IVEC2,ZVEC1,ZVEC2,IGMASK)
+ ZWQ5(:,5) = 0. ! normalement pas utile
+ DO JJ = 1, IGMASK
+ ZWQ5(I1(JJ),5) = ZVECQ3(JJ)
+ END DO
+ ELSE
+ ZVECQ3(:) = BI_LIN_INTP_V(XKER_Q_SDRYGB1,IVEC1,IVEC2,ZVEC1,ZVEC2,IGMASK)
+ ZVECQ4(:) = BI_LIN_INTP_V(XKER_Q_SDRYGB2,IVEC1,IVEC2,ZVEC1,ZVEC2,IGMASK)
+ ZWQ5(:,6:7) = 0. ! normalement pas utile
+ DO JJ = 1, IGMASK
+ ZWQ5(I1(JJ),6) = ZVECQ3(JJ) ! Dvqsgmn if charge>0
+ ZWQ5(I1(JJ),7) = ZVECQ4(JJ) ! Dvqsgmn if charge<0
+ END DO
+ ENDIF
+ !
+ DEALLOCATE(ZVEC1)
+ DEALLOCATE(ZVEC2)
+ DEALLOCATE(IVEC1)
+ DEALLOCATE(IVEC2)
+ DEALLOCATE(ZVECQ1)
+ DEALLOCATE(ZVECQ2)
+ DEALLOCATE(ZVECQ3)
+ DEALLOCATE(ZVECQ4)
+!
+!++CB-- CALCULER E_SG ICI POUR EVITER DES CALCULS REDONDANTS
+ !
+ ! compute QSDRYG_coal
+ WHERE (ZRSDRYG(:) > 0 .AND. & !GDRY(:) .AND. &
+ ZRST(:) > XRTMIN_ELEC(5) .AND. &
+ ZLBDAS(:) > 0. .AND. ZLBDAG(:) > 0. .AND. &
+ ABS(ZQST(:)) > XQTMIN(5) .AND. ABS(ZEST(:)) > XESMIN)
+ ZWQ5(:,3) = ZWQ5(:,3) * XFQSDRYG * &
+ ZCOLSG * EXP(ZCOLEXSG * (ZZT(:) - XTT)) * &
+ ZEST(:) * ZRHOCOR(:) / (ZCOR00 * ZRHODREF(:)) * &
+ ZCGT(:) * ZCST(:) * &
+ (XLBQSDRYG1 * ZLBDAS(:)**(-2.0-XFS) + &
+ XLBQSDRYG2 * ZLBDAS(:)**(-1.0-XFS) * ZLBDAG(:)**(-1.0) + &
+ XLBQSDRYG3 * ZLBDAS(:)**(-XFS) * ZLBDAG(:)**(-2.0)) ! QSDRYG_coal
+ ZWQ5(:,3) = SIGN( MIN( ABS(ZQST(:)/PTSTEP),ABS(ZWQ5(:,3)) ),ZQSS(:) )
+ !
+ ZQSS(:) = ZQSS(:) - ZWQ5(:,3)
+ ZQGS(:) = ZQGS(:) + ZWQ5(:,3)
+ ELSEWHERE
+ ZWQ5(:,3) = 0.
+ END WHERE
+!
+!
+!* 5.2.5 compute non-inductive charging during snow - graupel collisions
+!
+ ! compute QSDRYG_boun
+ CALL ELEC_SDRYG_B()
+ !
+ if ( lbudget_sv ) then
+ call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 4 ), 'NISG', &
+ Unpack( -zwq_ni(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'NISG', &
+ Unpack( zwq_ni(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ end if
+ !
+ ! Save the NI charging rate
+ DO JL = 1, KMICRO
+ XNI_SDRYG(II1(JL),II2(JL),II3(JL)) = ZWQ_NI(JL) * ZRHODREF(JL) ! C/m3/s
+ END DO
+ END IF ! end if igmask>0
+!
+!
+!* 5.2.6 compute qrdryg
+!
+ IGMASK = 0
+ GMASK(:) = .FALSE.
+ DO JJ = 1, SIZE(GMASK)
+ IF (ZRRT(JJ) > ZRTMIN(3) .AND. ZLBDAR(JJ) > 0. .AND. &
+ ZRGT(JJ) > ZRTMIN(6) .AND. ZLBDAG(JJ) > 0.) THEN
+ IGMASK = IGMASK + 1
+ I1(IGMASK) = JJ
+ GMASK(JJ) = .TRUE.
+ ELSE
+ GMASK(JJ) = .FALSE.
+ END IF
+ END DO
+ !
+ IF (IGMASK > 0) THEN
+ !
+ ALLOCATE(ZVEC1(IGMASK))
+ ALLOCATE(ZVEC2(IGMASK))
+ ALLOCATE(IVEC1(IGMASK))
+ ALLOCATE(IVEC2(IGMASK))
+ ALLOCATE(ZVECQ1(IGMASK))
+ !
+ ! select the (ZLBDAG,ZLBDAR) couplet
+ DO JJ = 1, IGMASK
+ ZVEC1(JJ) = ZLBDAG(I1(JJ))
+ ZVEC2(JJ) = ZLBDAR(I1(JJ))
+ END DO
+ !
+ ! find the next lower indice for the ZLBDAG and for the ZLBDAR in the geometrical set
+ ! of (Lbda_g,Lbda_r) couplet use to tabulate the QDRYG-kernel
+ ZVEC1(1:IGMASK) = MAX(1.00001, MIN( REAL(IDRYLBDAG)-0.00001, &
+ ZDRYINTP1G*LOG(ZVEC1(1:IGMASK))+ZDRYINTP2G))
+ IVEC1(1:IGMASK) = INT(ZVEC1(1:IGMASK))
+ ZVEC1(1:IGMASK) = ZVEC1(1:IGMASK) - REAL(IVEC1(1:IGMASK))
+ !
+ ZVEC2(1:IGMASK) = MAX(1.00001, MIN( REAL(IDRYLBDAR)-0.00001, &
+ ZDRYINTP1R*LOG(ZVEC2(1:IGMASK))+ZDRYINTP2R))
+ IVEC2(1:IGMASK) = INT(ZVEC2(1:IGMASK))
+ ZVEC2(1:IGMASK) = ZVEC2(1:IGMASK) - REAL(IVEC2(1:IGMASK))
+ !
+ ! perform the bilinear interpolation of the normalized RDRYG-kernel
+ ZVECQ1(:) = BI_LIN_INTP_V(XKER_Q_RDRYG, IVEC1, IVEC2, ZVEC1, ZVEC2, IGMASK)
+ ZWQ5(:,4) = 0.
+ DO JJ = 1, IGMASK
+ ZWQ5(I1(JJ),4) = ZVECQ1(JJ)
+ END DO
+ !
+ DEALLOCATE(ZVEC1)
+ DEALLOCATE(ZVEC2)
+ DEALLOCATE(IVEC1)
+ DEALLOCATE(IVEC2)
+ DEALLOCATE(ZVECQ1)
+ !
+ ! compute QRDRYG
+ WHERE (ZRRDRYG(:) > 0. .AND. &
+ ZRRT(:) > XRTMIN_ELEC(3) .AND. ZRGT(:) > XRTMIN_ELEC(6) .AND. &
+ ZCRT(:) > 0. .AND. ZCGT(:) > 0. .AND. &
+ ZLBDAR(:) > 0. .AND. ZLBDAG(:) > 0. .AND. &
+ ABS(ZERT(:)) > XERMIN .AND. ABS(ZQRT(:)) > XQTMIN(3))
+ ZWQ5(:,4) = ZWQ5(:,4) * XFQRDRYG * &
+ ZRHODREF(:)**(-ZCEXVT) * &
+ ZERT(:) * ZCGT(:) * ZCRT(:) * &
+ (XLBQRDRYG1 * ZLBDAR(:)**(-2.0 - XFR) + &
+ XLBQRDRYG2 * ZLBDAR(:)**(-1.0 - XFR) * ZLBDAG(:)**(-1.0) + &
+ XLBQRDRYG3 * ZLBDAR(:)**(-XFR) * ZLBDAG(:)**(-2.0))
+ ZWQ5(:,4) = SIGN( MIN( ABS(ZQRT(:)/PTSTEP),ABS(ZWQ5(:,4)) ),ZQRS(:) )
+ !
+ ZQRS(:) = ZQRS(:) - ZWQ5(:,4)
+ ZQGS(:) = ZQGS(:) + ZWQ5(:,4)
+ ELSEWHERE
+ ZWQ5(:,4) = 0.
+ ENDWHERE
+! ZRDRYG(:) = ZWQ5(:,1) + ZWQ5(:,2) + ZWQ5(:,3) + ZWQ5(:,4)
+!
+ if ( lbudget_sv ) then
+ call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1 ), 'DRYG', &
+ Unpack( -zwq5(:,1) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2 ), 'DRYG', &
+ Unpack( -zwq5(:,4) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'DRYG', &
+ Unpack( -zwq5(:,2) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 4 ), 'DRYG', &
+ Unpack( -zwq5(:,3) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'DRYG', &
+ Unpack( (zwq5(:,1) + zwq5(:,2) + zwq5(:,3) + zwq5(:,4)) * zrhodj(:), &
+ mask = odmicro(:, :, :), field = 0. ) )
+ end if
+!
+ END IF ! end if igmask>0
+!
+!
+!* 5.3 Hallett-Mossop ice multiplication process due to graupel riming (rhmgi)
+!
+ IF (CCLOUD == 'LIMA') THEN
+ CALL COMPUTE_CHARGE_TRANSFER (ZRGHMGI, ZRGT, ZQGT, PTSTEP, &
+ XRTMIN_ELEC(6), XQTMIN(6), XCOEF_RQ_G, &
+ ZWQ, ZQGS, ZQIS)
+!
+ if ( lbudget_sv ) then
+ call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'HMG', &
+ Unpack( -zwq(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'HMG', &
+ Unpack( zwq(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ end if
+ END IF
+!
+!
+!* 5.4 graupel wet growth (rcwetg, rrwetg, riwetg & rswetg)
+!
+!* 5.4.1 compute qcwetg
+!
+ ZWQ5(:,5) = 0.
+ WHERE (ZRCWETG(:) > 0. .AND. ZRCT(:) > XRTMIN_ELEC(2) .AND. ABS(ZQCT(:)) > XQTMIN(2) .AND. &
+ ZRGT(:) > XRTMIN_ELEC(6))
+ ZWQ5(:,5) = XCOEF_RQ_C * ZRCWETG(:) * ZQCT(:) / ZRCT(:)
+ ZWQ5(:,5) = SIGN( MIN( ABS(ZQCT(:)/PTSTEP),ABS(ZWQ5(:,5)) ),ZQCS(:) )
+ END WHERE
+!
+!
+!* 5.4.1 compute qiwetg
+!
+ ZWQ5(:,6) = 0.
+ WHERE (ZRIWETG(:) > 0. .AND. ZRIT(:) > XRTMIN_ELEC(4) .AND. ABS(ZQIT(:)) > XQTMIN(4) .AND. &
+ ZRGT(:) > XRTMIN_ELEC(6))
+ ZWQ5(:,6) = XCOEF_RQ_I * ZRIWETG(:) * ZQIT(:) / ZRIT(:)
+ ZWQ5(:,6) = SIGN( MIN( ABS(ZQIT(:)/PTSTEP),ABS(ZWQ5(:,6)) ),ZQIS(:) )
+ END WHERE
+!
+!
+!* 5.4.2 compute qswetg
+!
+ ZWQ5(:,7) = 0.
+ WHERE (ZRSWETG(:) > 0. .AND. ZRST(:) > XRTMIN_ELEC(5) .AND. ABS(ZQST(:)) > XQTMIN(5) .AND. &
+ ZRGT(:) > XRTMIN_ELEC(6))
+ ZWQ5(:,7) = XCOEF_RQ_S * ZRSWETG(:) * ZQST(:) / ZRST(:)
+ ZWQ5(:,7) = SIGN( MIN( ABS(ZQST(:)/PTSTEP),ABS(ZWQ5(:,7)) ),ZQSS(:) )
+ END WHERE
+!
+!
+!* 5.4.3 compute qrwetg
+!
+ ZWQ5(:,8) = 0.
+ WHERE (ZRRWETG(:) > 0. .AND. ZRRT(:) > XRTMIN_ELEC(3) .AND. ABS(ZQRT(:)) > XQTMIN(3) .AND. &
+ ZRGT(:) > XRTMIN_ELEC(6))
+ ZWQ5(:,8) = XCOEF_RQ_R * ZQRT(:) * ZRRWETG(:) / ZRRT(:)
+ ZWQ5(:,8) = SIGN( MIN( ABS(ZQRT(:)/PTSTEP),ABS(ZWQ5(:,8)) ),ZQRS(:) )
+ ENDWHERE
+!
+!
+!* 5.4.4 conversion of graupel into hail (rwetgh)
+!
+ if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'WETG', &
+ Unpack( zqgs(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ end if
+!
+ IF (KRR == 7) THEN
+ ZWQ5(:,9) = 0.
+ WHERE (ZRWETGH(:) > 0. .AND. ZRGT(:) > XRTMIN_ELEC(6) .AND. ABS(ZQGT(:)) > XQTMIN(6))
+ ZWQ5(:,9) = XCOEF_RQ_G * ZQGT(:) * ZRWETGH(:) / ZRGT(:)
+ ZWQ5(:,9) = SIGN( MIN( ABS(ZQGT(:)/PTSTEP),ABS(ZWQ5(:,9)) ),ZQGS(:) )
+ END WHERE
+ !
+ WHERE (ZRCWETG(:) > 0. .OR. ZRRWETG(:) > 0. .OR. ZRIWETG(:) > 0. .OR. &
+ ZRSWETG(:) > 0. .OR. ZRWETGH(:) > 0.)
+ ZQCS(:) = ZQCS(:) - ZWQ5(:,5)
+ ZQRS(:) = ZQRS(:) - ZWQ5(:,8)
+ ZQIS(:) = ZQIS(:) - ZWQ5(:,6)
+ ZQSS(:) = ZQSS(:) - ZWQ5(:,7)
+ ZQGS(:) = ZQGS(:) + ZWQ5(:,5) + ZWQ5(:,8) + ZWQ5(:,6) + ZWQ5(:,7) - ZWQ5(:,9)
+ ZQHS(:) = ZQHS(:) + ZWQ5(:,9)
+ END WHERE
+ ELSE IF (KRR == 6) THEN
+ WHERE (ZRCWETG(:) > 0. .OR. ZRRWETG(:) > 0. .OR. ZRIWETG(:) > 0. .OR. &
+ ZRSWETG(:) > 0.)
+ ZQCS(:) = ZQCS(:) - ZWQ5(:,5)
+ ZQRS(:) = ZQRS(:) - ZWQ5(:,8)
+ ZQIS(:) = ZQIS(:) - ZWQ5(:,6)
+ ZQSS(:) = ZQSS(:) - ZWQ5(:,7)
+ ZQGS(:) = ZQGS(:) + ZWQ5(:,5) + ZWQ5(:,8) + ZWQ5(:,6) + ZWQ5(:,7)
+ END WHERE
+ END IF
+!
+ if ( lbudget_sv ) then
+ call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1 ), 'WETG', &
+ Unpack( -zwq5(:,5) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2 ), 'WETG', &
+ Unpack( -zwq5(:,8) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'WETG', &
+ Unpack( -zwq5(:,6) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 4 ), 'WETG', &
+ Unpack( -zwq5(:,7) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'WETG', &
+ Unpack( zqgs(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ if ( krr == 7 ) &
+ call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 6 ), 'WETG', &
+ Unpack( zwq5(:,9) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ end if
+!
+!
+!* 5.5 compute charge separation by the inductive mechanism
+!
+! Computation of the charge transfer rate during inductive mechanism
+! Only the bouncing droplet-graupel collision when the graupel is in the dry
+! growth mode is considered
+! The electric field is limited to 100 kV/m
+!
+ IF (LINDUCTIVE) THEN
+ ZWQ(:) = 0.
+ GMASK(:) = ZRCDRYG(:) > 0.
+ IGMASK = COUNT(GMASK(:))
+ !
+ IF (IGMASK > 0) THEN
+ ZWQ(:) = 0.
+ !
+ WHERE (GMASK(:) .AND. &
+ ZEFIELDW(:) /= 0. .AND. ABS(ZEGT(:)) > XEGMIN .AND. &
+ ZLBDAG(:) > 0. .AND. ZCGT(:) > 0. .AND. &
+ ZRGT(:) > XRTMIN_ELEC(6) .AND. ZRCT(:) > XRTMIN_ELEC(2))
+ ZWQ(:) = XIND1 * ZCGT(:) * ZRHOCOR(:) * &
+ (XIND2 * SIGN(MIN(100.E3, ABS(ZEFIELDW(:))), ZEFIELDW(:)) * &
+ ZLBDAG(:) **(-2.-ZDG) - &
+ XIND3 * ZEGT(:) * ZLBDAG(:)**(-XFG-ZDG))
+ ZWQ(:) = ZWQ(:) / ZRHODREF(:)
+ !
+ ZQGS(:) = ZQGS(:) + ZWQ(:)
+ ZQCS(:) = ZQCS(:) - ZWQ(:)
+ END WHERE
+ !
+ if ( lbudget_sv ) then
+ call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1 ), 'INCG', &
+ Unpack( -zwq(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'INCG', &
+ Unpack( zwq(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ end if
+ !
+ ! Save the inductive charging rate
+ DO JL = 1, KMICRO
+ XIND_RATE(II1(JL),II2(JL),II3(JL)) = ZWQ(JL) * ZRHODREF(JL) ! C/m3/s
+ END DO
+ END IF
+ !
+ ! Save the inductive charging rate
+ DO JL = 1, KMICRO
+ XIND_RATE(II1(JL),II2(JL),II3(JL)) = ZWQ(JL) * ZRHODREF(JL) ! C/m3/s
+ END DO
+ END IF
+!
+!
+!* 5.6 melting of the graupel (rgmltr)
+!
+ CALL COMPUTE_CHARGE_TRANSFER (ZRGMLTR, ZRGT, ZQGT, PTSTEP, &
+ XRTMIN_ELEC(6), XQTMIN(6), XCOEF_RQ_G, &
+ ZWQ, ZQGS, ZQRS)
+!
+ if ( lbudget_sv ) then
+ call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2 ), 'GMLT', &
+ Unpack( zwq(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'GMLT', &
+ Unpack( -zwq(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ end if
+!
+!
+!------------------------------------------------------------------
+!
+!* 6. COMPUTE THE OPTIONAL SECONDARY ICE PRODUCTION
+! ---------------------------------------------
+!
+! dans un premier temps, on considere que la charge echangee est proportionnelle
+! a la masse echangee
+!
+!* 6.1 collisional ice breakup (cibu)
+!
+ IF (CCLOUD == 'LIMA' .AND. LCIBU) &
+ CALL COMPUTE_CHARGE_TRANSFER (ZRICIBU, ZRST, ZQST, PTSTEP, &
+ XRTMIN_ELEC(5), XQTMIN(5), XCOEF_RQ_S, &
+ ZWQ, ZQSS, ZQIS)
+!
+!* 6.2 raindrop shattering freezing (rdsf)
+!
+ IF (CCLOUD == 'LIMA' .AND. LRDSF) &
+ CALL COMPUTE_CHARGE_TRANSFER (ZRIRDSF, ZRRT, ZQRT, PTSTEP, &
+ XRTMIN_ELEC(3), XQTMIN(3), XCOEF_RQ_R, &
+ ZWQ, ZQRS, ZQIS)
+!
+!
+!------------------------------------------------------------------
+!
+!* 7. COMPUTE THE FAST COLD PROCESS SOURCES FOR r_h
+! ---------------------------------------------
+!
+ IF (KRR == 7) THEN
+!
+!* 7.1 wet growth of hail (qcweth, qrweth, qiweth, qsweth, qgweth)
+!
+ ZWQ5(:,:) = 0.
+ !
+ WHERE (ZRCWETH(:) > 0. .AND. ZRCT(:) > XRTMIN_ELEC(2))
+ ZWQ5(:,1) = XCOEF_RQ_C * ZQCT(:) * ZRCWETH(:) / ZRCT(:) ! QCWETH
+ ZWQ5(:,1) = SIGN( MIN( ABS(ZQCT(:)/PTSTEP),ABS(ZWQ5(:,1)) ),ZQCS(:) )
+ !
+ ZQCS(:) = ZQCS(:) - ZWQ5(:,1)
+ ZQHS(:) = ZQHS(:) + ZWQ5(:,1)
+ END WHERE
+ !
+ WHERE (ZRIWETH(:) > 0. .AND. ZRIT(:) > XRTMIN_ELEC(4))
+ ZWQ5(:,2) = XCOEF_RQ_I * ZQIT(:) * ZRIWETH(:) / ZRIT(:) ! QIWETH
+ ZWQ5(:,2) = SIGN( MIN( ABS(ZQIT(:)/PTSTEP),ABS(ZWQ5(:,2)) ),ZQIS(:) )
+ !
+ ZQIS(:) = ZQIS(:) - ZWQ5(:,2)
+ ZQHS(:) = ZQHS(:) + ZWQ5(:,2)
+ END WHERE
+ !
+ WHERE (ZRSWETH(:) > 0. .AND. ZRST(:) > XRTMIN_ELEC(5))
+ ZWQ5(:,3) = XCOEF_RQ_S * ZQST(:) * ZRSWETH(:) / ZRST(:) ! QSWETH
+ ZWQ5(:,3) = SIGN( MIN( ABS(ZQST(:)/PTSTEP),ABS(ZWQ5(:,3)) ),ZQSS(:) )
+ !
+ ZQSS(:) = ZQSS(:) - ZWQ5(:,3)
+ ZQHS(:) = ZQHS(:) + ZWQ5(:,3)
+ END WHERE
+ !
+ WHERE (ZRGWETH(:) > 0. .AND. ZRGT(:) > XRTMIN_ELEC(6))
+ ZWQ5(:,5) = XCOEF_RQ_G * ZQGT(:) * ZRGWETH(:) / ZRGT(:) ! QGWETH
+ ZWQ5(:,5) = SIGN( MIN( ABS(ZQGT(:)/PTSTEP),ABS(ZWQ5(:,5)) ),ZQGS(:) )
+ !
+ ZQGS(:) = ZQGS(:) - ZWQ5(:,5)
+ ZQHS(:) = ZQHS(:) + ZWQ5(:,5)
+ END WHERE
+ !
+ WHERE (ZRRWETH(:) > 0. .AND. ZRRT(:) > XRTMIN_ELEC(3))
+ ZWQ5(:,4) = XCOEF_RQ_R * ZQRT(:) * ZRRWETH(:) / ZRRT(:) ! QRWETH
+ ZWQ5(:,4) = SIGN( MIN( ABS(ZQRT(:)/PTSTEP),ABS(ZWQ5(:,4)) ),ZQRS(:) )
+ !
+ ZQRS(:) = ZQRS(:) - ZWQ5(:,4)
+ ZQHS(:) = ZQHS(:) + ZWQ5(:,4)
+ END WHERE
+!
+ if ( lbudget_sv ) then
+ call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1 ), 'WETH', &
+ Unpack( -zwq5(:, 1) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2 ), 'WETH', &
+ Unpack( -zwq5(:, 4) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'WETH', &
+ Unpack( -zwq5(:, 2) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 4 ), 'WETH', &
+ Unpack( -zwq5(:, 3) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'WETH', &
+ Unpack( -zwq5(:, 5) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 6 ), 'WETH', &
+ Unpack( ( zwq5(:, 1) + zwq5(:, 2) + zwq5(:, 3) + zwq5(:, 4) + zwq5(:, 5) ) &
+ * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ end if
+!
+!
+!* 7.2 dry growth of hail (qcdryh, qrdryh, qidryh, qsdryh, qgdryh)
+!
+ ZWQ5(:,:) = 0.
+ !
+ WHERE (ZRCDRYH(:) > 0. .AND. ZRCT(:) > XRTMIN_ELEC(2))
+ ZWQ5(:,1) = XCOEF_RQ_C * ZQCT(:) * ZRCDRYH(:) / ZRCT(:) ! QCDRYH
+ ZWQ5(:,1) = SIGN( MIN( ABS(ZQCT(:)/PTSTEP),ABS(ZWQ5(:,1)) ),ZQCS(:) )
+ !
+ ZQCS(:) = ZQCS(:) - ZWQ5(:,1)
+ ZQHS(:) = ZQHS(:) + ZWQ5(:,1)
+ END WHERE
+ !
+ WHERE (ZRIDRYH(:) > 0. .AND. ZRIT(:) > XRTMIN_ELEC(4))
+ ZWQ5(:,2) = XCOEF_RQ_I * ZQIT(:) * ZRIDRYH(:) / ZRIT(:) ! QIDRYH
+ ZWQ5(:,2) = SIGN( MIN( ABS(ZQIT(:)/PTSTEP),ABS(ZWQ5(:,2)) ),ZQIS(:) )
+ !
+ ZQIS(:) = ZQIS(:) - ZWQ5(:,2)
+ ZQHS(:) = ZQHS(:) + ZWQ5(:,2)
+ END WHERE
+ !
+ WHERE (ZRSDRYH(:) > 0. .AND. ZRST(:) > XRTMIN_ELEC(5))
+ ZWQ5(:,3) = XCOEF_RQ_S * ZQST(:) * ZRSDRYH(:) / ZRST(:) ! QSDRYH
+ ZWQ5(:,3) = SIGN( MIN( ABS(ZQST(:)/PTSTEP),ABS(ZWQ5(:,3)) ),ZQSS(:) )
+ !
+ ZQSS(:) = ZQSS(:) - ZWQ5(:,3)
+ ZQHS(:) = ZQHS(:) + ZWQ5(:,3)
+ END WHERE
+ !
+ WHERE (ZRGDRYH(:) > 0. .AND. ZRGT(:) > XRTMIN_ELEC(6))
+ ZWQ5(:,5) = XCOEF_RQ_G * ZQGT(:) * ZRGDRYH(:) / ZRGT(:) ! QGDRYH
+ ZWQ5(:,5) = SIGN( MIN( ABS(ZQGT(:)/PTSTEP),ABS(ZWQ5(:,5)) ),ZQGS(:) )
+ !
+ ZQGS(:) = ZQGS(:) - ZWQ5(:,5)
+ ZQHS(:) = ZQHS(:) + ZWQ5(:,5)
+ END WHERE
+ !
+ WHERE (ZRRDRYH(:) > 0. .AND. ZRRT(:) > XRTMIN_ELEC(3))
+ ZWQ5(:,4) = XCOEF_RQ_R * ZQRT(:) * ZRRDRYH(:) / ZRRT(:) ! QRDRYH
+ ZWQ5(:,4) = SIGN( MIN( ABS(ZQRT(:)/PTSTEP),ABS(ZWQ5(:,4)) ),ZQRS(:) )
+ !
+ ZQRS(:) = ZQRS(:) - ZWQ5(:,4)
+ ZQHS(:) = ZQHS(:) + ZWQ5(:,4)
+ END WHERE
+!
+!
+!* 7.3 conversion of hail into graupel (qdryhg)
+!
+ CALL COMPUTE_CHARGE_TRANSFER (ZRDRYHG, ZRHT, ZQHT, PTSTEP, &
+ XRTMIN_ELEC(7), XQTMIN(7), XCOEF_RQ_H, &
+ ZWQ, ZQHS, ZQGS)
+!
+ if ( lbudget_sv ) then
+ call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1 ), 'DRYH', &
+ Unpack( -zwq5(:, 1) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2 ), 'DRYH', &
+ Unpack( -zwq5(:, 4) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'DRYH', &
+ Unpack( -zwq5(:, 2) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 4 ), 'DRYH', &
+ Unpack( -zwq5(:, 3) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'DRYH', &
+ Unpack( (-zwq5(:, 5) - zwq(:)) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 6 ), 'DRYH', &
+ Unpack( ( zwq5(:, 1) + zwq5(:, 2) + zwq5(:, 3) + zwq5(:, 4) + zwq5(:, 5) + zwq(:) ) &
+ * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ end if
+!
+!
+!* 7.4 melting of hail (qhmltr)
+!
+ CALL COMPUTE_CHARGE_TRANSFER (ZRHMLTR, ZRHT, ZQHT, PTSTEP, &
+ XRTMIN_ELEC(7), XQTMIN(7), XCOEF_RQ_H, &
+ ZWQ, ZQHS, ZQRS)
+!
+ if ( lbudget_sv ) then
+ call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2 ), 'HMLT', &
+ Unpack( zwq(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 6 ), 'HMLT', &
+ Unpack( -zwq(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ end if
+!
+ END IF ! end if krr==7
+!
+!
+!------------------------------------------------------------------
+!
+!* 8. COMPUTE THE FAST COLD PROCESS SOURCES FOR r_i
+! ---------------------------------------------
+!
+!* 8.1 Bergeron-Findeisen effect (qcberi)
+!
+ CALL COMPUTE_CHARGE_TRANSFER (ZRCBERI, ZRCT, ZQCT, PTSTEP, &
+ XRTMIN_ELEC(2), XQTMIN(2), XCOEF_RQ_C, &
+ ZWQ, ZQCS, ZQIS)
+!
+ if ( lbudget_sv ) then
+ call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1 ), 'BERFI', &
+ Unpack( -zwq(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'BERFI', &
+ Unpack( zwq(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ end if
+!
+!
+!------------------------------------------------------------------
+!
+!* 9. COMPUTE THE CHARGE TRANSFER ASSOCIATED WITH THE CORRECTION TERM
+! ---------------------------------------------------------------
+!
+ IF (CCLOUD == 'LIMA') THEN
+!
+ if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg ), 'CORR2', &
+ Unpack( zqpis(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecend ), 'CORR2', &
+ Unpack( zqnis(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ end if
+!
+ ZWQ1(:) = 0.
+ WHERE (ZRCCORR2(:) .NE. 0. .AND. ZRCT(:) .GT. XRTMIN_ELEC(2))
+ ZWQ1(:) = XCOEF_RQ_C * ZQCT(:) * ZRCCORR2(:) / ZRCT(:)
+ ZWQ(:) = SIGN( MIN( ABS(ZQCT(:)/PTSTEP),ABS(ZWQ1(:)) ),ZQCS(:) )
+ !
+ ZQCS(:) = ZQCS(:) - ZWQ1(:)
+ ZQPIS(:) = ZQPIS(:) + MAX( 0.0,ZWQ1(:)/XECHARGE )
+ ZQNIS(:) = ZQNIS(:) - MIN( 0.0,ZWQ1(:)/XECHARGE )
+ END WHERE
+ !
+ !
+ ZWQ2(:) = 0.
+ WHERE (ZRRCORR2(:) .NE. 0. .AND. ZRRT(:) .GT. XRTMIN_ELEC(3))
+ ZWQ2(:) = XCOEF_RQ_R * ZQRT(:) * ZRRCORR2(:) / ZRRT(:)
+ ZWQ2(:) = SIGN( MIN( ABS(ZQRT(:)/PTSTEP),ABS(ZWQ2(:)) ),ZQRS(:) )
+ !
+ ZQRS(:) = ZQRS(:) - ZWQ2(:)
+ ZQPIS(:) = ZQPIS(:) + MAX( 0.0,ZWQ2(:)/XECHARGE )
+ ZQNIS(:) = ZQNIS(:) - MIN( 0.0,ZWQ2(:)/XECHARGE )
+ END WHERE
+ !
+ ZWQ3(:) = 0.
+ WHERE (ZRICORR2(:) .NE. 0. .AND. ZRIT(:) .GT. XRTMIN_ELEC(4))
+ ZWQ3(:) = XCOEF_RQ_I * ZQIT(:) * ZRICORR2(:) / ZRIT(:)
+ ZWQ3(:) = SIGN( MIN( ABS(ZQIT(:)/PTSTEP),ABS(ZWQ3(:)) ),ZQIS(:) )
+ !
+ ZQIS(:) = ZQIS(:) - ZWQ3(:)
+ ZQPIS(:) = ZQPIS(:) + MAX( 0.0,ZWQ3(:)/XECHARGE )
+ ZQNIS(:) = ZQNIS(:) - MIN( 0.0,ZWQ3(:)/XECHARGE )
+ END WHERE
+!
+ if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg ), 'CORR2', &
+ Unpack( zqpis(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecend ), 'CORR2', &
+ Unpack( zqnis(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1 ), 'CORR2', &
+ Unpack( zwq1(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2 ), 'CORR2', &
+ Unpack( zwq2(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'CORR2', &
+ Unpack( zwq3(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ end if
+ END IF
+!
+!
+!------------------------------------------------------------------
+!
+!* X. COMPUTE THE SEDIMENTATION SOURCE FOR Q_x
+! ----------------------------------------
+!
+! The sedimentation for electric charges is computed directly
+! in the microphysics scheme
+!
+!
+!------------------------------------------------------------------
+!
+!* 10. UPDATE VOLUMETRIC CHARGE CONCENTRATIONS
+! ---------------------------------------
+!
+ DO JL = 1, KMICRO
+ PQPIS(II1(JL),II2(JL),II3(JL)) = ZQPIS(JL)
+ PQNIS(II1(JL),II2(JL),II3(JL)) = ZQNIS(JL)
+ PQCS (II1(JL),II2(JL),II3(JL)) = ZQCS(JL)
+ PQRS (II1(JL),II2(JL),II3(JL)) = ZQRS(JL)
+ PQIS (II1(JL),II2(JL),II3(JL)) = ZQIS(JL)
+ PQSS (II1(JL),II2(JL),II3(JL)) = ZQSS(JL)
+ PQGS (II1(JL),II2(JL),II3(JL)) = ZQGS(JL)
+ END DO
+ IF ( KRR == 7 ) THEN
+ DO JL = 1, KMICRO
+ PQHS(II1(JL),II2(JL),II3(JL)) = ZQHS(JL)
+ END DO
+ END IF
+END IF ! end if kmicro>0
+!
+!
+!------------------------------------------------------------------
+!
+!* 11. DEALLOCATE
+! ----------
+!
+IF (ALLOCATED( ZDELTALWC )) DEALLOCATE( ZDELTALWC )
+IF (ALLOCATED( ZFT )) DEALLOCATE( ZFT )
+!
+IF (ALLOCATED( ZEW )) DEALLOCATE( ZEW )
+IF (ALLOCATED( ZSAUNSK )) DEALLOCATE( ZSAUNSK )
+IF (ALLOCATED( ZSAUNIM )) DEALLOCATE( ZSAUNIM )
+IF (ALLOCATED( ZSAUNIN )) DEALLOCATE( ZSAUNIN )
+IF (ALLOCATED( ZSAUNSM )) DEALLOCATE( ZSAUNSM )
+IF (ALLOCATED( ZSAUNSN )) DEALLOCATE( ZSAUNSN )
+IF (ALLOCATED( ZFQIAGGS )) DEALLOCATE( ZFQIAGGS )
+IF (ALLOCATED( ZFQIDRYGBS )) DEALLOCATE( ZFQIDRYGBS )
+IF (ALLOCATED( ZLBQSDRYGB1S )) DEALLOCATE( ZLBQSDRYGB1S )
+IF (ALLOCATED( ZLBQSDRYGB2S )) DEALLOCATE( ZLBQSDRYGB2S )
+IF (ALLOCATED( ZLBQSDRYGB3S )) DEALLOCATE( ZLBQSDRYGB3S )
+!
+IF (ALLOCATED( ZDQ )) DEALLOCATE( ZDQ )
+IF (ALLOCATED( ZRAR )) DEALLOCATE( ZRAR )
+IF (ALLOCATED( ZDQ_IS )) DEALLOCATE( ZDQ_IS )
+IF (ALLOCATED( ZSAUNIM_IS )) DEALLOCATE( ZSAUNIM_IS )
+IF (ALLOCATED( ZSAUNIN_IS )) DEALLOCATE( ZSAUNIN_IS )
+IF (ALLOCATED( ZDQ_IG )) DEALLOCATE( ZDQ_IG )
+IF (ALLOCATED( ZSAUNIM_IG )) DEALLOCATE( ZSAUNIM_IG )
+IF (ALLOCATED( ZSAUNIN_IG )) DEALLOCATE( ZSAUNIN_IG )
+IF (ALLOCATED( ZDQ_SG )) DEALLOCATE( ZDQ_SG )
+IF (ALLOCATED( ZSAUNSK_SG )) DEALLOCATE( ZSAUNSK_SG )
+IF (ALLOCATED( ZSAUNSM_SG )) DEALLOCATE( ZSAUNSM_SG )
+IF (ALLOCATED( ZSAUNSN_SG )) DEALLOCATE( ZSAUNSN_SG )
+!
+IF (ALLOCATED( ZEFIELDW )) DEALLOCATE( ZEFIELDW )
+!
+IF (ALLOCATED(ZRCMLTSR)) DEALLOCATE(ZRCMLTSR)
+IF (ALLOCATED(ZRICFRR)) DEALLOCATE(ZRICFRR)
+IF (ALLOCATED(ZRVHENC)) DEALLOCATE(ZRVHENC)
+IF (ALLOCATED(ZRCHINC)) DEALLOCATE(ZRCHINC)
+IF (ALLOCATED(ZRVHONH)) DEALLOCATE(ZRVHONH)
+IF (ALLOCATED(ZRRCVRC)) DEALLOCATE(ZRRCVRC)
+IF (ALLOCATED(ZRICNVI)) DEALLOCATE(ZRICNVI)
+IF (ALLOCATED(ZRVDEPI)) DEALLOCATE(ZRVDEPI)
+IF (ALLOCATED(ZRSHMSI)) DEALLOCATE(ZRSHMSI)
+IF (ALLOCATED(ZRGHMGI)) DEALLOCATE(ZRGHMGI)
+IF (ALLOCATED(ZRICIBU)) DEALLOCATE(ZRICIBU)
+IF (ALLOCATED(ZRIRDSF)) DEALLOCATE(ZRIRDSF)
+IF (ALLOCATED(ZRCCORR2)) DEALLOCATE(ZRCCORR2)
+IF (ALLOCATED(ZRRCORR2)) DEALLOCATE(ZRRCORR2)
+IF (ALLOCATED(ZRICORR2)) DEALLOCATE(ZRICORR2)
+IF (ALLOCATED(ZRWETGH)) DEALLOCATE(ZRWETGH)
+IF (ALLOCATED(ZRCWETH)) DEALLOCATE(ZRCWETH)
+IF (ALLOCATED(ZRIWETH)) DEALLOCATE(ZRIWETH)
+IF (ALLOCATED(ZRSWETH)) DEALLOCATE(ZRSWETH)
+IF (ALLOCATED(ZRGWETH)) DEALLOCATE(ZRGWETH)
+IF (ALLOCATED(ZRRWETH)) DEALLOCATE(ZRRWETH)
+IF (ALLOCATED(ZRCDRYH)) DEALLOCATE(ZRCDRYH)
+IF (ALLOCATED(ZRRDRYH)) DEALLOCATE(ZRRDRYH)
+IF (ALLOCATED(ZRIDRYH)) DEALLOCATE(ZRIDRYH)
+IF (ALLOCATED(ZRSDRYH)) DEALLOCATE(ZRSDRYH)
+IF (ALLOCATED(ZRGDRYH)) DEALLOCATE(ZRGDRYH)
+IF (ALLOCATED(ZRHMLTR)) DEALLOCATE(ZRHMLTR)
+IF (ALLOCATED(ZRDRYHG)) DEALLOCATE(ZRDRYHG)
+!
+!------------------------------------------------------------------
+!
+CONTAINS
+!
+! - routines to initialize the non-inductive charging
+! - routines to compute the non-inductive charging
+! - various useful routines
+!
+!------------------------------------------------------------------
+!
+! ##################################
+ SUBROUTINE ELEC_INIT_NOIND_GARDI()
+! ##################################
+!
+!
+! Purpose : initialization for the non-inductive charging process
+! following Gardiner et al. (1985)
+!
+!
+!* 0. DECLARATIONS
+! ------------
+!
+IMPLICIT NONE
+!
+!
+!* 1. COMPUTE f(DeltaT) AND (LWC - LWC_crit)
+! --------------------------------------
+!
+GELEC(:,:) = .FALSE.
+!
+ZDELTALWC(:) = 0.
+ZFT(:) = 0.
+!
+GELEC(:,3) = ZZT(:) > (XTT - 40.) .AND. ZZT(:) < XTT
+GELEC(:,1) = GELEC(:,3) .AND. &
+ ZRIT(:) > XRTMIN_ELEC(4) .AND. ZRST(:) > XRTMIN_ELEC(5) .AND. &
+ ZCIT(:) > 0.0 .AND. ZLBDAS(:) > 0. .AND. ZLBDAS(:) < XLBDAS_MAXE
+GELEC(:,2) = GELEC(:,3) .AND. &
+ ZRIT(:) > XRTMIN_ELEC(4) .AND. ZRGT(:) > XRTMIN_ELEC(6) .AND. &
+ ZCIT(:) > 0.0 .AND. ZLBDAG(:) > 0. .AND. ZLBDAG(:) < XLBDAG_MAXE
+GELEC(:,3) = GELEC(:,3) .AND. &
+ ZRST(:) > XRTMIN_ELEC(5) .AND. ZRGT(:) > XRTMIN_ELEC(6) .AND. &
+ ZLBDAS(:) > 0. .AND. ZLBDAS(:) < XLBDAS_MAXE .AND. &
+ ZLBDAG(:) > 0. .AND. ZLBDAG(:) < XLBDAG_MAXE
+GELEC(:,4) = GELEC(:,1) .OR. GELEC(:,2) .OR. GELEC(:,3)
+!
+WHERE (GELEC(:,4))
+ ! f(DeltaT)
+ ZFT(:) = - 1.7E-5 * ((-21 / (XQTC - XTT)) * (ZZT(:) - XTT))**3 &
+ - 0.003 * ((-21 / (XQTC - XTT)) * (ZZT(:) - XTT))**2 &
+ - 0.05 * ((-21 / (XQTC - XTT)) * (ZZT(:) - XTT)) &
+ + 0.13
+ !
+ ! LWC - LWC_crit
+ ZDELTALWC(:) = (ZRCT(:) * ZRHODREF(:) * 1.E3) - XLWCC ! (g m^-3)
+ENDWHERE
+!
+END SUBROUTINE ELEC_INIT_NOIND_GARDI
+!
+!-----------------------------------------------------------------
+!
+! ################################
+ SUBROUTINE ELEC_INIT_NOIND_EWC()
+! ################################
+!
+!
+! Purpose : initialization for the non-inductive charging process
+! following Saunders et al. (1991)
+!
+!
+!* 0. DECLARATIONS
+! ------------
+!
+IMPLICIT NONE
+!
+!
+!* 1. PARAMETERS FOR POSITIVE NI CHARGING
+! -----------------------------------
+!
+GELEC(:,:) = .FALSE.
+ZDQ(:) = 0.
+ZEW(:) = 0.
+!
+! positive case is the default value
+IF (CNI_CHARGING == 'SAUN1' .OR. CNI_CHARGING == 'SAUN2') THEN
+ ZFQIAGGS(:) = XFQIAGGSP
+ ZFQIDRYGBS(:) = XFQIDRYGBSP
+ELSE IF (CNI_CHARGING == 'TEEWC') THEN
+ ZFQIAGGS(:) = XFQIAGGSP_TAK
+ ZFQIDRYGBS(:) = XFQIDRYGBSP_TAK
+END IF
+ZLBQSDRYGB1S(:) = XLBQSDRYGB1SP
+ZLBQSDRYGB2S(:) = XLBQSDRYGB2SP
+ZLBQSDRYGB3S(:) = XLBQSDRYGB3SP
+ZSAUNIM(:) = XIMP !3.76
+ZSAUNIN(:) = XINP !2.5
+ZSAUNSK(:) = XSKP !52.8
+ZSAUNSM(:) = XSMP !0.44
+ZSAUNSN(:) = XSNP !2.5
+!
+!
+!* 2. PARAMETERS FOR NEGATIVE NI CHARGING
+! -----------------------------------
+!
+! Mansell et al. (2005, JGR): droplet collection efficiency of the graupel ~ 0.6-1.0
+WHERE (ZLBDAG(:) > 0. .AND. ZRCT(:) > 0.)
+ ZEW(:) = 0.8 * ZRCT(:) * ZRHODREF(:) * 1.E3 ! (g m^-3)
+END WHERE
+!
+GELEC(:,3) = ZZT(:) > (XTT - 40.) .AND. ZZT(:) <= XTT .AND. &
+ ZEW(:) >= 0.01 .AND. ZEW(:) <= 10.
+GELEC(:,1) = GELEC(:,3) .AND. &
+ ZRIT(:) > XRTMIN_ELEC(4) .AND. ZRST(:) > XRTMIN_ELEC(5) .AND. &
+ ZCIT(:) > 0.0 .AND. ZLBDAS(:) > 0. .AND. ZLBDAS(:) < XLBDAS_MAXE
+GELEC(:,2) = GELEC(:,3) .AND. &
+ ZRIT(:) > XRTMIN_ELEC(4) .AND. ZRGT(:) > XRTMIN_ELEC(6) .AND. &
+ ZCIT(:) > 0.0 .AND. ZLBDAG(:) > 0. .AND. ZLBDAG(:) < XLBDAG_MAXE
+GELEC(:,3) = GELEC(:,3) .AND. &
+ ZRST(:) > XRTMIN_ELEC(5) .AND. ZRGT(:) > XRTMIN_ELEC(6) .AND. &
+ ZLBDAS(:) > 0. .AND. ZLBDAS(:) < XLBDAS_MAXE .AND. &
+ ZLBDAG(:) > 0. .AND. ZLBDAG(:) < XLBDAG_MAXE
+!
+GELEC(:,4) = GELEC(:,1) .OR. GELEC(:,2) .OR. GELEC(:,3)
+!
+IF (COUNT(GELEC(:,4)) > 0) THEN
+ IF (CNI_CHARGING == 'SAUN1' .OR. CNI_CHARGING == 'SAUN2') THEN
+ CALL INTERP_DQ_TABLE (KMICRO, NIND_TEMP, NIND_LWC, GELEC(:,4), &
+ ZEW, ZZT, XSAUNDER, ZDQ)
+ !
+ WHERE (ZDQ(:) < 0.)
+ ZFQIAGGS(:) = XFQIAGGSN
+ ZFQIDRYGBS(:) = XFQIDRYGBSN
+ END WHERE
+ ELSE IF (CNI_CHARGING == 'TEEWC') THEN
+ CALL INTERP_DQ_TABLE (KMICRO, NIND_TEMP, NIND_LWC, GELEC(:,4), &
+ ZEW, ZZT, XTAKA_TM, ZDQ)
+ !
+ WHERE (ZDQ(:) < 0.)
+ ZFQIAGGS(:) = XFQIAGGSN_TAK
+ ZFQIDRYGBS(:) = XFQIDRYGBSN_TAK
+ END WHERE
+ END IF
+!
+! value of the parameters for the negative case
+ WHERE (ZDQ(:) < 0.)
+ ZLBQSDRYGB1S(:) = XLBQSDRYGB1SN
+ ZLBQSDRYGB2S(:) = XLBQSDRYGB2SN
+ ZLBQSDRYGB3S(:) = XLBQSDRYGB3SN
+ ZSAUNIM(:) = XIMN !2.54
+ ZSAUNIN(:) = XINN !2.8
+ ZSAUNSK(:) = XSKN !24.
+ ZSAUNSM(:) = XSMN !0.5
+ ZSAUNSN(:) = XSNN !2.8
+ ENDWHERE
+ENDIF
+!
+END SUBROUTINE ELEC_INIT_NOIND_EWC
+!
+!------------------------------------------------------------------
+!
+! ################################
+ SUBROUTINE ELEC_INIT_NOIND_RAR()
+! ################################
+!
+!
+! Purpose : initialization for the non-inductive charging process
+! following Saunders and Peck (1998)
+!
+!
+!* 0. DECLARATIONS
+! ------------
+!
+IMPLICIT NONE
+!
+! local variables
+REAL, DIMENSION(KMICRO) :: ZRAR_CRIT ! critical rime accretion rate
+REAL, DIMENSION(KMICRO) :: ZVGMEAN, & ! mean velocity of graupel
+ ZVSMEAN ! mean velocity of snow
+!
+!
+!* 1. COMPUTE THE CRITICAL RIME ACCRETION RATE
+! ----------------------------------------
+!
+ZRAR_CRIT(:) = 0.
+!
+IF (CNI_CHARGING == 'SAP98') THEN
+!
+ WHERE (ZZT(:) <= XTT .AND. ZZT(:) >= (XTT - 23.7)) ! Original from SAP98
+ ZRAR_CRIT(:) = 1.0 + 7.93E-2 * (ZZT(:) - XTT) + &
+ 4.48E-2 * (ZZT(:) - XTT)**2 + &
+ 7.48E-3 * (ZZT(:) - XTT)**3 + &
+ 5.47E-4 * (ZZT(:) - XTT)**4 + &
+ 1.67E-5 * (ZZT(:) - XTT)**5 + &
+ 1.76E-7 * (ZZT(:) - XTT)**6
+ END WHERE
+ !
+ WHERE (ZZT(:) < (XTT - 23.7) .AND. ZZT(:) > (XTT - 40.)) ! Added by Mansell
+ ZRAR_CRIT(:) = 3.4 * (1.0 - (ABS(ZZT(:) - XTT + 23.7) / & ! et al. (2005)
+ (-23.7 + 40.))**3.)
+ END WHERE
+ !
+ GELEC(:,3) = ZZT(:) >= (XTT - 40.) .AND. ZZT(:) <= XTT
+!
+ELSE IF (CNI_CHARGING == 'BSMP1' .OR. CNI_CHARGING == 'BSMP2') THEN
+!
+ WHERE (ZZT(:) > (XTT - 10.7))
+ ZRAR_CRIT(:) = 0.66
+ END WHERE
+ WHERE (ZZT(:) <= (XTT - 10.7) .AND. ZZT(:) >= (XTT - 23.7))
+ ZRAR_CRIT(:) = -1.47 - 0.2 * (ZZT(:) - XTT)
+ END WHERE
+ WHERE (ZZT(:) < (XTT - 23.7) .AND. ZZT(:) > (XTT - 40.))
+ ZRAR_CRIT(:) = 3.3
+ END WHERE
+ !
+ GELEC(:,3) = ZZT(:) > (XTT - 40.) .AND. ZZT(:) <= XTT .AND. &
+ ZEW(:) >= 0.01 .AND. ZEW(:) <= 10.
+!
+ELSE IF (CNI_CHARGING == 'TERAR') THEN
+!
+ GELEC(:,3) = ZZT(:) >= (XTT - 40.) .AND. ZZT(:) <= XTT
+END IF
+!
+GELEC(:,1) = GELEC(:,3) .AND. &
+ ZRIT(:) > XRTMIN_ELEC(4) .AND. ZRST(:) > XRTMIN_ELEC(5) .AND. &
+ ZCIT(:) > 0.0 .AND. ZLBDAS(:) > 0. .AND. ZLBDAS(:) < XLBDAS_MAXE
+GELEC(:,2) = GELEC(:,3) .AND. &
+ ZRIT(:) > XRTMIN_ELEC(4) .AND. ZRGT(:) > XRTMIN_ELEC(6) .AND. &
+ ZCIT(:) > 0.0 .AND. ZLBDAG(:) > 0. .AND. ZLBDAG(:) < XLBDAG_MAXE
+GELEC(:,3) = GELEC(:,3) .AND. &
+ ZRST(:) > XRTMIN_ELEC(5) .AND. ZRGT(:) > XRTMIN_ELEC(6) .AND. &
+ ZLBDAS(:) > 0. .AND. ZLBDAS(:) < XLBDAS_MAXE .AND. &
+ ZLBDAG(:) > 0. .AND. ZLBDAG(:) < XLBDAG_MAXE
+!
+!
+!* 2. INITIALIZATION FOR ICE CRYSTAL - GRAUPEL COLLISIONS
+! ---------------------------------------------------
+!
+ZDQ_IG(:) = 0.
+!
+! positive case is the default value
+ZSAUNIM_IG(:) = XIMP
+ZSAUNIN_IG(:) = XINP
+!
+! Compute the Rime Accretion Rate
+ZRAR(:) = 0.
+ZVGMEAN(:) = 0.
+WHERE (ZLBDAG(:) > 0. .AND. ZRCT(:) > 0.)
+ ZVGMEAN(:) = XVGCOEF * ZRHOCOR(:) * ZLBDAG(:)**(-ZDG)
+ ZRAR(:) = 0.8 * ZRHODREF(:) * ZRCT(:) * ZVGMEAN(:) * 1.E3
+END WHERE
+!
+IF (CNI_CHARGING == 'TERAR') THEN
+ GELEC(:,2) = GELEC(:,2) .AND. ZRAR(:) > 0.01 .AND. ZRAR(:) <= 80.
+ELSE
+ GELEC(:,2) = GELEC(:,2) .AND. ZRAR(:) > 0.1
+END IF
+GELEC(:,4) = GELEC(:,2)
+!
+IF (COUNT(GELEC(:,4)) .GT. 0) THEN
+! compute the coefficients for I-G collisions
+ IF (CNI_CHARGING == 'SAP98') THEN
+ CALL ELEC_INI_NI_SAP98 (KMICRO, GELEC(:,4), ZRAR, ZRAR_CRIT, ZDQ_IG)
+ !
+ ELSE IF (CNI_CHARGING == 'BSMP1' .OR. CNI_CHARGING == 'BSMP2') THEN
+ ZRAR(:) = ZRAR(:) / 3
+ CALL INTERP_DQ_TABLE (KMICRO, NIND_TEMP, NIND_LWC, GELEC(:,4), &
+ ZRAR, ZZT, XSAUNDER, ZDQ_IG)
+ !
+ ELSE IF (CNI_CHARGING == 'TERAR') THEN
+ ZRAR(:) = ZRAR(:) / 8.
+ CALL INTERP_DQ_TABLE (KMICRO, NIND_TEMP, NIND_LWC, GELEC(:,4), &
+ ZRAR, ZZT, XTAKA_TM, ZDQ_IG)
+ !
+ END IF
+ !
+ WHERE (ZDQ_IG(:) < 0.)
+ ZSAUNIM_IG(:) = XIMN
+ ZSAUNIN_IG(:) = XINN
+ ENDWHERE
+ENDIF
+!
+!
+!* 3. INITIALIZATION FOR ICE CRYSTAL - SNOW COLLISIONS
+! ------------------------------------------------
+!
+ZDQ_IS(:) = 0.
+!
+! positive case is the default value
+ZSAUNIM_IS(:) = XIMP
+ZSAUNIN_IS(:) = XINP
+!
+! Compute the Rime Accretion Rate
+ZRAR(:) = 0.
+ZVSMEAN(:) = 0.
+WHERE (ZLBDAS(:) > 0. .AND. ZRCT(:) > 0.)
+ ZVSMEAN(:) = XVSCOEF * ZRHOCOR(:) * ZLBDAS(:)**(-ZDS)
+ ZRAR(:) = 0.8 * ZRHODREF(:) * ZRCT(:) * ZVSMEAN(:) * 1.E3
+END WHERE
+!
+IF (CNI_CHARGING == 'TERAR') THEN
+ GELEC(:,1) = GELEC(:,1) .AND. ZRAR(:) > 0.01 .AND. ZRAR(:) <= 80.
+ELSE
+ GELEC(:,1) = GELEC(:,1) .AND. ZRAR(:) > 0.1
+END IF
+GELEC(:,4) = GELEC(:,1)
+!
+IF (COUNT(GELEC(:,4)) .GT. 0) THEN
+! compute the coefficients for I-S collisions
+ IF (CNI_CHARGING == 'SAP98') THEN
+ CALL ELEC_INI_NI_SAP98 (KMICRO, GELEC(:,4), ZRAR, ZRAR_CRIT, ZDQ_IS)
+ !
+ ELSE IF (CNI_CHARGING == 'BSMP1' .OR. CNI_CHARGING == 'BSMP2') THEN
+ ZRAR(:) = ZRAR(:) / 3
+ CALL INTERP_DQ_TABLE (KMICRO, NIND_TEMP, NIND_LWC, GELEC(:,4), &
+ ZRAR, ZZT, XSAUNDER, ZDQ_IS)
+ !
+ ELSE IF (CNI_CHARGING == 'TERAR') THEN
+ ZRAR(:) = ZRAR(:) / 8.
+ CALL INTERP_DQ_TABLE (KMICRO, NIND_TEMP, NIND_LWC, GELEC(:,4), &
+ ZRAR, ZZT, XTAKA_TM, ZDQ_IS)
+ !
+ END IF
+ !
+ WHERE (ZDQ_IS(:) < 0.)
+ ZSAUNIM_IS(:) = XIMN
+ ZSAUNIN_IS(:) = XINN
+ ENDWHERE
+ENDIF
+!
+!
+!* 4. INITIALIZATION FOR GRAUPEL - SNOW COLLISIONS
+! --------------------------------------------
+!
+ZDQ_SG(:) = 0.
+!
+! positive case is the default value
+ZSAUNSK_SG(:) = XSKP
+ZSAUNSM_SG(:) = XSMP
+ZSAUNSN_SG(:) = XSNP
+!
+! Compute the Rime Accretion Rate
+ZRAR(:) = 0.
+WHERE (ZVSMEAN(:) > 0. .AND. ZVGMEAN(:) > 0.)
+ ZRAR(:) = 0.8 * ZRHODREF(:) * ZRCT(:) * ABS(ZVGMEAN(:) - ZVSMEAN(:)) * 1.E3
+END WHERE
+!
+IF (CNI_CHARGING == 'TERAR') THEN
+ GELEC(:,3) = GELEC(:,3) .AND. ZRAR(:) > 0.01 .AND. ZRAR(:) <= 80.
+ELSE
+ GELEC(:,3) = GELEC(:,3) .AND. ZRAR(:) > 0.1
+END IF
+GELEC(:,4) = GELEC(:,3)
+!
+IF( COUNT(GELEC(:,4)) .GT. 0) THEN
+! compute the coefficients for S-G collisions
+ IF (CNI_CHARGING == 'SAP98') THEN
+ CALL ELEC_INI_NI_SAP98 (KMICRO, GELEC(:,4), ZRAR, ZRAR_CRIT, ZDQ_SG)
+ !
+ ELSE IF (CNI_CHARGING == 'BSMP1' .OR. CNI_CHARGING == 'BSMP2') THEN
+ ZRAR(:) = ZRAR(:) / 3
+ CALL INTERP_DQ_TABLE (KMICRO, NIND_TEMP, NIND_LWC, GELEC(:,4), &
+ ZRAR, ZZT, XSAUNDER, ZDQ_SG)
+ !
+ ELSE IF (CNI_CHARGING == 'TERAR') THEN
+ ZRAR(:) = ZRAR(:) / 8.
+ CALL INTERP_DQ_TABLE (KMICRO, NIND_TEMP, NIND_LWC, GELEC(:,4), &
+ ZRAR, ZZT, XTAKA_TM, ZDQ_SG)
+ !
+ END IF
+ !
+ WHERE (ZDQ_SG(:) < 0.)
+ ZSAUNSK_SG(:) = XSKN
+ ZSAUNSM_SG(:) = XSMN
+ ZSAUNSN_SG(:) = XSNN
+ ENDWHERE
+ENDIF
+!
+END SUBROUTINE ELEC_INIT_NOIND_RAR
+!
+!------------------------------------------------------------------
+!
+! ##################################
+ SUBROUTINE ELEC_INIT_NOIND_TAKAH()
+! ##################################
+!
+! Purpose : initialization for the non-inductive charging process
+! following Takahashi (1978)
+!
+!
+!* 0. DECLARATIONS
+! ------------
+!
+IMPLICIT NONE
+!
+!
+!* 1. COMPUTE f(T, LWC)
+! -----------------
+!
+ZDQ(:) = 0.
+!
+ZEW(:) = ZRCT(:) * ZRHODREF(:) * 1.E3 ! (g m^-3)
+!
+GELEC(:,3) = ZZT(:) > (XTT - 40.) .AND. ZZT(:) <= XTT .AND. &
+ ZEW(:) >= 0.01 .AND. ZEW(:) <= 10.
+GELEC(:,1) = GELEC(:,3) .AND. &
+ ZRIT(:) > XRTMIN_ELEC(4) .AND. ZRST(:) > XRTMIN_ELEC(5) .AND. &
+ ZCIT(:) > 0.0 .AND. ZLBDAS(:) > 0. .AND. ZLBDAS(:) < XLBDAS_MAXE
+GELEC(:,2) = GELEC(:,3) .AND. &
+ ZRIT(:) > XRTMIN_ELEC(4) .AND. ZRGT(:) > XRTMIN_ELEC(6) .AND. &
+ ZCIT(:) > 0.0 .AND. ZLBDAG(:) > 0. .AND. ZLBDAG(:) < XLBDAG_MAXE
+GELEC(:,3) = GELEC(:,3) .AND. &
+ ZRST(:) > XRTMIN_ELEC(5) .AND. ZRGT(:) > XRTMIN_ELEC(6) .AND. &
+ ZLBDAS(:) > 0. .AND. ZLBDAS(:) < XLBDAS_MAXE .AND. &
+ ZLBDAG(:) > 0. .AND. ZLBDAG(:) < XLBDAG_MAXE
+GELEC(:,4) = GELEC(:,1) .OR. GELEC(:,2) .OR. GELEC(:,3)
+!
+IF (COUNT(GELEC(:,4)) > 0) THEN
+ CALL INTERP_DQ_TABLE (KMICRO, NIND_TEMP, NIND_LWC, GELEC(:,4), &
+ ZEW, ZZT, XMANSELL, ZDQ)
+ENDIF
+!
+END SUBROUTINE ELEC_INIT_NOIND_TAKAH
+!
+!------------------------------------------------------------------
+!
+! ##################################
+ SUBROUTINE ELEC_INIT_NOIND_TEEWC()
+! ##################################
+!
+!
+! Purpose : initialization for the non-inductive charging process
+! following Tsenova and Mitzeva (2009)
+!
+!
+!* 0. DECLARATIONS
+! ------------
+!
+IMPLICIT NONE
+!
+!
+!* 1. PARAMETERS FOR POSITIVE NI CHARGING
+! -----------------------------------
+!
+GELEC(:,:) = .FALSE.
+ZDQ(:) = 0.
+!
+! positive case is the default value
+ZFQIAGGS(:) = XFQIAGGSP_TAK
+ZFQIDRYGBS(:) = XFQIDRYGBSP_TAK
+ZLBQSDRYGB1S(:) = XLBQSDRYGB1SP
+ZLBQSDRYGB2S(:) = XLBQSDRYGB2SP
+ZLBQSDRYGB3S(:) = XLBQSDRYGB3SP
+ZSAUNIM(:) = XIMP !3.76
+ZSAUNIN(:) = XINP !2.5
+ZSAUNSK(:) = XSKP_TAK !6.5
+ZSAUNSM(:) = XSMP !0.44
+ZSAUNSN(:) = XSNP !2.5
+!
+!
+!* 2. PARAMETERS FOR NEGATIVE NI CHARGING
+! -----------------------------------
+!
+! Compute the effective water content
+ZEW(:) = 0.
+!
+WHERE (ZLBDAG(:) > 0. .AND. ZRCT(:) > 0.)
+ ZEW(:) = 0.8 * ZRHODREF(:) * ZRCT(:) * 1.E3
+END WHERE
+!
+GELEC(:,3) = ZZT(:) >= (XTT - 40.) .AND. ZZT(:) <= XTT .AND. &
+ ZEW(:) >= 0.01 .AND. ZEW(:) <= 10.
+GELEC(:,1) = GELEC(:,3) .AND. &
+ ZRIT(:) > XRTMIN_ELEC(4) .AND. ZRST(:) > XRTMIN_ELEC(5) .AND. &
+ ZCIT(:) > 0.0 .AND. ZLBDAS(:) > 0. .AND. ZLBDAS(:) < XLBDAS_MAXE
+GELEC(:,2) = GELEC(:,3) .AND. &
+ ZRIT(:) > XRTMIN_ELEC(4) .AND. ZRGT(:) > XRTMIN_ELEC(6) .AND. &
+ ZCIT(:) > 0.0 .AND. ZLBDAG(:) > 0. .AND. ZLBDAG(:) < XLBDAG_MAXE
+GELEC(:,3) = GELEC(:,3) .AND. &
+ ZRST(:) > XRTMIN_ELEC(5) .AND. ZRGT(:) > XRTMIN_ELEC(6) .AND. &
+ ZLBDAS(:) > 0. .AND. ZLBDAS(:) < XLBDAS_MAXE .AND. &
+ ZLBDAG(:) > 0. .AND. ZLBDAG(:) < XLBDAG_MAXE
+!
+GELEC(:,4) = GELEC(:,1) .OR. GELEC(:,2) .OR. GELEC(:,3)
+!
+IF (COUNT(GELEC(:,4)) > 0) THEN
+ CALL INTERP_DQ_TABLE (KMICRO, NIND_TEMP, NIND_LWC, GELEC(:,4), &
+ ZEW, ZZT, XTAKA_TM, ZDQ)
+!
+ WHERE (ZDQ(:) < 0.)
+ ZFQIAGGS(:) = XFQIAGGSN_TAK
+ ZFQIDRYGBS(:) = XFQIDRYGBSN_TAK
+ ZLBQSDRYGB1S(:) = XLBQSDRYGB1SN
+ ZLBQSDRYGB2S(:) = XLBQSDRYGB2SN
+ ZLBQSDRYGB3S(:) = XLBQSDRYGB3SN
+ ZSAUNIM(:) = XIMN !2.54
+ ZSAUNIN(:) = XINN !2.8
+ ZSAUNSK(:) = XSKN_TAK !2.0
+ ZSAUNSM(:) = XSMN !0.5
+ ZSAUNSN(:) = XSNN !2.8
+ ENDWHERE
+ENDIF
+!
+END SUBROUTINE ELEC_INIT_NOIND_TEEWC
+!
+!------------------------------------------------------------------
+!
+! #################################################################
+ SUBROUTINE ELEC_INI_NI_SAP98(KMICRO, OMASK, PRAR, PRAR_CRIT, PDQ)
+! #################################################################
+!
+!
+! Purpose : compute dQ(RAR,T) in the parameterization of Saunders and Peck (1998)
+!
+!
+!* 0. DECLARATIONS
+! ------------
+!
+IMPLICIT NONE
+!
+INTEGER, INTENT(IN) :: KMICRO
+LOGICAL, DIMENSION(KMICRO), INTENT(IN) :: OMASK
+REAL, DIMENSION(KMICRO), INTENT(IN) :: PRAR ! Rime accretion rate
+REAL, DIMENSION(KMICRO), INTENT(IN) :: PRAR_CRIT ! Critical rime accretion rate
+REAL, DIMENSION(KMICRO), INTENT(INOUT) :: PDQ ! interpolated dQ
+!
+!
+!* 1. COMPUTE dQ(RAR, T)
+! ------------------
+!
+PDQ(:) = 0.
+!
+! positive region : Mansell et al., 2005
+WHERE (OMASK(:) .AND. PRAR(:) > PRAR_CRIT(:))
+ PDQ(:) = MAX(0., 6.74 * (PRAR(:) - PRAR_CRIT(:)) * 1.E-15)
+ENDWHERE
+!
+! negative region : Mansell et al. 2005
+WHERE (OMASK(:) .AND. PRAR(:) < PRAR_CRIT(:))
+ PDQ(:) = MIN(0., 3.9 * (PRAR_CRIT(:) - 0.1) * &
+ (4.0 * ((PRAR(:) - (PRAR_CRIT(:) + 0.1) / 2.) / &
+ (PRAR_CRIT(:) - 0.1))**2 - 1.) * 1.E-15)
+ENDWHERE
+!
+END SUBROUTINE ELEC_INI_NI_SAP98
+!
+!------------------------------------------------------------------
+!
+! #################################################################
+ SUBROUTINE INTERP_DQ_TABLE (KMICRO, KIND_TEMP, KIND_LWC, OMASK, &
+ PLIQ, PTEMP, PTABLE, PDQ)
+! #################################################################
+!
+!
+! Purpose : interpolate dQ from a lookup table at each gridpoint
+!
+!
+!* 0. DECLARATIONS
+! ------------
+!
+IMPLICIT NONE
+!
+INTEGER, INTENT(IN) :: KMICRO
+INTEGER, INTENT(IN) :: KIND_TEMP, KIND_LWC
+LOGICAL, DIMENSION(KMICRO), INTENT(IN) :: OMASK
+REAL, DIMENSION(KMICRO), INTENT(IN) :: PLIQ ! effective water content or rime accretion rate
+REAL, DIMENSION(KMICRO), INTENT(IN) :: PTEMP ! temperature
+REAL, DIMENSION(KIND_LWC+1,KIND_TEMP+1), INTENT(IN) :: PTABLE ! lookup table
+REAL, DIMENSION(KMICRO), INTENT(INOUT) :: PDQ ! interpolated dQ
+!
+! declaration of local variables
+INTEGER :: IGAUX
+REAL, DIMENSION(:), ALLOCATABLE :: ZDQ_INTERP
+REAL, DIMENSION(:), ALLOCATABLE :: ZVECT1, ZVECT2
+INTEGER, DIMENSION(:), ALLOCATABLE :: IVECT1, IVECT2
+!
+!
+!* 1. FIND THE INDEXES FOR RAR/EW AND T
+! ---------------------------------
+!
+PDQ(:) = 0.
+!
+IGAUX = 0
+DO II = 1, KMICRO
+ IF (OMASK(II)) THEN
+ IGAUX = IGAUX + 1
+ I1(IGAUX) = II
+ END IF
+END DO
+!
+IF (IGAUX > 0) THEN
+ ALLOCATE(ZDQ_INTERP(IGAUX))
+ ALLOCATE(ZVECT1(IGAUX))
+ ALLOCATE(ZVECT2(IGAUX))
+ ALLOCATE(IVECT1(IGAUX))
+ ALLOCATE(IVECT2(IGAUX))
+ ZDQ_INTERP(:) = 0.
+ IVECT1(:) = 0
+ IVECT2(:) = 0
+!
+ DO II = 1, IGAUX
+ ZVECT1(II) = PTEMP(I1(II))
+ ZVECT2(II) = PLIQ(I1(II))
+ ZDQ_INTERP(II) = PDQ(I1(II))
+ END DO
+!
+! Temperature index (0C --> -40C)
+ ZVECT1(1:IGAUX) = MAX( 1.00001, MIN( REAL(KIND_TEMP)-0.00001, &
+ (ZVECT1(1:IGAUX) - XTT - 1.)/(-1.) ) )
+ IVECT1(1:IGAUX) = INT( ZVECT1(1:IGAUX) )
+ ZVECT1(1:IGAUX) = ZVECT1(1:IGAUX) - REAL(IVECT1(1:IGAUX))
+!
+! LWC index (0.01 g.m^-3 --> 10 g.m^-3)
+ WHERE (ZVECT2(:) >= 0.01 .AND. ZVECT2(:) < 0.1)
+ ZVECT2(:) = MAX( 1.00001, MIN( REAL(10)-0.00001, &
+ ZVECT2(:) * 100. ))
+ IVECT2(:) = INT(ZVECT2(:))
+ ZVECT2(:) = ZVECT2(:) - REAL(IVECT2(:))
+ ENDWHERE
+!
+ WHERE (ZVECT2(:) >= 0.1 .AND. ZVECT2(:) < 1. .AND. IVECT2(:) == 0)
+ ZVECT2(:) = MAX( 10.00001, MIN( REAL(19)-0.00001, &
+ ZVECT2(:) * 10. + 9. ) )
+ IVECT2(:) = INT(ZVECT2(:))
+ ZVECT2(:) = ZVECT2(:) - REAL(IVECT2(:))
+ ENDWHERE
+!
+ WHERE ((ZVECT2(:) >= 1.) .AND. ZVECT2(:) <= 10.)
+ ZVECT2(:) = MAX( 19.00001, MIN( REAL(KIND_LWC)-0.00001, &
+ ZVECT2(:) + 18. ) )
+ IVECT2(:) = INT(ZVECT2(:))
+ ZVECT2(:) = ZVECT2(:) - REAL(IVECT2(:))
+ ENDWHERE
+!
+!
+!* 2. INTERPOLATE dQ(RAR or EW,T)
+! ---------------------------
+!
+ ZDQ_INTERP(:) = BI_LIN_INTP_V( PTABLE, IVECT2, IVECT1, ZVECT2, ZVECT1, &
+ IGAUX )
+!
+ DO II = 1, IGAUX
+ PDQ(I1(II)) = ZDQ_INTERP(II)
+ END DO
+END IF
+!
+DEALLOCATE(ZDQ_INTERP)
+DEALLOCATE(ZVECT1)
+DEALLOCATE(ZVECT2)
+DEALLOCATE(IVECT1)
+DEALLOCATE(IVECT2)
+!
+END SUBROUTINE INTERP_DQ_TABLE
+!
+!------------------------------------------------------------------
+!
+! #########################
+ SUBROUTINE ELEC_IAGGS_B()
+! #########################
+!
+!
+! Purpose : compute charge separation process during the collision
+! between ice and snow
+!
+!
+!* 0. DECLARATIONS
+! ------------
+!
+IMPLICIT NONE
+!
+!
+!* 1. COMPUTE THE COLLISION EFFICIENCY
+! --------------------------------
+!
+ZQCOLIS(:) = ZCOLIS * EXP(ZCOLEXIS * (ZZT(:) - XTT))
+!
+ZWQ_NI(:) = 0.
+ZLIMIT(:) = 0.
+!
+!* 2. COMPUTE THE RATE OF SEPARATED CHARGE
+! ------------------------------------
+!
+!* 2.1 Charging process following Helsdon and Farley (1987)
+!
+IF (CNI_CHARGING == 'HELFA') THEN
+ !
+ WHERE (ZCIT(:) > 0.0 .AND. &
+ ZRIT(:) > XRTMIN_ELEC(4) .AND. ZRST(:) > XRTMIN_ELEC(5))
+ ZWQ_NI(:) = XFQIAGGSBH * ZRIAGGS(:) * ZCIT(:) / ZRIT(:)
+ ZWQ_NI(:) = ZWQ_NI(:) * (1. - ZQCOLIS(:)) / ZQCOLIS(:)
+!
+! Temperature dependance of the charge transferred
+ ZWQ_NI(:) = ZWQ_NI(:) * (ZZT(:) - XQTC) / ABS(ZZT(:) - XQTC)
+ ZWQ_NI(:) = ZWQ_NI(:) / ZRHODREF(:)
+ END WHERE
+!
+ELSE
+!
+!
+!* 2.2 Charging process following Gardiner et al. (1985)
+!
+ IF (CNI_CHARGING == 'GARDI') THEN
+ WHERE (GELEC(:,1) .AND. ZDELTALWC(:) > 0.)
+ ZWQ_NI(:) = XFQIAGGSBG * (1 - ZQCOLIS(:)) * &
+ ZRHODREF(:)**(-4. * ZCEXVT + 4. / ZBI) * &
+ ZCIT(:)**(1 - 4. / ZBI) * &
+ ZDELTALWC(:) * ZFT(:) * &
+ ZCST(:) * ZLBDAS(:)**(-2. - 4. * ZDS) * &
+ (ZAI * MOMG(ZALPHAI, ZNUI, ZBI) / &
+ ZRIT(:))**(-4 / ZBI)
+ ENDWHERE
+ END IF
+!
+!
+!* 2.3 Charging process based on EW: SAUN1/SAUN2, TEEWC
+!* following Saunders et al. (1991), Takahashi via Tsenova and Mitzeva (2009)
+!
+ IF (CNI_CHARGING == 'SAUN1' .OR. CNI_CHARGING == 'SAUN2' .OR. &
+ CNI_CHARGING == 'TEEWC') THEN
+ WHERE (GELEC(:,1) .AND. ZDQ(:) /= 0.)
+ ZWQ_NI(:) = XFQIAGGSBS * (1 - ZQCOLIS(:)) * &
+ ZRHOCOR(:)**(1 + ZSAUNIN(:)) * &
+ ZFQIAGGS(:) * ZDQ(:) * &
+ ZCIT(:)**(1 - ZSAUNIM(:) / ZBI) * &
+ ZCST(:) * ZLBDAS(:)**(-2.- ZDS * (1. + ZSAUNIN(:))) * &
+ (ZRHODREF(:) * ZRIT(:) / XAIGAMMABI)**(ZSAUNIM(:) / ZBI)
+ ENDWHERE
+ END IF
+!
+!
+!* 2.4 Charging process based on RAR (=EW*V): SAP98, BSMP1/BSMP2, TERAR
+!* following Saunders and Peck (1998) or Brooks et al., 1997 (with/out anomalies)
+!* or Takahashi via Tsenova and Mitzeva (2011)
+!
+ IF (CNI_CHARGING == 'SAP98' .OR. CNI_CHARGING == 'BSMP1' .OR. &
+ CNI_CHARGING == 'BSMP2' .OR. CNI_CHARGING == 'TERAR') THEN
+ IF (CNI_CHARGING /= 'TERAR') THEN
+ ZFQIAGGS(:) = XFQIAGGSP
+ WHERE (ZDQ_IS(:) < 0.)
+ ZFQIAGGS(:) = XFQIAGGSN
+ ENDWHERE
+ ELSE
+ ZFQIAGGS(:) = XFQIAGGSP_TAK
+ WHERE (ZDQ_IS(:) < 0.)
+ ZFQIAGGS(:) = XFQIAGGSN_TAK
+ ENDWHERE
+ ENDIF
+!
+ WHERE (GELEC(:,1) .AND. ZDQ_IS(:) /= 0.)
+ ZWQ_NI(:) = XFQIAGGSBS * (1 - ZQCOLIS(:)) * &
+ ZRHOCOR(:)**(1 + ZSAUNIN_IS(:)) * &
+ ZFQIAGGS(:) * ZDQ_IS(:) * &
+ ZCIT(:)**(1 - ZSAUNIM_IS(:) / ZBI) * &
+ ZCST(:) * ZLBDAS(:)**(-2.- ZDS * (1. + ZSAUNIN_IS(:))) * &
+ (ZRHODREF(:) * ZRIT(:) / XAIGAMMABI)**(ZSAUNIM_IS(:) / ZBI)
+ ENDWHERE
+ END IF
+!
+!
+!* 2.5 Charging process following Takahashi (1978)
+!
+ IF (CNI_CHARGING == 'TAKAH') THEN
+ WHERE (GELEC(:,1) .AND. ZDQ(:) /= 0.)
+ ZWQ_NI(:) = XFQIAGGSBT1 * (1.0 - ZQCOLIS(:)) * ZRHOCOR(:) * &
+ ZCIT(:) * ZCST(:) * ZDQ(:) * &
+ MIN( XFQIAGGSBT2 / (ZLBDAS(:)**(2. + ZDS)) , &
+ XFQIAGGSBT3 * ZRHOCOR(:) * ZRHODREF(:)**(2./ZBI) * &
+ ZRIT(:)**(2. / ZBI) / &
+ (ZCIT(:)**(2. / ZBI) * ZLBDAS(:)**(2. + 2. * ZDS)))
+ ENDWHERE
+ END IF
+!
+!
+!* 3. LIMITATION OF THE SEPARATED CHARGE
+! ----------------------------------
+!
+! Dq is limited to XLIM_NI_IS
+ WHERE (ZWQ_NI(:) .NE. 0.)
+ ZLIMIT(:) = XLIM_NI_IS * ZRIAGGS(:) * ZCIT(:) * &
+ (1 - ZQCOLIS(:)) / (ZRIT(:) * ZQCOLIS(:))
+ ZWQ_NI(:) = SIGN( MIN( ABS(ZLIMIT(:)), ABS(ZWQ_NI(:) ) ), ZWQ_NI(:) )
+ ZWQ_NI(:) = ZWQ_NI(:) / ZRHODREF(:)
+ ENDWHERE
+!
+! For temperatures lower than -30C --> linear interpolation
+ WHERE (ZWQ_NI(:) /= 0. .AND. ZZT(:) < (XTT-30.) .AND. ZZT(:) >= (XTT-40.))
+ ZWQ_NI(:) = ZWQ_NI(:) * (ZZT(:) - XTT + 40.) / 10.
+ ENDWHERE
+!
+END IF
+!
+ZQSS(:) = ZQSS(:) + ZWQ_NI(:)
+ZQIS(:) = ZQIS(:) - ZWQ_NI(:)
+!
+END SUBROUTINE ELEC_IAGGS_B
+!
+!------------------------------------------------------------------
+!
+! #########################
+ SUBROUTINE ELEC_IDRYG_B()
+! #########################
+!
+!
+! Purpose : compute charge separation process during the dry collision
+! between ice and graupeln
+!
+!
+!* 0. DECLARATIONS
+! ------------
+!
+IMPLICIT NONE
+!
+!
+!* 1. COMPUTE THE COLLISION EFFICIENCY
+! --------------------------------
+!
+ZQCOLIG(:) = ZCOLIG * EXP(ZCOLEXIG * (ZZT(:) - XTT))
+!
+ZWQ_NI(:) = 0.
+ZLIMIT(:) = 0.
+!
+!* 2. COMPUTE THE RATE OF SEPARATED CHARGE
+! ------------------------------------
+!
+!* 2.1 Charging process following Helsdon and Farley (1987)
+!
+IF (CNI_CHARGING == 'HELFA') THEN
+ !
+ WHERE (ZRIT(:) > XRTMIN_ELEC(4) .AND. ZCIT(:) > 0. .AND. &
+ ZRGT(:) > XRTMIN_ELEC(6))
+ ZWQ_NI(:) = XHIDRYG * ZRIDRYG(:) * ZCIT(:) / ZRIT(:)
+ ZWQ_NI(:) = ZWQ_NI(:) * (1. - ZQCOLIG(:)) / ZQCOLIG(:) ! QIDRYG_boun
+!
+! Temperature dependance of the charge transfered
+ ZWQ_NI(:) = ZWQ_NI(:) * (ZZT(:) - XQTC) / ABS(ZZT(:) - XQTC)
+ ZWQ_NI(:) = ZWQ_NI(:) / ZRHODREF(:)
+ END WHERE
+!
+ELSE
+!
+!
+!* 2.2 Charging process following Gardiner et al. (1985)
+!
+ IF (CNI_CHARGING == 'GARDI') THEN
+ WHERE (GELEC(:,2) .AND. ZDELTALWC(:) > 0.)
+ ZWQ_NI(:) = XFQIDRYGBG * XLBQIDRYGBG * (1 - ZQCOLIG) * &
+ ZRHODREF(:)**(-4. * ZCEXVT + 4. / ZBI) * &
+ ZCIT(:)**(1 - 4. / ZBI) * &
+ ZDELTALWC(:) * ZFT(:) * &
+ ZCGT(:) * ZLBDAG(:)**(-2. - 4. * ZDG) * &
+ (ZAI * MOMG(ZALPHAI, ZNUI, ZBI) / &
+ ZRIT(:))**(-4 / ZBI)
+ ENDWHERE
+ END IF
+!
+!
+!* 2.3 Charging process based on EW: SAUN1/SAUN2, TEEWC following
+!* Saunders et al. (1991), Takahashi via Tsenova and Mitzeva(2009)
+!
+ IF (CNI_CHARGING == 'SAUN1' .OR. CNI_CHARGING == 'SAUN2' .OR. &
+ CNI_CHARGING == 'TEEWC') THEN
+ WHERE (GELEC(:,2) .AND. ZDQ(:) /= 0.)
+ ZWQ_NI(:) = XFQIDRYGBS * (1. - ZQCOLIG(:)) * &
+ ZRHOCOR(:)**(1. + ZSAUNIN(:)) * &
+ ZFQIDRYGBS(:) * ZDQ(:) * &
+ ZCIT(:)**(1. - ZSAUNIM(:) / ZBI) * &
+ ZCGT(:) * ZLBDAG(:)**(-2. - ZDG * (1. + ZSAUNIN(:))) * &
+ (ZRHODREF(:) * ZRIT(:) / XAIGAMMABI)**(ZSAUNIM(:) / ZBI)
+ ENDWHERE
+ END IF
+!
+!
+!* 2.4 Charging process based on RAR (=EW*V): SAP98, BSMP1/BSMP2, TERAR
+!* following Saunders and Peck (1998) or Brooks et al., 1997 (with/out anomalies)
+!* or Takahashi via Tsenova and Mitzeva (2011)
+!
+ IF (CNI_CHARGING == 'SAP98' .OR. CNI_CHARGING == 'BSMP1' .OR. &
+ CNI_CHARGING == 'BSMP2' .OR. CNI_CHARGING == 'TERAR') THEN
+ IF (CNI_CHARGING /= 'TERAR') THEN
+ ZFQIDRYGBS(:) = XFQIDRYGBSP
+ WHERE (ZDQ_IG(:) < 0.)
+ ZFQIDRYGBS(:) = XFQIDRYGBSN
+ ENDWHERE
+ ELSE
+ ZFQIDRYGBS(:) = XFQIDRYGBSP_TAK
+ WHERE (ZDQ_IG(:) <0.)
+ ZFQIDRYGBS(:) = XFQIDRYGBSN_TAK
+ ENDWHERE
+ END IF
+!
+ WHERE (GELEC(:,2) .AND. ZDQ_IG(:) /= 0.)
+ ZWQ_NI(:) = XFQIDRYGBS * (1. - ZQCOLIG(:)) * &
+ ZRHOCOR(:)**(1 + ZSAUNIN_IG(:)) * &
+ ZFQIDRYGBS(:) * ZDQ_IG(:) * &
+ ZCIT(:)**(1 - ZSAUNIM_IG(:) / ZBI) * &
+ ZCGT(:) * ZLBDAG(:)**(-2. - ZDG * (1. + ZSAUNIN_IG(:))) * &
+ (ZRHODREF(:) * ZRIT(:) / XAIGAMMABI)**(ZSAUNIM_IG(:) / ZBI)
+ ENDWHERE
+ END IF
+!
+!
+!* 2.5 Charging process following Takahashi (1978)
+!
+ IF (CNI_CHARGING == 'TAKAH') THEN
+ WHERE (GELEC(:,2) .AND. ZDQ(:) /= 0.)
+ ZWQ_NI(:) = XFQIDRYGBT1 * (1. - ZQCOLIG(:)) * ZRHOCOR(:) * &
+ ZCIT(:) * ZCGT(:) * ZDQ(:) * &
+ MIN( XFQIDRYGBT2 / (ZLBDAG(:)**(2. + ZDG)), &
+ XFQIDRYGBT3 * ZRHOCOR(:) * ZRHODREF(:)**(2./ZBI) * &
+ ZRIT(:)**(2. / ZBI) / (ZCIT(:)**(2. / ZBI) * &
+ ZLBDAG(:)**(2. + 2. * ZDG)) )
+ ENDWHERE
+ END IF
+!
+!
+!* 3. LIMITATION OF THE SEPARATED CHARGE
+! ----------------------------------
+!
+! Dq is limited to XLIM_NI_IG
+ WHERE (ZWQ_NI(:) .NE. 0. .AND. ZRIT(:) > 0.)
+ ZLIMIT(:) = XLIM_NI_IG * ZRIDRYG(:) * ZCIT(:) * (1 - ZQCOLIG(:)) / &
+ (ZRIT(:) * ZQCOLIG(:))
+ ZWQ_NI(:) = SIGN( MIN( ABS(ZLIMIT(:)), ABS(ZWQ_NI(:) ) ), ZWQ_NI(:) )
+ ZWQ_NI(:) = ZWQ_NI(:) / ZRHODREF(:)
+ ENDWHERE
+!
+! For temperatures lower than -30C --> linear interpolation
+ WHERE (ZWQ_NI(:) /= 0. .AND. ZZT(:) < (XTT-30.) .AND. ZZT(:) >= (XTT-40.))
+ ZWQ_NI(:) = ZWQ_NI(:) * (ZZT(:) - XTT + 40.) / 10.
+ ENDWHERE
+!
+END IF
+!
+WHERE (ZRIDRYG(:) > 0.)
+ ZQGS(:) = ZQGS(:) + ZWQ_NI(:)
+ ZQIS(:) = ZQIS(:) - ZWQ_NI(:)
+END WHERE
+!
+END SUBROUTINE ELEC_IDRYG_B
+!
+!------------------------------------------------------------------
+!
+! #########################
+ SUBROUTINE ELEC_SDRYG_B()
+! #########################
+!
+!
+! Purpose : compute the charge separation during the dry collision
+! between snow and graupel
+!
+!
+!* 0. DECLARATIONS
+! ------------
+!
+IMPLICIT NONE
+!
+!
+!* 1. COMPUTE THE COLLECTION EFFICIENCY
+! ---------------------------------
+!
+ZQCOLSG(:) = ZCOLSG * EXP (ZCOLEXSG * (ZZT(:) - XTT))
+!
+ZWQ_NI(:) = 0.
+ZLIMIT(:) = 0.
+!
+!* 2. COMPUTE THE RATE OF SEPARATED CHARGE
+! ------------------------------------
+!
+!* 2.1 Charge separation following Helsdon and Farley (1987)
+!
+IF (CNI_CHARGING == 'HELFA') THEN
+!
+ WHERE (ZRGT(:) > XRTMIN_ELEC(6) .AND. ZLBDAG(:) > 0. .AND. &
+ ZRST(:) > XRTMIN_ELEC(5) .AND. ZLBDAS(:) > 0.)
+ ZWQ_NI(:) = ZWQ5(:,5) * XFQSDRYGBH * ZRHODREF(:)**(-ZCEXVT) * &
+ (1. - ZQCOLSG(:)) * &
+ ZCST(:) * ZCGT(:) * &
+ (XLBQSDRYGB4H * ZLBDAS(:)**(-2.) + &
+ XLBQSDRYGB5H * ZLBDAS(:)**(-1.) * ZLBDAG(:)**(-1.) + &
+ XLBQSDRYGB6H * ZLBDAG(:)**(-2.))
+!
+! Temperature dependance of the charge transfered
+ ZWQ_NI(:) = ZWQ_NI(:) * (ZZT(:) - XQTC) / ABS(ZZT(:) - XQTC)
+ ZWQ_NI(:) = ZWQ_NI(:) / ZRHODREF(:)
+ ENDWHERE
+!
+ELSE
+!
+!
+!* 2.2 Charge separation following Gardiner et al. (1985)
+!
+ IF (CNI_CHARGING == 'GARDI') THEN
+ WHERE (GELEC(:,3) .AND. ZDELTALWC(:) > 0.)
+ ZWQ_NI(:) = XFQSDRYGBG * (1. - ZQCOLSG(:)) * &
+ ZRHODREF(:)**(-4. * ZCEXVT) * &
+ ZFT(:) * ZDELTALWC(:) * &
+ ZCST(:) * ZCGT(:) * &
+ (XLBQSDRYGB4G * ZLBDAS(:)**(-4.) * ZLBDAG(:)**(-2.) + &
+ XLBQSDRYGB5G * ZLBDAS(:)**(-5.) * ZLBDAG(:)**(-1.) + &
+ XLBQSDRYGB6G * ZLBDAS(:)**(-6.)) * &
+ ZWQ5(:,5)
+ ENDWHERE
+ END IF
+!
+!
+!* 2.3 Charging process based on EW: SAUN1/SAUN2, TEEWC following
+!* Saunders et al. (1991), Takahashi via Tsenova and Mitzeva(2009)
+!
+ IF (CNI_CHARGING == 'SAUN1' .OR. CNI_CHARGING == 'SAUN2' .OR. &
+ CNI_CHARGING == 'TEEWC') THEN
+ WHERE (GELEC(:,3) .AND. ZDQ(:) /= 0.)
+! ZWQ_NI(:) = ZWQ5(:,6) If graupel gains positive charge ZDQ(:) > 0.
+! ZWQ_NI(:) = ZWQ5(:,7) If graupel gains negative charge ZDQ(:) < 0.
+ ZWQ_NI(:) = ZWQ5(:,6) * (0.5 + SIGN(0.5,ZDQ(:))) + &
+ ZWQ5(:,7) * (0.5 - SIGN(0.5,ZDQ(:)))
+!
+ ZWQ_NI(:) = ZWQ_NI(:) * XFQSDRYGBS * (1. - ZQCOLSG(:)) * &
+ ZRHOCOR(:)**(1. + ZSAUNSN(:)) * ZSAUNSK(:) * ZDQ(:) * &
+ ZCST(:) * ZCGT(:) * &
+ ( ZLBQSDRYGB1S(:) / (ZLBDAS(:)**ZSAUNSM(:) * ZLBDAG(:)**2) + &
+ ZLBQSDRYGB2S(:) / (ZLBDAS(:)**( 1.+ZSAUNSM(:)) * ZLBDAG(:)) + &
+ ZLBQSDRYGB3S(:) / ZLBDAS(:)**(2.+ZSAUNSM(:)) )
+ ENDWHERE
+ END IF
+!
+!
+!* 2.4 Charging process based on RAR (=EW*V): SAP98, BSMP1/BSMP2, TERAR
+!* following Saunders and Peck (1998) or Brooks et al., 1997 (with/out anomalies)
+!* or Takahashi via Tsenova and Mitzeva (2011)
+!
+ IF (CNI_CHARGING == 'SAP98' .OR. CNI_CHARGING == 'BSMP1' .OR. &
+ CNI_CHARGING == 'BSMP2' .OR. CNI_CHARGING == 'TERAR') THEN
+ ZLBQSDRYGB1S(:) = XLBQSDRYGB1SP
+ ZLBQSDRYGB2S(:) = XLBQSDRYGB2SP
+ ZLBQSDRYGB3S(:) = XLBQSDRYGB3SP
+ WHERE (ZDQ_SG(:) < 0.)
+ ZLBQSDRYGB1S(:) = XLBQSDRYGB1SN
+ ZLBQSDRYGB2S(:) = XLBQSDRYGB2SN
+ ZLBQSDRYGB3S(:) = XLBQSDRYGB3SN
+ ENDWHERE
+!
+ WHERE (GELEC(:,3) .AND. ZDQ_SG(:) /= 0.)
+ ZWQ_NI(:) = ZWQ5(:,6) * (0.5+SIGN(0.5,ZDQ_SG(:))) + &
+ ZWQ5(:,7) * (0.5-SIGN(0.5,ZDQ_SG(:)))
+!
+ ZWQ_NI(:) = ZWQ_NI(:) * XFQSDRYGBS * (1. - ZQCOLSG(:)) * &
+ ZRHOCOR(:)**(1. + ZSAUNSN_SG(:)) * ZSAUNSK_SG(:) * ZDQ_SG(:) * &
+ ZCST(:) * ZCGT(:) * &
+ (ZLBQSDRYGB1S(:) / (ZLBDAS(:)**ZSAUNSM_SG(:) * ZLBDAG(:)**2) + &
+ ZLBQSDRYGB2S(:) / (ZLBDAS(:)**(1.+ZSAUNSM_SG(:)) * ZLBDAG(:)) + &
+ ZLBQSDRYGB3S(:) / ZLBDAS(:)**(2.+ZSAUNSM_SG(:)) )
+ ENDWHERE
+ END IF
+!
+!
+!* 2.5 Charging process following Takahashi (1978)
+!
+ IF (CNI_CHARGING == 'TAKAH') THEN
+ WHERE (GELEC(:,3) .AND. ZDQ(:) /= 0.)
+ ZWQ_NI(:) = XFQSDRYGBT1 * (1. - ZQCOLSG(:)) * ZRHOCOR(:) * &
+ ZCGT(:) * ZCST(:) * ZDQ(:) * &
+ MIN(10. * ( &
+ ABS(XFQSDRYGBT2 / (ZLBDAG(:)**ZDG * ZLBDAS(:)**2.) - &
+ XFQSDRYGBT3 / (ZLBDAS(:)**(2. + ZDS))) + &
+ ABS(XFQSDRYGBT4 / (ZLBDAG(:)**(2. + ZDG)) - &
+ XFQSDRYGBT5 / (ZLBDAS(:)**ZDS * ZLBDAG(:)**2.)) + &
+ ABS(XFQSDRYGBT6 / (ZLBDAG(:)**(1. + ZDG) * ZLBDAS(:)) - &
+ XFQSDRYGBT7 / (ZLBDAS(:)**(1. + ZDS) * ZLBDAG(:)))), &
+ XFQSDRYGBT8 * ZRHOCOR(:) * ZWQ5(:,5) * &
+ (XFQSDRYGBT9 / (ZLBDAS(:)**2. * ZLBDAG(:)**2.) + &
+ XFQSDRYGBT10 / (ZLBDAS(:)**4.) + &
+ XFQSDRYGBT11 / (ZLBDAS(:)**3. * ZLBDAG(:))))
+ ENDWHERE
+ END IF
+!
+!
+!* 3. LIMITATION OF THE SEPARATED CHARGE
+! ----------------------------------
+!
+! Dq is limited to XLIM_NI_SG
+ WHERE (ZWQ_NI(:) .NE. 0.)
+ ZLIMIT(:) = XLIM_NI_SG * ZWQ5(:,4) * XAUX_LIM * &
+ ZRHOCOR(:) * (1. - ZQCOLSG(:)) * &
+ ZCST(:) * ZCGT(:) * &
+ ( XAUX_LIM1 / ZLBDAS(:)**2 + &
+ XAUX_LIM2 /(ZLBDAS(:) * ZLBDAG(:)) + &
+ XAUX_LIM3 / ZLBDAG(:)**2 )
+!
+ ZWQ_NI(:) = SIGN( MIN( ABS(ZLIMIT(:)), ABS(ZWQ_NI(:) ) ), ZWQ_NI(:) )
+ ZWQ_NI(:) = ZWQ_NI(:) / ZRHODREF(:)
+ ENDWHERE
+!
+! For temperatures lower than -30C --> linear interpolation
+ WHERE (ZWQ_NI(:) /= 0. .AND. ZZT(:) < (XTT-30.) .AND. ZZT(:) >= (XTT-40.))
+ ZWQ_NI(:) = ZWQ_NI(:) * (ZZT(:) - XTT + 40.) / 10.
+ ENDWHERE
+!
+END IF
+!
+WHERE (ZRSDRYG(:) > 0.)
+ ZQGS(:) = ZQGS(:) + ZWQ_NI(:)
+ ZQSS(:) = ZQSS(:) - ZWQ_NI(:)
+END WHERE
+!
+END SUBROUTINE ELEC_SDRYG_B
+!
+!------------------------------------------------------------------
+!
+! #########################################################################
+ SUBROUTINE COMPUTE_CHARGE_TRANSFER (PR_RATE, PRXT, PQXT, PTSTEP, &
+ PRX_THRESH, PQX_THRESH, PCOEF_RQ_X, &
+ PQ_RATE, PQXS, PQYS )
+! #########################################################################
+!
+! Purpose : compute the charge transfer rate in proportion of the mass transfer rate
+! x --> y
+! q_rate_xy = r_rate_xy * coef_rq_x * qx_t / rx_t
+!
+!
+!* 0. DECLARATIONS
+! ------------
+!
+IMPLICIT NONE
+!
+!* 0.1 Declaration of dummy arguments
+!
+REAL, INTENT(IN), DIMENSION(:) :: PR_RATE ! Mass exchange rate from x to y
+REAL, INTENT(IN), DIMENSION(:) :: PRXT ! Mixing ratio of x at t
+REAL, INTENT(IN), DIMENSION(:) :: PQXT ! Electric charge of x at t
+REAL, INTENT(IN) :: PRX_THRESH ! Threshold on mixing ratio
+REAL, INTENT(IN) :: PQX_THRESH ! Threshold on electric charge
+REAL, INTENT(IN) :: PCOEF_RQ_X ! Coefficient for charge exchange
+REAL, INTENT(IN) :: PTSTEP ! Time step
+REAL, INTENT(INOUT), DIMENSION(:) :: PQ_RATE ! Charge exchange rate from x to y
+REAL, INTENT(INOUT), DIMENSION(:) :: PQXS ! Electric charge of x - source term
+REAL, INTENT(INOUT), DIMENSION(:) :: PQYS ! Electric charge of y - source term
+!
+!
+!* 0.2 Declaration of local variables
+!
+!
+PQ_RATE(:) = 0.
+!
+WHERE (PR_RATE(:) > 0. .AND. &
+ PRXT(:) > PRX_THRESH .AND. ABS(PQXT(:)) > PQX_THRESH)
+! Compute the charge exchanged during the mass tranfer from species x to y
+ PQ_RATE(:) = PCOEF_RQ_X * PR_RATE(:) * PQXT(:) / PRXT(:)
+! Limit the charge exchanged to the charge available on x at t
+ PQ_RATE(:) = SIGN( MIN( ABS(PQXT(:)/PTSTEP),ABS(PQ_RATE(:)) ), PQXT(:)/PTSTEP )
+ !
+! Update the source terms of x and y
+ PQXS(:) = PQXS(:) - PQ_RATE(:)
+ PQYS(:) = PQYS(:) + PQ_RATE(:)
+END WHERE
+!
+END SUBROUTINE COMPUTE_CHARGE_TRANSFER
+!
+!------------------------------------------------------------------
+!
+! ###########################################################
+ FUNCTION BI_LIN_INTP_V(ZT, KI, KJ, PDX, PDY, KN) RESULT(PY)
+! ###########################################################
+!
+! Purpose :
+!
+! | |
+! ZT(KI(1),KJ(2))-|-------------------|-ZT(KI(2),KJ(2))
+! | |
+! | |
+! x2-|-------|y(x1,x2) |
+! | | |
+! PDY| | |
+! | | |
+! | | |
+!ZT( KI(1),KJ(1))-|-------------------|-ZT(KI(2),KJ(1))
+! | PDX |x1 |
+! | |
+!
+!* 0. DECLARATIONS
+! ------------
+!
+IMPLICIT NONE
+!
+!* 0.1 Declaration of dummy arguments
+!
+INTEGER, INTENT(IN) :: KN ! Size of the result vector
+INTEGER, INTENT(IN), DIMENSION(KN) :: KI ! Tabulated coordinate
+INTEGER, INTENT(IN), DIMENSION(KN) :: KJ ! Tabulated coordinate
+REAL, INTENT(IN), DIMENSION(:,:) :: ZT ! Tabulated data
+REAL, INTENT(IN), DIMENSION(KN) :: PDX, PDY !
+!
+REAL, DIMENSION(KN) :: PY ! Interpolated value
+!
+!* 0.2 Declaration of local variables
+!
+INTEGER :: JJ ! Loop index
+!
+!
+!* 1. INTERPOLATION
+! -------------
+!
+DO JJ = 1, KN
+ PY(JJ) = (1.0 - PDX(JJ)) * (1.0 - PDY(JJ)) * ZT(KI(JJ), KJ(JJ)) + &
+ PDX(JJ) * (1.0 - PDY(JJ)) * ZT(KI(JJ)+1,KJ(JJ)) + &
+ PDX(JJ) * PDY(JJ) * ZT(KI(JJ)+1,KJ(JJ)+1) + &
+ (1.0 - PDX(JJ)) * PDY(JJ) * ZT(KI(JJ) ,KJ(JJ)+1)
+ENDDO
+!
+END FUNCTION BI_LIN_INTP_V
+!
+!------------------------------------------------------------------
+!
+END SUBROUTINE ELEC_TENDENCIES
diff --git a/src/MNH/endstep.f90 b/src/MNH/endstep.f90
index 97734d72bd8ecad1aa8e4163c203fbfe7ab5fe57..cbb2080b592fcb7ad1f1492a165fd2df660e53f5 100644
--- a/src/MNH/endstep.f90
+++ b/src/MNH/endstep.f90
@@ -193,6 +193,7 @@ END MODULE MODI_ENDSTEP
!! 02/2019 (S. Bielli) Sea salt : significant sea wave height influences salt emission; 5 salt modes
! P. Wautelet 02/2020: use the new data structures and subroutines for budgets
! P. Wautelet 02/2022: add sea salt
+! C. Barthe 03/2023: add correction for electric charges
!------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -217,7 +218,8 @@ USE MODD_NSV, ONLY: XSVMIN, NSV_CHEMBEG, NSV_CHEMEND, &
NSV_AERBEG, NSV_AEREND,&
NSV_DSTBEG, NSV_DSTEND,&
NSV_SLTBEG, NSV_SLTEND,&
- NSV_SNWBEG, NSV_SNWEND
+ NSV_SNWBEG, NSV_SNWEND,&
+ NSV_ELECBEG, NSV_ELECEND
USE MODD_PARAM_C2R2, ONLY: LACTIT
USE MODD_PARAM_LIMA, ONLY: LACTIT_LIMA=>LACTIT
@@ -470,6 +472,18 @@ END IF
!
!------------------------------------------------------------------------------
!
+!* 6b. ELECTRIC CHARGES ONLY EXIST WHERE HYDROMETEORS ARE PRESENT
+!
+IF (SIZE(PRT,4) > 1 .AND. NSV_ELECEND > NSV_ELECBEG) THEN
+ DO JSV = 2, KRR
+ WHERE (PRT(:,:,:,JSV) == 0.)
+ PSVT(:,:,:,NSV_ELECBEG+JSV-1) = 0.
+ END WHERE
+ END DO
+END IF
+!
+!------------------------------------------------------------------------------
+!
!* 7. MINIMUM VALUE FOR CHEMISTRY
!
IF ((SIZE(PLBXSVM,4) > NSV_CHEMEND-1).AND.(SIZE(PLBXSVM,1) /= 0)) THEN
diff --git a/src/MNH/flash_geom_elec.f90 b/src/MNH/flash_geom_elec.f90
index e6eea2d03c113ae02451da51869d6ce8c6da983f..8c2c0a149c8e15eb83a19bc064a36a57c27c9a20 100644
--- a/src/MNH/flash_geom_elec.f90
+++ b/src/MNH/flash_geom_elec.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 2010-2022 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2010-2020 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -8,24 +8,25 @@
! #############################
!
INTERFACE
- SUBROUTINE FLASH_GEOM_ELEC_n (KTCOUNT, KMI, KRR, PTSTEP, OEXIT, &
+ SUBROUTINE FLASH_GEOM_ELEC_n (KTCOUNT, KMI, KRR, HCLOUD, PTSTEP, OEXIT, &
PRHODJ, PRHODREF, PRT, PCIT, PRSVS, PRS, PTHT, PPABST, &
- PEFIELDU, PEFIELDV, PEFIELDW, PZZ, PSVS_LINOX, &
+ PEFIELDU, PEFIELDV, PEFIELDW, PZZ, &
TPFILE_FGEOM_DIAG, TPFILE_FGEOM_COORD, TPFILE_LMA, &
- PTOWN, PSEA )
+ PTOWN, PSEA, PSVS_LNOX, PCCS, PCRS, PCSS, PCGS, PCHS )
!
USE MODD_IO, ONLY: TFILEDATA
!
INTEGER, INTENT(IN) :: KTCOUNT ! Temporal loop counter
INTEGER, INTENT(IN) :: KMI ! current model index
INTEGER, INTENT(IN) :: KRR ! number of moist variables
+CHARACTER(LEN=4), INTENT(IN) :: HCLOUD ! kind of cloud paramerization
REAL, INTENT(IN) :: PTSTEP ! Double time step except for
! cold start
LOGICAL, INTENT(IN) :: OEXIT ! switch for the end of the temporal loop
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Reference dry air density
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT ! Moist variables at time t
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCIT ! Pristine ice n.c. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCIT ! Pristine ice n.c. at t
REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRSVS ! Scalar variables source term
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PEFIELDU ! x-component of the electric field
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PEFIELDV ! y-component of the electric field
@@ -34,12 +35,18 @@ REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRS ! Moist variables vol. sourc
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta (K) at time t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! Absolute pressure at t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! height
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSVS_LINOX ! NOx source term
TYPE(TFILEDATA), INTENT(IN) :: TPFILE_FGEOM_DIAG
TYPE(TFILEDATA), INTENT(IN) :: TPFILE_FGEOM_COORD
TYPE(TFILEDATA), INTENT(IN) :: TPFILE_LMA
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PTOWN ! town fraction
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PSEA ! Land-sea mask
+!
+REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PTOWN ! town fraction
+REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PSEA ! Land-sea mask
+REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(INOUT) :: PSVS_LNOX ! NOx source term
+REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(IN) :: PCCS ! Nc source term
+REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(IN) :: PCRS ! Nr source term
+REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(IN) :: PCSS ! Ns source term
+REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(IN) :: PCGS ! Ng source term
+REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(IN) :: PCHS ! Nh source term
!
END SUBROUTINE FLASH_GEOM_ELEC_n
END INTERFACE
@@ -47,11 +54,11 @@ END MODULE MODI_FLASH_GEOM_ELEC_n
!
!
! ######################################################################################
- SUBROUTINE FLASH_GEOM_ELEC_n (KTCOUNT, KMI, KRR, PTSTEP, OEXIT, &
+ SUBROUTINE FLASH_GEOM_ELEC_n (KTCOUNT, KMI, KRR, HCLOUD, PTSTEP, OEXIT, &
PRHODJ, PRHODREF, PRT, PCIT, PRSVS, PRS, PTHT, PPABST, &
- PEFIELDU, PEFIELDV, PEFIELDW, PZZ, PSVS_LINOX, &
+ PEFIELDU, PEFIELDV, PEFIELDW, PZZ, &
TPFILE_FGEOM_DIAG, TPFILE_FGEOM_COORD, TPFILE_LMA, &
- PTOWN, PSEA )
+ PTOWN, PSEA, PSVS_LNOX, PCCS, PCRS, PCSS, PCGS, PCHS )
! ######################################################################################
!
!!**** * -
@@ -102,6 +109,8 @@ END MODULE MODI_FLASH_GEOM_ELEC_n
! P. Wautelet 20/05/2019: add name argument to ADDnFIELD_ll + new ADD4DFIELD_ll subroutine
! P. Wautelet 18/09/2019: correct support of 64bit integers (MNH_INT=8)
! P. Wautelet 31/08/2022: remove ZXMASS and ZYMASS (use XXHATM and XYHATM instead)
+! C. Barthe 07/09/2022: enable using CELLS with LIMA
+! C. Barthe 11/09/2023: enable using CELLS with LIMA2
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -125,11 +134,15 @@ USE MODD_IO, ONLY: TFILEDATA
USE MODD_LMA_SIMULATOR
USE MODD_METRICS_n, ONLY: XDXX, XDYY, XDZZ ! in linox_production
USE MODD_NSV, ONLY: NSV_ELECBEG, NSV_ELECEND, NSV_ELEC
-USE MODD_PARAMETERS, ONLY: JPHEXT, JPVEXT
-use MODD_PRECISION, only: MNHINT_MPI, MNHLOG_MPI, MNHREAL_MPI
-USE MODD_RAIN_ICE_DESCR_n, ONLY: XLBR, XLBEXR, XLBS, XLBEXS, &
- XLBG, XLBEXG, XLBH, XLBEXH, &
- XRTMIN
+USE MODD_PARAM_LIMA, ONLY: XRTMIN_L=>XRTMIN
+USE MODD_PARAM_LIMA_COLD, ONLY: XLBS_L=>XLBS, XLBEXS_L=>XLBEXS
+USE MODD_PARAM_LIMA_MIXED, ONLY: XLBG_L=>XLBG, XLBEXG_L=>XLBEXG, XLBH_L=>XLBH, XLBEXH_L=>XLBEXH
+USE MODD_PARAM_LIMA_WARM, ONLY: XLBC, XLBEXC, XLBR_L=>XLBR, XLBEXR_L=>XLBEXR
+USE MODD_PARAMETERS, ONLY: JPHEXT, JPVEXT
+use MODD_PRECISION, ONLY: MNHINT_MPI, MNHLOG_MPI, MNHREAL_MPI
+USE MODD_RAIN_ICE_DESCR_n, ONLY: XLBR_I=>XLBR, XLBEXR_I=>XLBEXR, XLBS_I=>XLBS, XLBEXS_I=>XLBEXS, &
+ XLBG_I=>XLBG, XLBEXG_I=>XLBEXG, XLBH_I=>XLBH, XLBEXH_I=>XLBEXH, &
+ XRTMIN_I=>XRTMIN
USE MODD_SUB_ELEC_n
USE MODD_TIME_n
USE MODD_VAR_ll, ONLY: NPROC,NMNH_COMM_WORLD
@@ -142,6 +155,7 @@ USE MODE_MPPDB
USE MODE_PACK_PGI
#endif
!
+USE MODI_COMPUTE_LAMBDA_3D
USE MODI_ION_ATTACH_ELEC
USE MODI_SHUMAN
USE MODI_TO_ELEC_FIELD_n
@@ -154,13 +168,14 @@ IMPLICIT NONE
INTEGER, INTENT(IN) :: KTCOUNT ! Temporal loop counter
INTEGER, INTENT(IN) :: KMI ! current model index
INTEGER, INTENT(IN) :: KRR ! number of moist variables
+CHARACTER(LEN=4), INTENT(IN) :: HCLOUD ! kind of cloud paramerization
REAL, INTENT(IN) :: PTSTEP ! Double time step except for
! cold start
LOGICAL, INTENT(IN) :: OEXIT ! switch for the end of the temporal loop
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Reference dry air density
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT ! Moist variables at time t
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCIT ! Pristine ice n.c. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCIT ! Pristine ice n.c. at t
REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRSVS ! Scalar variables source term
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PEFIELDU ! x-component of the electric field
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PEFIELDV ! y-component of the electric field
@@ -169,12 +184,18 @@ REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRS ! Moist variables vol. sourc
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta (K) at time t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! Absolute pressure at t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! height
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSVS_LINOX ! NOx source term
TYPE(TFILEDATA), INTENT(IN) :: TPFILE_FGEOM_DIAG
TYPE(TFILEDATA), INTENT(IN) :: TPFILE_FGEOM_COORD
TYPE(TFILEDATA), INTENT(IN) :: TPFILE_LMA
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PTOWN ! town fraction
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PSEA ! Land-sea mask
+!
+REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PTOWN ! town fraction
+REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PSEA ! Land-sea mask
+REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(INOUT) :: PSVS_LNOX ! NOx source term
+REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(IN) :: PCCS ! Nc source term
+REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(IN) :: PCRS ! Nr source term
+REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(IN) :: PCSS ! Ns source term
+REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(IN) :: PCGS ! Ng source term
+REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(IN) :: PCHS ! Nh source term
!
!
! 0.2 Declaration of local variables
@@ -276,7 +297,9 @@ REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZSIGMA ! efficient cross section of hyd
REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZDQDT ! charge to neutralize at each pt (C/kg)
REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZFLASH ! = 1 if the flash leader reaches this pt
! = 2 if the flash branch is concerned
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZLBDAC ! Lambda for cloud droplets
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZLBDAR ! Lambda for rain
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZLBDAI ! Lambda for ice crystals
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZLBDAS ! Lambda for snow
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZLBDAG ! Lambda for graupel
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZLBDAH ! Lambda for hail
@@ -324,6 +347,13 @@ REAL,DIMENSION(SIZE(PRT,1),SIZE(PRT,2)) :: ZCELL_NEW
INTEGER :: ILJ
INTEGER :: NIMAX_ll, NJMAX_ll,IIU_ll,IJU_ll ! dimensions of global domain
!
+! variables used to select between common parameters between ICEx and LIMA
+REAL :: ZLBR, ZLBEXR, ZLBS, ZLBEXS, &
+ ZLBG, ZLBEXG, ZLBH, ZLBEXH
+REAL, DIMENSION(:), ALLOCATABLE :: ZRTMIN
+INTEGER :: IMOMC, IMOMR, IMOMI, IMOMS, IMOMG, IMOMH ! nb of moments for hydrometeors
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZCCT, ZCRT, ZCIT, ZCST, ZCGT, ZCHT ! Nb conc. at t
+!
!-------------------------------------------------------------------------------
!
!* 1. INITIALIZATION
@@ -391,7 +421,6 @@ ALLOCATE (ZCLOUD(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3)))
ALLOCATE (GPOSS(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3)))
ALLOCATE (ZEMODULE(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3)))
ALLOCATE (ZCELL(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3),NMAX_CELL))
-
!
ZQMT(:,:,:,:) = 0.
ZQMTOT(:,:,:) = 0.
@@ -401,6 +430,30 @@ GPOSS(IIB:IIE,IJB:IJE,IKB:IKE) = .TRUE.
ZEMODULE(:,:,:) = 0.
ZCELL(:,:,:,:) = 0.
!
+! select parameters between ICEx and LIMA
+ALLOCATE(ZRTMIN(KRR))
+IF (HCLOUD(1:3) == 'ICE') THEN
+ ZRTMIN(1:KRR) = XRTMIN_I(1:KRR)
+ ZLBR = XLBR_I
+ ZLBEXR = XLBEXR_I
+ ZLBS = XLBS_I
+ ZLBEXS = XLBEXS_I
+ ZLBG = XLBG_I
+ ZLBEXG = XLBEXG_I
+ ZLBH = XLBH_I
+ ZLBEXH = XLBEXH_I
+ELSE IF (HCLOUD == 'LIMA') THEN
+ ZRTMIN(1:KRR) = XRTMIN_L(1:KRR)
+ ZLBR = XLBR_L
+ ZLBEXR = XLBEXR_L
+ ZLBS = XLBS_L
+ ZLBEXS = XLBEXS_L
+ ZLBG = XLBG_L
+ ZLBEXG = XLBEXG_L
+ ZLBH = XLBH_L
+ ZLBEXH = XLBEXH_L
+END IF
+!
!
!* 1.3 point discharge (Corona)
!
@@ -432,6 +485,36 @@ ZCLOUDLIM = 1.E-5
ZSIGMIN = 1.E-12
!
!
+!* 1.6 moments of the microphysics scheme
+!
+IMOMI = 2
+IF (HCLOUD(1:3) == 'ICE') THEN
+ IMOMC = 1
+ IMOMR = 1
+ IMOMS = 1
+ IMOMG = 1
+ IF (KRR == 7) IMOMH = 1
+ELSE IF (HCLOUD == 'LIMA') THEN
+ IMOMC = 2
+ IMOMR = 2
+ IF (PRESENT(PCSS)) THEN
+ IMOMS = 2
+ ELSE
+ IMOMS = 1
+ END IF
+ IF (PRESENT(PCGS)) THEN
+ IMOMG = 2
+ ELSE
+ IMOMG = 1
+ END IF
+ IF (PRESENT(PCHS)) THEN
+ IMOMH = 2
+ ELSE
+ IMOMH = 1
+ END IF
+END IF
+!
+!
!-------------------------------------------------------------------------------
!
!* 2. FIND AND COUNT THE ELECTRIFIED CELLS
@@ -627,7 +710,9 @@ IF (INB_CELL .GE. 1) THEN
ALLOCATE (INBSEG_LEADER(INB_CELL))
ALLOCATE (ZDQDT(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3),SIZE(PRT,4)+1))
ALLOCATE (ZSIGMA(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3),SIZE(PRT,4)-1))
+ ALLOCATE (ZLBDAC(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3)))
ALLOCATE (ZLBDAR(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3)))
+ ALLOCATE (ZLBDAI(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3)))
ALLOCATE (ZLBDAS(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3)))
ALLOCATE (ZLBDAG(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3)))
IF (KRR == 7) ALLOCATE (ZLBDAH(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3)))
@@ -642,7 +727,9 @@ IF (INB_CELL .GE. 1) THEN
ZCOORD_SEG(:,:) = 0.
ZDQDT(:,:,:,:) = 0.
ZSIGMA(:,:,:,:) = 0.
+ ZLBDAC(:,:,:) = 0.
ZLBDAR(:,:,:) = 0.
+ ZLBDAI(:,:,:) = 0.
ZLBDAS(:,:,:) = 0.
ZLBDAG(:,:,:) = 0.
ZSIGLOB(:,:,:) = 0.
@@ -663,74 +750,128 @@ IF (INB_CELL .GE. 1) THEN
!
!* 3. COMPUTE THE EFFICIENT CROSS SECTIONS OF HYDROMETEORS
! ----------------------------------------------------
+!
+ ALLOCATE(ZCCT(SIZE(PRSVS,1),SIZE(PRSVS,2),SIZE(PRSVS,3)))
+ ALLOCATE(ZCRT(SIZE(PRSVS,1),SIZE(PRSVS,2),SIZE(PRSVS,3)))
+ ALLOCATE(ZCIT(SIZE(PRSVS,1),SIZE(PRSVS,2),SIZE(PRSVS,3)))
+ ALLOCATE(ZCST(SIZE(PRSVS,1),SIZE(PRSVS,2),SIZE(PRSVS,3)))
+ ALLOCATE(ZCGT(SIZE(PRSVS,1),SIZE(PRSVS,2),SIZE(PRSVS,3)))
+ ALLOCATE(ZCHT(SIZE(PRSVS,1),SIZE(PRSVS,2),SIZE(PRSVS,3)))
!
!* 3.1 for cloud droplets
!
- WHERE (PRT(:,:,:,2) > ZCLOUDLIM)
- ZSIGMA(:,:,:,1) = XFQLIGHTC * PRHODREF(:,:,:) * PRT(:,:,:,2)
- ENDWHERE
+ IF (HCLOUD == 'LIMA') THEN
+ ZCCT(:,:,:) = PCCS(:,:,:) * PTSTEP / PRHODJ(:,:,:)
+ CALL COMPUTE_LAMBDA_3D(2, IMOMC, PRHODREF, ZRTMIN(2), PRT(:,:,:,2), ZCCT, ZLBDAC)
+ WHERE (PRT(:,:,:,2) > ZCLOUDLIM .AND. ZCCT(:,:,:) > 0. .AND. &
+ ZLBDAC(:,:,:) > 0.)
+ ZSIGMA(:,:,:,1) = XFQLIGHTC * ZLBDAC(:,:,:)**(-2.) * ZCCT(:,:,:)
+ END WHERE
+ ELSE IF (HCLOUD(1:3) == 'ICE') THEN
+ WHERE (PRT(:,:,:,2) > ZCLOUDLIM)
+ ZSIGMA(:,:,:,1) = XFQLIGHTC * PRHODREF(:,:,:) * PRT(:,:,:,2)
+ END WHERE
+ END IF
!
!
!* 3.2 for raindrops
!
- WHERE (PRT(:,:,:,3) > 0.0)
- ZLBDAR(:,:,:) = XLBR * (PRHODREF(:,:,:) * &
- MAX(PRT(:,:,:,3),XRTMIN(3)))**XLBEXR
- END WHERE
-!
- WHERE (PRT(:,:,:,3) > ZCLOUDLIM .AND. ZLBDAR(:,:,:) < XLBDAR_MAXE .AND. &
- ZLBDAR(:,:,:) > 0.)
- ZSIGMA(:,:,:,2) = XFQLIGHTR * ZLBDAR(:,:,:)**XEXQLIGHTR
- END WHERE
+ IF (HCLOUD == 'LIMA') THEN ! 2-moment: N is pronostic
+ ZCRT(:,:,:) = PCRS(:,:,:) * PTSTEP / PRHODJ(:,:,:)
+ CALL COMPUTE_LAMBDA_3D(3, IMOMR, PRHODREF, ZRTMIN(3), PRT(:,:,:,3), ZCRT, ZLBDAR)
+ WHERE (PRT(:,:,:,3) > ZCLOUDLIM .AND. ZLBDAR(:,:,:) < XLBDAR_MAXE .AND. &
+ ZLBDAR(:,:,:) > 0.)
+ ZSIGMA(:,:,:,2) = XFQLIGHTR * ZLBDAR(:,:,:)**XEXQLIGHTR * ZCRT(:,:,:)
+ END WHERE
+ ELSE IF (HCLOUD(1:3) == 'ICE') THEN ! 1-moment: N=C*lambda^x
+ CALL COMPUTE_LAMBDA_3D(3, IMOMR, PRHODREF, ZRTMIN(3), PRT(:,:,:,3), ZCRT, ZLBDAR)
+ !
+ WHERE (PRT(:,:,:,3) > ZCLOUDLIM .AND. ZLBDAR(:,:,:) < XLBDAR_MAXE .AND. &
+ ZLBDAR(:,:,:) > 0.)
+ ZSIGMA(:,:,:,2) = XFQLIGHTR * ZLBDAR(:,:,:)**XEXQLIGHTR
+ END WHERE
+ END IF
!
!
!* 3.3 for ice crystals
!
- WHERE (PRT(:,:,:,4) > ZCLOUDLIM .AND. PCIT(:,:,:) > 1.E4)
- ZSIGMA(:,:,:,3) = XFQLIGHTI * PCIT(:,:,:)**(1.-XEXQLIGHTI) * &
+ IF (HCLOUD == 'LIMA') THEN
+ ! with LIMA, pcit is pcis
+ ZCIT(:,:,:) = PCIT(:,:,:) * PTSTEP / PRHODJ(:,:,:)
+ ELSE IF (HCLOUD(1:3) == 'ICE') THEN
+ ! with ICEx, pcit is really pcit
+ ZCIT(:,:,:) = PCIT(:,:,:)
+ END IF
+ CALL COMPUTE_LAMBDA_3D(4, IMOMI, PRHODREF, ZRTMIN(4), PRT(:,:,:,4), ZCIT, ZLBDAI)
+ WHERE (PRT(:,:,:,4) > ZCLOUDLIM .AND. ZCIT(:,:,:) > 1.E4)
+ ZSIGMA(:,:,:,3) = XFQLIGHTI * ZCIT(:,:,:)**(1.-XEXQLIGHTI) * &
((PRHODREF(:,:,:) * PRT(:,:,:,4))**XEXQLIGHTI)
ENDWHERE
!
!
!* 3.4 for snow
!
- WHERE (PRT(:,:,:,5) > 0.0)
- ZLBDAS(:,:,:) = MIN(XLBDAS_MAXE, &
- XLBS * (PRHODREF(:,:,:) * &
- MAX(PRT(:,:,:,5),XRTMIN(5)))**XLBEXS)
- END WHERE
-!
- WHERE (PRT(:,:,:,5) > ZCLOUDLIM .AND. ZLBDAS(:,:,:) < XLBDAS_MAXE .AND. &
- ZLBDAS(:,:,:) > 0.)
- ZSIGMA(:,:,:,4) = XFQLIGHTS * ZLBDAS(:,:,:)**XEXQLIGHTS
- ENDWHERE
+ IF (IMOMS == 2) THEN
+ ZCST(:,:,:) = PCSS(:,:,:) * PTSTEP / PRHODJ(:,:,:)
+ CALL COMPUTE_LAMBDA_3D(5, IMOMS, PRHODREF, ZRTMIN(5), PRT(:,:,:,5), ZCST, ZLBDAS)
+ WHERE (PRT(:,:,:,5) > ZCLOUDLIM .AND. ZLBDAS(:,:,:) < XLBDAS_MAXE .AND. &
+ ZLBDAS(:,:,:) > 0.)
+ ZSIGMA(:,:,:,4) = XFQLIGHTS * ZLBDAS(:,:,:)**XEXQLIGHTS * ZCST(:,:,:)
+ END WHERE
+ ELSE IF (IMOMS == 1) THEN
+ CALL COMPUTE_LAMBDA_3D(5, IMOMS, PRHODREF, ZRTMIN(5), PRT(:,:,:,5), ZCST, ZLBDAS)
+ WHERE (PRT(:,:,:,5) > ZCLOUDLIM .AND. ZLBDAS(:,:,:) < XLBDAS_MAXE .AND. &
+ ZLBDAS(:,:,:) > 0.)
+ ZSIGMA(:,:,:,4) = XFQLIGHTS * ZLBDAS(:,:,:)**XEXQLIGHTS
+ END WHERE
+ END IF
!
!
!* 3.5 for graupel
!
- WHERE (PRT(:,:,:,6) > 0.0)
- ZLBDAG(:,:,:) = XLBG * (PRHODREF(:,:,:) * MAX(PRT(:,:,:,6),XRTMIN(6)))**XLBEXG
- END WHERE
-!
- WHERE (PRT(:,:,:,6) > ZCLOUDLIM .AND. ZLBDAG(:,:,:) < XLBDAG_MAXE .AND. &
- ZLBDAG(:,:,:) > 0.)
- ZSIGMA(:,:,:,5) = XFQLIGHTG * ZLBDAG(:,:,:)**XEXQLIGHTG
- ENDWHERE
+ IF (IMOMG == 2) THEN
+ ZCGT(:,:,:) = PCGS(:,:,:) * PTSTEP / PRHODJ(:,:,:)
+ CALL COMPUTE_LAMBDA_3D(6, IMOMG, PRHODREF, ZRTMIN(6), PRT(:,:,:,6), ZCGT, ZLBDAG)
+ WHERE (PRT(:,:,:,6) > ZCLOUDLIM .AND. ZLBDAG(:,:,:) < XLBDAG_MAXE .AND. &
+ ZLBDAG(:,:,:) > 0.)
+ ZSIGMA(:,:,:,5) = XFQLIGHTG * ZLBDAG(:,:,:)**XEXQLIGHTG * ZCGT(:,:,:)
+ END WHERE
+ ELSE IF (IMOMG == 1) THEN
+ CALL COMPUTE_LAMBDA_3D(6, IMOMG, PRHODREF, ZRTMIN(6), PRT(:,:,:,6), ZCGT, ZLBDAG)
+ !
+ WHERE (PRT(:,:,:,6) > ZCLOUDLIM .AND. ZLBDAG(:,:,:) < XLBDAG_MAXE .AND. &
+ ZLBDAG(:,:,:) > 0.)
+ ZSIGMA(:,:,:,5) = XFQLIGHTG * ZLBDAG(:,:,:)**XEXQLIGHTG
+ END WHERE
+ END IF
!
!
!* 3.6 for hail
!
IF (KRR == 7) THEN
- WHERE (PRT(:,:,:,7) > 0.0)
- ZLBDAH(:,:,:) = XLBH * (PRHODREF(:,:,:) * &
- MAX(PRT(:,:,:,7), XRTMIN(7)))**XLBEXH
- END WHERE
-!
- WHERE (PRT(:,:,:,7) > ZCLOUDLIM .AND. ZLBDAH(:,:,:) < XLBDAH_MAXE .AND. &
- ZLBDAH(:,:,:) > 0.)
- ZSIGMA(:,:,:,6) = XFQLIGHTH * ZLBDAH(:,:,:)**XEXQLIGHTH
- ENDWHERE
+ IF (IMOMH == 2) THEN
+ ZCHT(:,:,:) = PCHS(:,:,:) * PTSTEP / PRHODJ(:,:,:)
+ CALL COMPUTE_LAMBDA_3D(7, IMOMH, PRHODREF, ZRTMIN(7), PRT(:,:,:,7), ZCHT, ZLBDAH)
+ WHERE (PRT(:,:,:,7) > ZCLOUDLIM .AND. ZLBDAH(:,:,:) < XLBDAH_MAXE .AND. &
+ ZLBDAH(:,:,:) > 0.)
+ ZSIGMA(:,:,:,6) = XFQLIGHTH * ZLBDAH(:,:,:)**XEXQLIGHTH * ZCHT(:,:,:)
+ END WHERE
+ ELSE IF (IMOMH == 1) THEN
+ CALL COMPUTE_LAMBDA_3D(7, IMOMH, PRHODREF, ZRTMIN(7), PRT(:,:,:,7), ZCHT, ZLBDAH)
+ !
+ WHERE (PRT(:,:,:,7) > ZCLOUDLIM .AND. ZLBDAH(:,:,:) < XLBDAH_MAXE .AND. &
+ ZLBDAH(:,:,:) > 0.)
+ ZSIGMA(:,:,:,6) = XFQLIGHTH * ZLBDAH(:,:,:)**XEXQLIGHTH
+ END WHERE
+ END IF
END IF
+!
+ DEALLOCATE(ZCCT)
+ DEALLOCATE(ZCRT)
+ DEALLOCATE(ZCIT)
+ DEALLOCATE(ZCST)
+ DEALLOCATE(ZCGT)
+ IF (ALLOCATED(ZCHT)) DEALLOCATE(ZCHT)
!
!
!* 3.7 sum of the efficient cross sections
@@ -1045,7 +1186,6 @@ ENDIF
INB_NEUT = COUNT(ZSIGLOB(IIB:IIE,IJB:IJE,IKB:IKE) .GE. ZSIGMIN .AND. &
ZQFLASH(IIB:IIE,IJB:IJE,IKB:IKE) .NE. 0.)
CALL SUM_ELEC_ll(INB_NEUT)
-
!
!
!* 9.3 ensure total charge conservation for IC
@@ -1378,16 +1518,42 @@ ENDIF
!
IF (INB_NEUT_OK .NE. 0) THEN
- CALL MPPDB_CHECK3DM("flash:: PRSVS",PRECISION,&
- PRSVS(:,:,:,1),PRSVS(:,:,:,2),PRSVS(:,:,:,3),PRSVS(:,:,:,4),&
- PRSVS(:,:,:,5),PRSVS(:,:,:,6),PRSVS(:,:,:,7))
+ CALL MPPDB_CHECK3DM("flash:: PRSVS",PRECISION,&
+ PRSVS(:,:,:,1),PRSVS(:,:,:,2),PRSVS(:,:,:,3),PRSVS(:,:,:,4),&
+ PRSVS(:,:,:,5),PRSVS(:,:,:,6),PRSVS(:,:,:,7))
PRSVS(:,:,:,1) = PRSVS(:,:,:,1) / XECHARGE
PRSVS(:,:,:,NSV_ELEC) = - PRSVS(:,:,:,NSV_ELEC) / XECHARGE
!
- CALL ION_ATTACH_ELEC(KTCOUNT, KRR, PTSTEP, PRHODREF, &
- PRHODJ, PRSVS, PRS, PTHT, PCIT, PPABST, PEFIELDU, &
- PEFIELDV, PEFIELDW, GATTACH, PTOWN, PSEA )
+ IF (HCLOUD(1:3) == 'ICE') THEN
+ IF (PRESENT(PTOWN) .AND. PRESENT(PSEA)) THEN
+ CALL ION_ATTACH_ELEC(KTCOUNT, KRR, HCLOUD, PTSTEP, PRHODREF, &
+ PRHODJ, PRSVS, PRS, PTHT, PCIT, PPABST, PEFIELDU, &
+ PEFIELDV, PEFIELDW, GATTACH, &
+ PTOWN=PTOWN, PSEA=PSEA )
+ ELSE
+ CALL ION_ATTACH_ELEC(KTCOUNT, KRR, HCLOUD, PTSTEP, PRHODREF, &
+ PRHODJ, PRSVS, PRS, PTHT, PCIT, PPABST, PEFIELDU, &
+ PEFIELDV, PEFIELDW, GATTACH )
+ END IF
+ ELSE IF (HCLOUD == 'LIMA') THEN
+ IF (IMOMS == 1 .AND. IMOMG == 1) THEN
+ CALL ION_ATTACH_ELEC(KTCOUNT, KRR, HCLOUD, PTSTEP, PRHODREF, &
+ PRHODJ, PRSVS, PRS, PTHT, PCIT, PPABST, PEFIELDU, &
+ PEFIELDV, PEFIELDW, GATTACH, &
+ PCCS=PCCS, PCRS=PCRS )
+ ELSE IF (KRR == 6 .AND. IMOMS == 2 .AND. IMOMG == 2) THEN
+ CALL ION_ATTACH_ELEC(KTCOUNT, KRR, HCLOUD, PTSTEP, PRHODREF, &
+ PRHODJ, PRSVS, PRS, PTHT, PCIT, PPABST, PEFIELDU, &
+ PEFIELDV, PEFIELDW, GATTACH, &
+ PCCS=PCCS, PCRS=PCRS, PCSS=PCSS, PCGS=PCGS )
+ ELSE IF (KRR == 7 .AND. IMOMS == 2 .AND. IMOMG == 2 .AND. IMOMH == 2) THEN
+ CALL ION_ATTACH_ELEC(KTCOUNT, KRR, HCLOUD, PTSTEP, PRHODREF, &
+ PRHODJ, PRSVS, PRS, PTHT, PCIT, PPABST, PEFIELDU, &
+ PEFIELDV, PEFIELDW, GATTACH, &
+ PCCS=PCCS, PCRS=PCRS, PCSS=PCSS, PCGS=PCGS, PCHS=PCHS )
+ END IF
+ END IF
!
PRSVS(:,:,:,1) = PRSVS(:,:,:,1) * XECHARGE
PRSVS(:,:,:,NSV_ELEC) = - PRSVS(:,:,:,NSV_ELEC) * XECHARGE
@@ -1467,8 +1633,8 @@ ENDIF
XLNOX_ECLAIR = 0.
IF (IFLASH_COUNT .NE. 0) THEN
XLNOX_ECLAIR = SUM(ZLNOX(:,:,:))
- PSVS_LINOX(:,:,:) = PSVS_LINOX(:,:,:) + ZLNOX(:,:,:) * ZCOEF ! PRHODJ is
- ! implicit
+ PSVS_LNOX(:,:,:) = PSVS_LNOX(:,:,:) + ZLNOX(:,:,:) * ZCOEF ! PRHODJ is
+ ! implicit
END IF
CALL SUM_ELEC_ll (XLNOX_ECLAIR)
XLNOX_ECLAIR = XLNOX_ECLAIR / (XAVOGADRO * REAL(IFLASH_COUNT_GLOB))
@@ -1479,7 +1645,9 @@ ENDIF
DEALLOCATE (ZNEUT_POS)
DEALLOCATE (ZNEUT_NEG)
DEALLOCATE (ZSIGMA)
+ DEALLOCATE (ZLBDAC)
DEALLOCATE (ZLBDAR)
+ DEALLOCATE (ZLBDAI)
DEALLOCATE (ZLBDAS)
DEALLOCATE (ZLBDAG)
IF (KRR == 7) DEALLOCATE (ZLBDAH)
@@ -2164,7 +2332,6 @@ DO WHILE (IM .LE. IDELTA_IND .AND. ISTOP .NE. 1)
IF (IMASKQ_DIST(JI,JJ,JK) .EQ. IM) THEN
JIL = JIL + 1
I8VECT(JIL) = IJU_ll*IIU_ll*(JK-1) + IIU_ll*(JJ-1 +IYOR-1) + (JI +IXOR-1)
- !print*,"IN => I8VECT(JIL )=",I8VECT(JIL),JI,JJ,JK,JIL
END IF
END DO
END DO
@@ -2196,7 +2363,6 @@ DO WHILE (IM .LE. IDELTA_IND .AND. ISTOP .NE. 1)
JK = 1 + (I8VECT_LL(ICHOICE)-1) / ( IJU_ll*IIU_ll )
JJ = 1 + ( (I8VECT_LL(ICHOICE)-1) - IJU_ll*IIU_ll*(JK-1) ) / IIU_ll - IYOR +1
JI = 1 + MOD((I8VECT_LL(ICHOICE)-1) , int(IIU_ll,kind(I8VECT_LL(1)))) - IXOR +1
- !print*,"OUT => I8VECT_LL(ICHOICE)=",I8VECT_ll(ICHOICE),JI,JJ,JK,ICHOICE
ZFLASH(JI,JJ,JK,IL) = 2.
END IF
I8VECT_LL(ICHOICE) = 0
diff --git a/src/MNH/ini_budget.f90 b/src/MNH/ini_budget.f90
index 6e8895afca14422904c7d7c6af66ad6a8063dd10..79608c1252a2f756f26d1d47f9309b1fcbbfe2cd 100644
--- a/src/MNH/ini_budget.f90
+++ b/src/MNH/ini_budget.f90
@@ -211,6 +211,7 @@ end subroutine Budget_preallocate
! R. Schoetter 12/2021 multi-level coupling between MesoNH and SURFEX
! C. Barthe 14/03/2022: budgets: add terms for CIBU and RDSF in LIMA
! M. Taufour 01/07/2022: budgets: add concentration for snow, graupel, hail
+! C. Barthe 14/03/2023: budgets: add terms for electricity with LIMA
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -1253,7 +1254,7 @@ if ( lbu_rth ) then
tzsource%cmnhname = 'CORR'
tzsource%clongname = 'correction'
- tzsource%lavailable = hcloud(1:3) == 'ICE' .and. lred .and. celec == 'NONE'
+ tzsource%lavailable = hcloud(1:3) == 'ICE' .and. lred .and. celec /= 'ELE3'
call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
tzsource%cmnhname = 'CEDS'
@@ -1263,7 +1264,7 @@ if ( lbu_rth ) then
tzsource%cmnhname = 'ADJU'
tzsource%clongname = 'adjustment to saturation'
- tzsource%lavailable = hcloud(1:3) == 'ICE' .and. lred .and. ladj_before .and. celec == 'NONE'
+ tzsource%lavailable = hcloud(1:3) == 'ICE' .and. lred .and. ladj_before .and. celec /= 'ELE3'
call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
tzsource%cmnhname = 'DEPI'
@@ -1280,8 +1281,8 @@ if ( lbu_rth ) then
tzsource%cmnhname = 'NECON'
tzsource%clongname = 'negativity correction induced by condensation'
tzsource%lavailable = ( hcloud == 'KESS' .or. hcloud == 'ICE3' .or. hcloud == 'ICE4' &
- .or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA' ) &
- .and. celec == 'NONE'
+ .or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA' ) !&
+! .and. celec /= 'ELE3' !++cb-- 26/04/23
call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
@@ -1586,7 +1587,7 @@ if ( tbudgets(NBUDGET_RV)%lenabled ) then
tzsource%cmnhname = 'ADJU'
tzsource%clongname = 'adjustment to saturation'
- tzsource%lavailable = hcloud(1:3) == 'ICE' .and. lred .and. ladj_before .and. celec == 'NONE'
+ tzsource%lavailable = hcloud(1:3) == 'ICE' .and. lred .and. ladj_before .and. celec /= 'ELE3'
call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
tzsource%cmnhname = 'COND'
@@ -1596,7 +1597,7 @@ if ( tbudgets(NBUDGET_RV)%lenabled ) then
tzsource%cmnhname = 'CORR'
tzsource%clongname = 'correction'
- tzsource%lavailable = hcloud(1:3) == 'ICE' .and. lred .and. celec == 'NONE'
+ tzsource%lavailable = hcloud(1:3) == 'ICE' .and. lred .and. celec /= 'ELE3'
call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
tzsource%cmnhname = 'DEPI'
@@ -1613,8 +1614,8 @@ if ( tbudgets(NBUDGET_RV)%lenabled ) then
tzsource%cmnhname = 'NECON'
tzsource%clongname = 'negativity correction induced by condensation'
tzsource%lavailable = ( hcloud == 'KESS' .or. hcloud == 'ICE3' .or. hcloud == 'ICE4' &
- .or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA' ) &
- .and. celec == 'NONE'
+ .or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA' ) !&
+! .and. celec /= 'ELE3' !++cb-- 26/04/23
call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
@@ -1741,7 +1742,7 @@ if ( tbudgets(NBUDGET_RC)%lenabled ) then
tzsource%clongname = 'correction'
! tzsource%lavailable = ( hcloud == 'LIMA' .and. lptsplit .and. nmom_c.ge.1 .and. nmom_r.ge.1 ) &
! .or. ( hcloud(1:3) == 'ICE' .and. lred .and. celec == 'NONE' )
- tzsource%lavailable = hcloud(1:3) == 'ICE' .and. lred .and. celec == 'NONE'
+ tzsource%lavailable = hcloud(1:3) == 'ICE' .and. lred .and. celec /= 'ELE3'
call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
tzsource%cmnhname = 'SEDI'
@@ -1781,7 +1782,7 @@ if ( tbudgets(NBUDGET_RC)%lenabled ) then
tzsource%cmnhname = 'ADJU'
tzsource%clongname = 'adjustment to saturation'
- tzsource%lavailable = hcloud(1:3) == 'ICE' .and. lred .and. ladj_before .and. celec == 'NONE'
+ tzsource%lavailable = hcloud(1:3) == 'ICE' .and. lred .and. ladj_before .and. celec /= 'ELE3'
call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
tzsource%cmnhname = 'HON'
@@ -1835,7 +1836,7 @@ if ( tbudgets(NBUDGET_RC)%lenabled ) then
tzsource%cmnhname = 'CMEL'
tzsource%clongname = 'collection by snow and conversion into rain with T>XTT on ice'
- tzsource%lavailable = hcloud(1:3) == 'ICE' .and. lred .and. celec == 'NONE'
+ tzsource%lavailable = hcloud(1:3) == 'ICE' .and. lred .and. celec /= 'ELE3'
call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
tzsource%cmnhname = 'WETG'
@@ -1891,8 +1892,8 @@ if ( tbudgets(NBUDGET_RC)%lenabled ) then
tzsource%cmnhname = 'NECON'
tzsource%clongname = 'negativity correction induced by condensation'
tzsource%lavailable = ( hcloud == 'KESS' .or. hcloud == 'ICE3' .or. hcloud == 'ICE4' &
- .or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA' ) &
- .and. celec == 'NONE'
+ .or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA' ) !&
+! .and. celec /= 'ELE3' !++cb-- 26/04/23
call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
@@ -1994,7 +1995,7 @@ if ( tbudgets(NBUDGET_RR)%lenabled ) then
tzsource%clongname = 'correction'
! tzsource%lavailable = ( hcloud == 'LIMA' .and. lptsplit .and. nmom_c.ge.1 .and. nmom_r.ge.1 ) &
! .or. ( hcloud(1:3) == 'ICE' .and. lred .and. celec == 'NONE' )
- tzsource%lavailable = hcloud(1:3) == 'ICE' .and. lred .and. celec == 'NONE'
+ tzsource%lavailable = hcloud(1:3) == 'ICE' .and. lred .and. celec /= 'ELE3'
call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
tzsource%cmnhname = 'SEDI'
@@ -2053,7 +2054,7 @@ if ( tbudgets(NBUDGET_RR)%lenabled ) then
tzsource%cmnhname = 'CMEL'
tzsource%clongname = 'collection of droplets by snow and conversion into rain'
- tzsource%lavailable = hcloud(1:3) == 'ICE' .and. lred .and. celec == 'NONE'
+ tzsource%lavailable = hcloud(1:3) == 'ICE' .and. lred .and. celec /= 'ELE3'
call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
tzsource%cmnhname = 'CFRZ'
@@ -2120,8 +2121,8 @@ if ( tbudgets(NBUDGET_RR)%lenabled ) then
tzsource%cmnhname = 'NECON'
tzsource%clongname = 'negativity correction induced by condensation'
tzsource%lavailable = ( hcloud == 'KESS' .or. hcloud == 'ICE3' .or. hcloud == 'ICE4' &
- .or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA' ) &
- .and. celec == 'NONE'
+ .or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA' ) !&
+! .and. celec /= 'ELE3' !++cb-- 26/04/23
call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
@@ -2236,12 +2237,12 @@ if ( tbudgets(NBUDGET_RI)%lenabled ) then
tzsource%clongname = 'correction'
! tzsource%lavailable = ( hcloud == 'LIMA' .and. lptsplit .and. nmom_i.ge.1 .and. nmom_s.ge.1 ) &
! .or. ( hcloud(1:3) == 'ICE' .and. lred .and. celec == 'NONE' )
- tzsource%lavailable = hcloud(1:3) == 'ICE' .and. lred .and. celec == 'NONE'
+ tzsource%lavailable = hcloud(1:3) == 'ICE' .and. lred .and. celec /= 'ELE3'
call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
tzsource%cmnhname = 'ADJU'
tzsource%clongname = 'adjustment to saturation'
- tzsource%lavailable = hcloud(1:3) == 'ICE' .and. lred .and. ladj_before .and. celec == 'NONE'
+ tzsource%lavailable = hcloud(1:3) == 'ICE' .and. lred .and. ladj_before .and. celec /= 'ELE3'
call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
tzsource%cmnhname = 'SEDI'
@@ -2379,7 +2380,7 @@ if ( tbudgets(NBUDGET_RI)%lenabled ) then
tzsource%cmnhname = 'NECON'
tzsource%clongname = 'negativity correction induced by condensation'
- tzsource%lavailable = celec == 'NONE'
+ tzsource%lavailable = .true. !celec /= 'ELE3' !++cb-- 26/04/23
call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
@@ -2480,7 +2481,7 @@ if ( tbudgets(NBUDGET_RS)%lenabled ) then
tzsource%clongname = 'correction'
! tzsource%lavailable = ( hcloud == 'LIMA' .and. lptsplit .and. nmom_i.ge.1 .and. nmom_s.ge.1 ) &
! .or. ( hcloud(1:3) == 'ICE' .and. lred .and. celec == 'NONE' )
- tzsource%lavailable = hcloud(1:3) == 'ICE' .and. lred .and. celec == 'NONE'
+ tzsource%lavailable = hcloud(1:3) == 'ICE' .and. lred .and. celec /= 'ELE3'
call Budget_source_add( tbudgets(NBUDGET_RS), tzsource )
tzsource%cmnhname = 'SEDI'
@@ -2570,7 +2571,7 @@ if ( tbudgets(NBUDGET_RS)%lenabled ) then
tzsource%cmnhname = 'NECON'
tzsource%clongname = 'negativity correction induced by condensation'
- tzsource%lavailable = celec == 'NONE'
+ tzsource%lavailable = .true. !celec /= 'ELE3' !++cb-- 26/04/23
call Budget_source_add( tbudgets(NBUDGET_RS), tzsource )
@@ -2669,7 +2670,7 @@ if ( tbudgets(NBUDGET_RG)%lenabled ) then
tzsource%cmnhname = 'CORR'
tzsource%clongname = 'correction'
- tzsource%lavailable = hcloud(1:3) == 'ICE' .and. lred .and. celec == 'NONE'
+ tzsource%lavailable = hcloud(1:3) == 'ICE' .and. lred .and. celec /= 'ELE3'
call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
tzsource%cmnhname = 'SEDI'
@@ -2778,8 +2779,8 @@ if ( tbudgets(NBUDGET_RG)%lenabled ) then
tzsource%cmnhname = 'NECON'
tzsource%clongname = 'negativity correction induced by condensation'
tzsource%lavailable = ( hcloud == 'KESS' .or. hcloud == 'ICE3' .or. hcloud == 'ICE4' &
- .or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA' ) &
- .and. celec == 'NONE'
+ .or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA' ) !&
+! .and. celec /= 'ELE3' !++cb-- 24/04/23
call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
@@ -2939,7 +2940,7 @@ if ( tbudgets(NBUDGET_RH)%lenabled ) then
tzsource%cmnhname = 'NECON'
tzsource%clongname = 'negativity correction induced by condensation'
- tzsource%lavailable = celec == 'NONE'
+ tzsource%lavailable = .true. !celec == 'NONE' !++cb-- 26/04/23
call Budget_source_add( tbudgets(NBUDGET_RH), tzsource )
@@ -3761,14 +3762,29 @@ SV_BUDGETS: do jsv = 1, ksv
else if ( jsv >= nsv_elecbeg .and. jsv <= nsv_elecend ) then SV_VAR
! Electricity case
+ tzsource%cmnhname = 'NETUR'
+ tzsource%clongname = 'negativity correction induced by turbulence'
+ tzsource%lavailable = hturb == 'TKEL'
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'NEADV'
+ tzsource%clongname = 'negativity correction induced by advection'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
tzsource%cmnhname = 'NEGA'
tzsource%clongname = 'negativity correction'
tzsource%lavailable = .true.
call Budget_source_add( tbudgets(ibudget), tzsource )
+ tzsource%cmnhname = 'NECON'
+ tzsource%clongname = 'negativity correction induced by condensation'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
SV_ELEC: select case( jsv - nsv_elecbeg + 1 )
case ( 1 ) SV_ELEC
- ! volumetric charge of water vapor
+ ! positive ions
tzsource%cmnhname = 'DRIFT'
tzsource%clongname = 'ion drift motion'
tzsource%lavailable = .true.
@@ -3779,6 +3795,11 @@ SV_BUDGETS: do jsv = 1, ksv
tzsource%lavailable = .true.
call Budget_source_add( tbudgets(ibudget), tzsource )
+ tzsource%cmnhname = 'ADJU'
+ tzsource%clongname = 'adjustement to saturation'
+ tzsource%lavailable = hcloud(1:3) == 'ICE' .and. lred .and. ladj_before
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
tzsource%cmnhname = 'DEPS'
tzsource%clongname = 'deposition on snow'
tzsource%lavailable = .true.
@@ -3796,7 +3817,12 @@ SV_BUDGETS: do jsv = 1, ksv
tzsource%cmnhname = 'DEPI'
tzsource%clongname = 'condensation/deposition on ice'
- tzsource%lavailable = .true.
+ tzsource%lavailable = hcloud(1:3) == 'ICE' .and. (.not. lred .or. (lred .and. ladj_after))
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CEDS'
+ tzsource%clongname = 'adjustement to saturation'
+ tzsource%lavailable = hcloud == 'LIMA'
call Budget_source_add( tbudgets(ibudget), tzsource )
tzsource%cmnhname = 'NEUT'
@@ -3804,9 +3830,23 @@ SV_BUDGETS: do jsv = 1, ksv
tzsource%lavailable = .true.
call Budget_source_add( tbudgets(ibudget), tzsource )
+ tzsource%cmnhname = 'SUBI'
+ tzsource%clongname = 'sublimation of ice crystals'
+ tzsource%lavailable = hcloud == 'LIMA' .and. lptsplit
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CORR2'
+ tzsource%clongname = 'supplementary correction inside LIMA splitting'
+ tzsource%lavailable = hcloud == 'LIMA' .and. lptsplit
+ call Budget_source_add( tbudgets(ibudget), tzsource )
case ( 2 ) SV_ELEC
! volumetric charge of cloud droplets
+ tzsource%cmnhname = 'ADJU'
+ tzsource%clongname = 'adjustement to saturation'
+ tzsource%lavailable = hcloud(1:3) == 'ICE' .and. lred .and. ladj_before
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
tzsource%cmnhname = 'HON'
tzsource%clongname = 'homogeneous nucleation'
tzsource%lavailable = .true.
@@ -3864,7 +3904,12 @@ SV_BUDGETS: do jsv = 1, ksv
tzsource%cmnhname = 'DEPI'
tzsource%clongname = 'condensation/deposition on ice'
- tzsource%lavailable = .true.
+ tzsource%lavailable = hcloud(1:3) == 'ICE' .and. (.not. lred .or. (lred .and. ladj_after))
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CEDS'
+ tzsource%clongname = 'adjustement to saturation'
+ tzsource%lavailable = hcloud == 'LIMA'
call Budget_source_add( tbudgets(ibudget), tzsource )
tzsource%cmnhname = 'NEUT'
@@ -3872,6 +3917,20 @@ SV_BUDGETS: do jsv = 1, ksv
tzsource%lavailable = .true.
call Budget_source_add( tbudgets(ibudget), tzsource )
+ tzsource%cmnhname = 'R2C1'
+ tzsource%clongname = 'rain to cloud change after sedimentation'
+ tzsource%lavailable = hcloud == 'LIMA' .and. lptsplit .and. nmom_c.ge.1 .and. nmom_r.ge.1
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CORR2'
+ tzsource%clongname = 'supplementary correction inside LIMA splitting'
+ tzsource%lavailable = hcloud == 'LIMA' .and. lptsplit
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CMEL'
+ tzsource%clongname = 'collection by snow and conversion into rain with T>XTT on ice'
+ tzsource%lavailable = hcloud(1:3) == 'ICE' .and. lred
+ call Budget_source_add( tbudgets(ibudget), tzsource )
case ( 3 ) SV_ELEC
! volumetric charge of rain drops
@@ -3940,8 +3999,33 @@ SV_BUDGETS: do jsv = 1, ksv
tzsource%lavailable = .true.
call Budget_source_add( tbudgets(ibudget), tzsource )
+ tzsource%cmnhname = 'R2C1'
+ tzsource%clongname = 'rain to cloud change after sedimentation'
+ tzsource%lavailable = hcloud == 'LIMA' .and. lptsplit .and. nmom_c.ge.1 .and. nmom_r.ge.1
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CORR2'
+ tzsource%clongname = 'supplementary correction inside LIMA splitting'
+ tzsource%lavailable = hcloud == 'LIMA' .and. lptsplit
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CMEL'
+ tzsource%clongname = 'collection by snow and conversion into rain with T>XTT on ice'
+ tzsource%lavailable = hcloud(1:3) == 'ICE' .and. lred
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'RDSF'
+ tzsource%clongname = 'raindrop shattering by freezing'
+ tzsource%lavailable = hcloud == 'LIMA' .and. lptsplit .and. lrdsf
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
case ( 4 ) SV_ELEC
! volumetric charge of ice crystals
+ tzsource%cmnhname = 'ADJU'
+ tzsource%clongname = 'adjustement to saturation'
+ tzsource%lavailable = hcloud(1:3) == 'ICE' .and. lred .and. ladj_before
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
tzsource%cmnhname = 'HON'
tzsource%clongname = 'homogeneous nucleation'
tzsource%lavailable = .true.
@@ -3992,6 +4076,11 @@ SV_BUDGETS: do jsv = 1, ksv
tzsource%lavailable = .true.
call Budget_source_add( tbudgets(ibudget), tzsource )
+ tzsource%cmnhname = 'NIIG'
+ tzsource%clongname = 'non-inductive charge separation due to ice-graupel collisions'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
tzsource%cmnhname = 'SEDI'
tzsource%clongname = 'sedimentation'
tzsource%lavailable = .true.
@@ -3999,7 +4088,12 @@ SV_BUDGETS: do jsv = 1, ksv
tzsource%cmnhname = 'DEPI'
tzsource%clongname = 'condensation/deposition on ice'
- tzsource%lavailable = .true.
+ tzsource%lavailable = hcloud(1:3) == 'ICE' .and. (.not. lred .or. (lred .and. ladj_after))
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CEDS'
+ tzsource%clongname = 'adjustement to saturation'
+ tzsource%lavailable = hcloud == 'LIMA'
call Budget_source_add( tbudgets(ibudget), tzsource )
tzsource%cmnhname = 'NEUT'
@@ -4007,6 +4101,40 @@ SV_BUDGETS: do jsv = 1, ksv
tzsource%lavailable = .true.
call Budget_source_add( tbudgets(ibudget), tzsource )
+ tzsource%cmnhname = 'CNVI'
+ tzsource%clongname = 'conversion of snow to cloud ice'
+ tzsource%lavailable = hcloud == 'LIMA' .and. lptsplit
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'SUBI'
+ tzsource%clongname = 'sublimation of ice crystals'
+ tzsource%lavailable = hcloud == 'LIMA' .and. lptsplit
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'HMS'
+ tzsource%clongname = 'Hallett-Mossop ice multiplication process due to snow riming'
+ tzsource%lavailable = hcloud == 'LIMA' .and. lptsplit
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'HMG'
+ tzsource%clongname = 'Hallett-Mossop ice multiplication process due to graupel riming'
+ tzsource%lavailable = hcloud == 'LIMA' .and. lptsplit
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CIBU'
+ tzsource%clongname = 'collisional ice breakup'
+ tzsource%lavailable = hcloud == 'LIMA' .and. lptsplit .and. lcibu
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'RDSF'
+ tzsource%clongname = 'raindrop shattering by freezing'
+ tzsource%lavailable = hcloud == 'LIMA' .and. lptsplit .and. lrdsf
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CORR2'
+ tzsource%clongname = 'supplementary correction inside LIMA splitting'
+ tzsource%lavailable = hcloud == 'LIMA' .and. lptsplit
+ call Budget_source_add( tbudgets(ibudget), tzsource )
case ( 5 ) SV_ELEC
! volumetric charge of snow
@@ -4055,6 +4183,11 @@ SV_BUDGETS: do jsv = 1, ksv
tzsource%lavailable = .true.
call Budget_source_add( tbudgets(ibudget), tzsource )
+ tzsource%cmnhname = 'NISG'
+ tzsource%clongname = 'non-inductive charge separation due to snow-graupel collisions'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
tzsource%cmnhname = 'WETH'
tzsource%clongname = 'wet growth of hail'
tzsource%lavailable = hcloud == 'ICE4'
@@ -4065,6 +4198,21 @@ SV_BUDGETS: do jsv = 1, ksv
tzsource%lavailable = .true.
call Budget_source_add( tbudgets(ibudget), tzsource )
+ tzsource%cmnhname = 'CNVI'
+ tzsource%clongname = 'conversion of snow to cloud ice'
+ tzsource%lavailable = hcloud == 'LIMA' .and. lptsplit
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'HMS'
+ tzsource%clongname = 'Hallett-Mossop ice multiplication process due to snow riming'
+ tzsource%lavailable = hcloud == 'LIMA' .and. lptsplit
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CIBU'
+ tzsource%clongname = 'collisional ice breakup'
+ tzsource%lavailable = hcloud == 'LIMA' .and. lptsplit .and. lcibu
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
tzsource%cmnhname = 'NEUT'
tzsource%clongname = 'neutralization'
tzsource%lavailable = .true.
@@ -4118,6 +4266,16 @@ SV_BUDGETS: do jsv = 1, ksv
tzsource%lavailable = linductive
call Budget_source_add( tbudgets(ibudget), tzsource )
+ tzsource%cmnhname = 'NIIG'
+ tzsource%clongname = 'non-inductive charge separation due to ice-graupel collisions'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'NISG'
+ tzsource%clongname = 'non-inductive charge separation due to snow-graupel collisions'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
tzsource%cmnhname = 'GMLT'
tzsource%clongname = 'graupel melting'
tzsource%lavailable = .true.
@@ -4133,6 +4291,11 @@ SV_BUDGETS: do jsv = 1, ksv
tzsource%lavailable = .true.
call Budget_source_add( tbudgets(ibudget), tzsource )
+ tzsource%cmnhname = 'HMG'
+ tzsource%clongname = 'Hallett-Mossop ice multiplication process due to graupel riming'
+ tzsource%lavailable = hcloud == 'LIMA' .and. lptsplit
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
tzsource%cmnhname = 'NEUT'
tzsource%clongname = 'neutralization'
tzsource%lavailable = .true.
@@ -4140,7 +4303,8 @@ SV_BUDGETS: do jsv = 1, ksv
case ( 7: ) SV_ELEC
- if ( ( hcloud == 'ICE4' .and. ( jsv - nsv_elecbeg + 1 ) == 7 ) ) then
+ if ( ( ( hcloud == 'ICE4' .or. (hcloud == 'LIMA' .and. nmom_h.ge.1) ) .and. &
+ ( jsv - nsv_elecbeg + 1 ) == 7 ) ) then
! volumetric charge of hail
tzsource%cmnhname = 'WETG'
tzsource%clongname = 'wet growth of graupel'
@@ -4167,8 +4331,10 @@ SV_BUDGETS: do jsv = 1, ksv
tzsource%lavailable = .true.
call Budget_source_add( tbudgets(ibudget), tzsource )
- else if ( ( hcloud == 'ICE3' .and. ( jsv - nsv_elecbeg + 1 ) == 7 ) &
- .or. ( hcloud == 'ICE4' .and. ( jsv - nsv_elecbeg + 1 ) == 8 ) ) then
+ else if ( ( ( hcloud == 'ICE3' .or. ( hcloud == 'LIMA' .and. nmom_h.eq.0 ) ) .and. &
+ ( jsv - nsv_elecbeg + 1 ) == 7 ) .or. &
+ ( ( hcloud == 'ICE4' .or. ( hcloud == 'LIMA' .and. nmom_h.ge.1 ) ) .and. &
+ ( jsv - nsv_elecbeg + 1 ) == 8 ) ) then
! Negative ions (NSV_ELECEND case)
tzsource%cmnhname = 'DRIFT'
tzsource%clongname = 'ion drift motion'
@@ -4180,6 +4346,11 @@ SV_BUDGETS: do jsv = 1, ksv
tzsource%lavailable = .true.
call Budget_source_add( tbudgets(ibudget), tzsource )
+ tzsource%cmnhname = 'ADJU'
+ tzsource%clongname = 'adjustement to saturation'
+ tzsource%lavailable = hcloud(1:3) == 'ICE' .and. lred .and. ladj_before
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
tzsource%cmnhname = 'DEPS'
tzsource%clongname = 'deposition on snow'
tzsource%lavailable = .true.
@@ -4197,7 +4368,12 @@ SV_BUDGETS: do jsv = 1, ksv
tzsource%cmnhname = 'DEPI'
tzsource%clongname = 'condensation/deposition on ice'
- tzsource%lavailable = .true.
+ tzsource%lavailable = hcloud(1:3) == 'ICE' .and. (.not. lred .or. (lred .and. ladj_after))
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CEDS'
+ tzsource%clongname = 'adjustement to saturation'
+ tzsource%lavailable = hcloud == 'LIMA'
call Budget_source_add( tbudgets(ibudget), tzsource )
tzsource%cmnhname = 'NEUT'
@@ -4205,6 +4381,16 @@ SV_BUDGETS: do jsv = 1, ksv
tzsource%lavailable = .true.
call Budget_source_add( tbudgets(ibudget), tzsource )
+ tzsource%cmnhname = 'SUBI'
+ tzsource%clongname = 'sublimation of ice crystals'
+ tzsource%lavailable = hcloud == 'LIMA' .and. lptsplit
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CORR2'
+ tzsource%clongname = 'supplementary correction inside LIMA splitting'
+ tzsource%lavailable = hcloud == 'LIMA' .and. lptsplit
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
else
call Print_msg( NVERB_FATAL, 'BUD', 'Ini_budget', 'unknown electricity budget' )
end if
diff --git a/src/MNH/ini_elecn.f90 b/src/MNH/ini_elecn.f90
index e00ea14d3a6f0eff266625c09fc945a1c7805d80..25a77068dee77613a87024b79cee6c2ee848cb91 100644
--- a/src/MNH/ini_elecn.f90
+++ b/src/MNH/ini_elecn.f90
@@ -74,40 +74,44 @@ END MODULE MODI_INI_ELEC_n
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
! P. Wautelet 14/02/2019: remove CLUOUT/CLUOUT0 and associated variables
! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
+!! C. Barthe 04/02/22 Remove call to ini_rain_ice_elec
+!! Initialization of cloud microphysics and cloud electricity
+!! is now done separately
+!! C. Barthe 07/07/23 New data structures for some variables
!!
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_CLOUDPAR_n, ONLY : NSPLITR
-USE MODD_CONF, ONLY : CEQNSYS,CCONF,CPROGRAM
-USE MODD_CONF_n, ONLY : NRR
+USE MODD_CLOUDPAR_n, ONLY: NSPLITR
+USE MODD_CONF, ONLY: CEQNSYS, CCONF, CPROGRAM
+USE MODD_CONF_n, ONLY: NRR
USE MODD_CST
-USE MODD_DIM_n, ONLY : NIMAX_ll, NJMAX_ll
+USE MODD_DIM_n, ONLY: NIMAX_ll, NJMAX_ll
USE MODD_DYN
-USE MODD_DYN_n, ONLY : XRHOM, XTRIGSX, XTRIGSY, XAF, XCF, XBFY, XBFB, XDXHATM, &
- XDYHATM, NIFAXX, NIFAXY, XBF_SXP2_YP1_Z
+USE MODD_DYN_n, ONLY: XRHOM, XTRIGSX, XTRIGSY, XAF, XCF, XBFY, XBFB, XDXHATM, &
+ XDYHATM, NIFAXX, NIFAXY, XBF_SXP2_YP1_Z
USE MODD_ELEC_DESCR
+USE MODD_ELEC_PARAM
USE MODD_ELEC_FLASH
-USE MODD_ELEC_n, ONLY : XRHOM_E, XAF_E, XCF_E, XBFY_E, XBFB_E, XBF_SXP2_YP1_Z_E
-USE MODD_GET_n, ONLY : CGETINPRC, CGETINPRR, CGETINPRS, CGETINPRG, CGETINPRH, &
- CGETCLOUD, CGETSVT
-USE MODD_GRID_n, ONLY : XMAP, XDXHAT, XDYHAT
-USE MODD_IO, ONLY : TFILEDATA
-USE MODD_LBC_n, ONLY : CLBCX, CLBCY
-USE MODD_LUNIT_n, ONLY: TLUOUT
-USE MODD_PARAM_C2R2, ONLY : LDEPOC
-USE MODD_PARAMETERS, ONLY : JPVEXT, JPHEXT
-USE MODD_PARAM_ICE_n, ONLY : LDEPOSC
-USE MODD_PRECIP_n, ONLY : XINPRR, XACPRR, XINPRS, XACPRS, XINPRG, XACPRG, &
- XINPRH, XACPRH, XINPRC, XACPRC, XINPRR3D, XEVAP3D,&
- XINDEP,XACDEP
+USE MODD_ELEC_n, ONLY: XRHOM_E, XAF_E, XCF_E, XBFY_E, XBFB_E, XBF_SXP2_YP1_Z_E
+USE MODD_GET_n, ONLY: CGETSVT, CGETINPRC, CGETINPRR, CGETINPRS, CGETINPRG, CGETINPRH, &
+ CGETCLOUD
+USE MODD_GRID_n, ONLY: XMAP, XDXHAT, XDYHAT
+USE MODD_IO, ONLY: TFILEDATA
+USE MODD_LBC_n, ONLY: CLBCX, CLBCY
+USE MODD_LUNIT_n, ONLY: TLUOUT
+USE MODD_PARAMETERS, ONLY: JPVEXT, JPHEXT
+USE MODD_PARAM_ICE_n,ONLY : LDEPOSC, LRED
+USE MODD_PRECIP_n, ONLY : XINPRR, XACPRR, XINPRS, XACPRS, XINPRG, XACPRG, &
+ XINPRH, XACPRH, XINPRC, XACPRC, XINPRR3D, XEVAP3D,&
+ XINDEP,XACDEP
USE MODD_REF
-USE MODD_REF_n, ONLY : XRHODJ, XTHVREF
+USE MODD_REF_n, ONLY: XRHODJ, XTHVREF
USE MODD_TIME
!
-USE MODD_ARGSLIST_ll, ONLY : LIST_ll
+USE MODD_ARGSLIST_ll, ONLY: LIST_ll
USE MODE_ll
use mode_msg
!
@@ -149,137 +153,121 @@ INTEGER :: JK ! Loop vertical index
INTEGER :: IINFO_ll ! Return code of // routines
INTEGER :: IINTVL ! Number of intervals to integrate the kernels
REAL :: ZFDINFTY ! Factor used to define the "infinite" diameter
-!
-REAL :: ZRHO00 ! Surface reference air density
-REAL :: ZDZMIN
+REAL :: ZRHO00 ! Surface reference air density
+REAL :: ZDZMIN
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZDZ ! mesh size
CHARACTER (LEN=3) :: YEQNSYS
!
!
!-------------------------------------------------------------------------------
!
-!* 0. PROLOGUE
+!* 1. PROLOGUE
! --------
!
ILUOUT = TLUOUT%NLU
!
CALL GET_DIM_EXT_ll('B',IIU,IJU)
IKU = SIZE(PZZ,3)
+IKB = 1 + JPVEXT
+IKE = SIZE(PZZ,3) - JPVEXT
!
-!-------------------------------------------------------------------------------
-!
-!* 1. ALLOCATE Module MODD_PRECIP_n
-! -----------------------------
-!
-IF (HCLOUD(1:3) == 'ICE') THEN
- ALLOCATE( XINPRR(IIU,IJU) )
- ALLOCATE( XINPRR3D(IIU,IJU,IKU) )
- ALLOCATE( XEVAP3D(IIU,IJU,IKU) )
- ALLOCATE( XACPRR(IIU,IJU) )
- XINPRR(:,:) = 0.0
- XACPRR(:,:) = 0.0
- XINPRR3D(:,:,:) = 0.0
- XEVAP3D(:,:,:) = 0.0
- ALLOCATE( XINPRC(IIU,IJU) )
- ALLOCATE( XACPRC(IIU,IJU) )
- XINPRC(:,:) = 0.0
- XACPRC(:,:) = 0.0
- ALLOCATE( XINPRS(IIU,IJU) )
- ALLOCATE( XACPRS(IIU,IJU) )
- XINPRS(:,:) = 0.0
- XACPRS(:,:) = 0.0
- ALLOCATE( XINPRG(IIU,IJU) )
- ALLOCATE( XACPRG(IIU,IJU) )
- XINPRG(:,:) = 0.0
- XACPRG(:,:) = 0.0
-END IF
-!
-IF (HCLOUD == 'ICE4') THEN
- ALLOCATE( XINPRH(IIU,IJU) )
- ALLOCATE( XACPRH(IIU,IJU) )
- XINPRH(:,:) = 0.0
- XACPRH(:,:) = 0.0
-ELSE
- ALLOCATE( XINPRH(0,0) )
- ALLOCATE( XACPRH(0,0) )
-END IF
-!
-IF ( LDEPOSC) THEN
- ALLOCATE(XINDEP(IIU,IJU))
- ALLOCATE(XACDEP(IIU,IJU))
- XINDEP(:,:)=0.0
- XACDEP(:,:)=0.0
-ELSE
- ALLOCATE(XINDEP(0,0))
- ALLOCATE(XACDEP(0,0))
-END IF
-!
-IF(SIZE(XINPRR) == 0) RETURN
-!
+IF (.NOT.ASSOCIATED(XFCI)) CALL ELEC_PARAM_ASSOCIATE()
+IF (.NOT.ASSOCIATED(XFC)) CALL ELEC_DESCR_ASSOCIATE()
!
!-------------------------------------------------------------------------------
+!++cb++ 26/04/2023 this part is needed to run the old version of the electrical scheme
+! --> use of rain_ice_elec
+! --> should be removed when the new scheme is fully validated
+!
+!* 2. INITIALIZE THE PARAMETERS FOR THE MICROPHYSICS AND THE ELECTRICITY
+!* IN THE "OLD" ELECTRICAL SCHEME
+! ------------------------------------------------------------------
+!
+!* 2.1 Allocate module modd_precip_n
+!
+IF (HELEC == 'ELE3' .AND. (HCLOUD(1:3) == 'ICE' .AND. .NOT.(LRED))) THEN
+ ALLOCATE( XINPRR(IIU,IJU) ) ; XINPRR(:,:) = 0.0
+ ALLOCATE( XINPRR3D(IIU,IJU,IKU) ) ; XACPRR(:,:) = 0.0
+ ALLOCATE( XEVAP3D(IIU,IJU,IKU) ) ; XINPRR3D(:,:,:) = 0.0
+ ALLOCATE( XACPRR(IIU,IJU) ) ; XEVAP3D(:,:,:) = 0.0
+ ALLOCATE( XINPRC(IIU,IJU) ) ; XINPRC(:,:) = 0.0
+ ALLOCATE( XACPRC(IIU,IJU) ) ; XACPRC(:,:) = 0.0
+ ALLOCATE( XINPRS(IIU,IJU) ) ; XINPRS(:,:) = 0.0
+ ALLOCATE( XACPRS(IIU,IJU) ) ; XACPRS(:,:) = 0.0
+ ALLOCATE( XINPRG(IIU,IJU) ) ; XINPRG(:,:) = 0.0
+ ALLOCATE( XACPRG(IIU,IJU) ) ; XACPRG(:,:) = 0.0
+!
+ IF (HCLOUD == 'ICE4') THEN
+ ALLOCATE( XINPRH(IIU,IJU) ) ; XINPRH(:,:) = 0.0
+ ALLOCATE( XACPRH(IIU,IJU) ) ; XACPRH(:,:) = 0.0
+ ELSE
+ ALLOCATE( XINPRH(0,0) )
+ ALLOCATE( XACPRH(0,0) )
+ END IF
!
-!* 2. Initialize MODD_PRECIP_n variables
-! -----------------------------------
+ IF ( LDEPOSC) THEN
+ ALLOCATE(XINDEP(IIU,IJU)) ; XINDEP(:,:) = 0.0
+ ALLOCATE(XACDEP(IIU,IJU)) ; XACDEP(:,:) = 0.0
+ ELSE
+ ALLOCATE(XINDEP(0,0))
+ ALLOCATE(XACDEP(0,0))
+ END IF
!
-CALL READ_PRECIP_FIELD (TPINIFILE, CPROGRAM, CCONF, &
- CGETINPRC,CGETINPRR,CGETINPRS,CGETINPRG,CGETINPRH, &
- XINPRC,XACPRC,XINDEP,XACDEP,XINPRR,XINPRR3D,XEVAP3D, &
- XACPRR, XINPRS, XACPRS, XINPRG, XACPRG, XINPRH, XACPRH)
+ IF(SIZE(XINPRR) == 0) RETURN
!
+!* 2.2 Initialize modd_precip_n variables
!
-!-------------------------------------------------------------------------------
+ CALL READ_PRECIP_FIELD (TPINIFILE, CPROGRAM, CCONF, &
+ CGETINPRC,CGETINPRR,CGETINPRS,CGETINPRG,CGETINPRH, &
+ XINPRC,XACPRC,XINDEP,XACDEP,XINPRR,XINPRR3D,XEVAP3D, &
+ XACPRR, XINPRS, XACPRS, XINPRG, XACPRG, XINPRH, XACPRH)
!
-!* 3. INITIALIZE THE PARAMETERS
-!* FOR THE MICROPHYSICS AND THE ELECTRICITY
-! ----------------------------------------
+!* 2.3 Initialize the parameters for the microphysics and the electrification
!
-!* 3.1 Compute the minimun vertical mesh size
+! Compute the minimun vertical mesh size
+ ALLOCATE( ZDZ(IIU,IJU,IKU) )
+ ZDZ(:,:,:) = 0.
!
-ALLOCATE( ZDZ(IIU,IJU,IKU) )
-ZDZ(:,:,:) = 0.
+ DO JK = IKB, IKE
+ ZDZ(:,:,JK) = PZZ(:,:,JK+1) - PZZ(:,:,JK)
+ END DO
+ ZDZMIN = MIN_ll (ZDZ,IINFO_ll,1,1,IKB,NIMAX_ll+2*JPHEXT,NJMAX_ll+2*JPHEXT,IKE )
!
-IKB = 1 + JPVEXT
-IKE = SIZE(PZZ,3) - JPVEXT
+ DEALLOCATE(ZDZ)
!
-DO JK = IKB, IKE
- ZDZ(:,:,JK) = PZZ(:,:,JK+1) - PZZ(:,:,JK)
-END DO
-ZDZMIN = MIN_ll (ZDZ,IINFO_ll,1,1,IKB,NIMAX_ll+2*JPHEXT,NJMAX_ll+2*JPHEXT,IKE )
+! initialize the parameters for the mixed-phase microphysics and the electrification
+ CALL INI_RAIN_ICE_ELEC (KLUOUT, PTSTEP, ZDZMIN, NSPLITR, HCLOUD, &
+ IINTVL, ZFDINFTY)
+END IF
!
-DEALLOCATE(ZDZ)
+!--cb--
+!-------------------------------------------------------------------------------
!
+!* 2. INITIALIZE THE PARAMETERS FOR THE ELECTRICITY
+! ---------------------------------------------
!
IF (HELEC(1:3) == 'ELE') THEN
!
-!
-!* 3.2 initialize the parameters for the mixed-phase microphysics
-!* and the electrification
-!
- CALL INI_RAIN_ICE_ELEC (KLUOUT, PTSTEP, ZDZMIN, NSPLITR, HCLOUD, &
- IINTVL, ZFDINFTY)
-!
-!
-!* 3.3 initialize the electrical parameters
+!* 2.1 Initialize the electrical parameters for cloud electrification
!
ZRHO00 = XP00 / (XRD * XTHVREFZ(IKB))
!
- CALL INI_PARAM_ELEC (TPINIFILE, CGETSVT, ZRHO00, NRR, IINTVL, &
- ZFDINFTY, IIU, IJU, IKU)
+ CALL INI_PARAM_ELEC (TPINIFILE, CGETSVT, HCLOUD, HELEC, &
+ ZRHO00, NRR, IIU, IJU, IKU)
!
!
-!* 3.4 initialize the parameters for the electric field
+!* 2.2 Initialize the parameters for the electric field
!
IF (LINDUCTIVE .OR. ((.NOT. LOCG) .AND. LELEC_FIELD)) THEN
CALL INI_FIELD_ELEC (PDXX, PDYY, PDZZ, PDZX, PDZY, PZZ)
END IF
!
!
-!* 3.5 initialize the parameters for the lightning flashes
+!* 2.3 Initialize the parameters for the lightning flashes
!
IF (.NOT. LOCG) THEN
IF (LFLASH_GEOM) THEN
- CALL INI_FLASH_GEOM_ELEC
+ CALL INI_FLASH_GEOM_ELEC (HCLOUD)
ELSE
call Print_msg( NVERB_FATAL, 'GEN', 'INI_ELEC_n', 'INI_LIGHTNING_ELEC not yet developed' )
END IF
@@ -289,13 +277,14 @@ ELSE IF (HELEC /= 'NONE') THEN
call Print_msg( NVERB_FATAL, 'GEN', 'INI_ELEC_n', 'not yet developed for CELEC='//trim(HELEC) )
END IF
!
-!* 3.6 initialize the parameters for the resolution of the electric field
+!
+!* 2.4 Initialize the parameters for the resolution of the electric field
!
YEQNSYS = CEQNSYS
CEQNSYS = 'LHE'
! Force any CEQNSYS (DUR, MAE, LHE) to LHE to obtain a unique set of coefficients
! for the flat laplacian operator and Return to the original CEQNSYS
-
+!
ALLOCATE (XRHOM_E(SIZE(XRHOM)))
ALLOCATE (XAF_E(SIZE(XAF)))
ALLOCATE (XCF_E(SIZE(XCF)))
@@ -304,15 +293,16 @@ ALLOCATE (XBFB_E(SIZE(XBFB,1),SIZE(XBFB,2),SIZE(XBFB,3)))
ALLOCATE (XBF_SXP2_YP1_Z_E(SIZE(XBF_SXP2_YP1_Z,1),SIZE(XBF_SXP2_YP1_Z,2),&
SIZE(XBF_SXP2_YP1_Z,3)))
!
-CALL ELEC_TRIDZ (CLBCX,CLBCY, &
- XMAP,XDXHAT,XDYHAT,XDXHATM,XDYHATM,XRHOM_E,XAF_E, &
- XCF_E,XTRIGSX,XTRIGSY,NIFAXX,NIFAXY, &
- XRHODJ,XTHVREF,PZZ,XBFY_E,XEPOTFW_TOP, &
- XBFB_E,XBF_SXP2_YP1_Z_E)
+CALL ELEC_TRIDZ (CLBCX, CLBCY, &
+ XMAP, XDXHAT, XDYHAT, XDXHATM, XDYHATM, XRHOM_E, XAF_E, &
+ XCF_E, XTRIGSX, XTRIGSY, NIFAXX, NIFAXY, &
+ XRHODJ, XTHVREF, PZZ, XBFY_E, XEPOTFW_TOP, &
+ XBFB_E, XBF_SXP2_YP1_Z_E)
!
-CEQNSYS=YEQNSYS
+CEQNSYS = YEQNSYS
!
-!* 3.7 initialize the flash maps
+!
+!* 2.5 Initialize the flash maps
!
ALLOCATE( NMAP_TRIG_IC(IIU,IJU) ); NMAP_TRIG_IC(:,:) = 0
ALLOCATE( NMAP_IMPACT_CG(IIU,IJU) ); NMAP_IMPACT_CG(:,:) = 0
@@ -322,6 +312,5 @@ ALLOCATE( NMAP_3DIC(IIU,IJU,IKU) ); NMAP_3DIC(:,:,:) = 0
ALLOCATE( NMAP_3DCG(IIU,IJU,IKU) ); NMAP_3DCG(:,:,:) = 0
!
!-------------------------------------------------------------------------------
-!
!
END SUBROUTINE INI_ELEC_n
diff --git a/src/MNH/ini_flash_geom_elec.f90 b/src/MNH/ini_flash_geom_elec.f90
index 3c5faece3492d78a958b5bfe54b815164611abde..e543b5ca95a9e6419e3f8278622c7ce3a331b107 100644
--- a/src/MNH/ini_flash_geom_elec.f90
+++ b/src/MNH/ini_flash_geom_elec.f90
@@ -8,15 +8,17 @@
!
INTERFACE
!
- SUBROUTINE INI_FLASH_GEOM_ELEC
+ SUBROUTINE INI_FLASH_GEOM_ELEC (HCLOUD)
+!
+CHARACTER(LEN=4), INTENT(IN) :: HCLOUD ! microphysics scheme
!
END SUBROUTINE INI_FLASH_GEOM_ELEC
END INTERFACE
END MODULE MODI_INI_FLASH_GEOM_ELEC
!
-! ##############################
- SUBROUTINE INI_FLASH_GEOM_ELEC
-! ##############################
+! #######################################
+ SUBROUTINE INI_FLASH_GEOM_ELEC (HCLOUD)
+! #######################################
!
!!**** *INI_FLASH_GEOM_ELEC* - routine to initialize the lightning flashes
!!
@@ -48,6 +50,8 @@ END MODULE MODI_INI_FLASH_GEOM_ELEC
!! Modifications
!! J.-P. Pinty jan 2015 : add LMA simulator
!! J.Escobar 20/06/2018 : truly set NBRANCH_MAX = 5000 !
+!! C. Barthe 30/11/2022 : add parameters for LIMA
+!! C. Barthe 11/09/2023 : modify some parameters to use with LIMA2
!!
!-------------------------------------------------------------------------------
!
@@ -55,7 +59,18 @@ END MODULE MODI_INI_FLASH_GEOM_ELEC
! ------------
!
USE MODD_CST, ONLY : XPI
-USE MODD_RAIN_ICE_DESCR_n
+USE MODD_RAIN_ICE_DESCR_n,ONLY : XALPHAR_I=>XALPHAR, XNUR_I=>XNUR, XCCR, &
+ XALPHAI_I=>XALPHAI, XNUI_I=>XNUI, XAI_I=>XAI, XBI_I=>XBI, &
+ XALPHAS_I=>XALPHAS, XNUS_I=>XNUS, XCCS_I=>XCCS, XCXS_I=>XCXS, &
+ XALPHAG_I=>XALPHAG, XNUG_I=>XNUG, XCCG_I=>XCCG, XCXG_I=>XCXG, &
+ XALPHAH_I=>XALPHAH, XNUH_I=>XNUH, XCCH_I=>XCCH, XCXH_I=>XCXH
+USE MODD_PARAM_LIMA, ONLY : XALPHAC, XNUC, &
+ XALPHAR_L=>XALPHAR, XNUR_L=>XNUR, XALPHAI_L=>XALPHAI, XNUI_L=>XNUI, &
+ XALPHAS_L=>XALPHAS, XNUS_L=>XNUS, XALPHAG_L=>XALPHAG, XNUG_L=>XNUG, &
+ NMOM_S, NMOM_G, NMOM_H
+USE MODD_PARAM_LIMA_COLD, ONLY : XAI_L=>XAI, XBI_L=>XBI, XCCS_L=>XCCS, XCXS_L=>XCXS
+USE MODD_PARAM_LIMA_MIXED,ONLY : XCCG_L=>XCCG, XCXG_L=>XCXG, &
+ XCCH_L=>XCCH, XCXH_L=>XCXH, XALPHAH_L=>XALPHAH, XNUH_L=>XNUH
USE MODD_ELEC_DESCR
USE MODD_ELEC_PARAM
USE MODD_DIM_n, ONLY : NKMAX
@@ -68,34 +83,132 @@ IMPLICIT NONE
!
!* 0.1 Declaration of dummy arguments
!
+CHARACTER(LEN=4), INTENT(IN) :: HCLOUD ! microphysics scheme
!
-!* 0.2 Declaration of local variables
-!
-!
-!----------------------------------------------------------------------------
!
-!* 1. SOME CONSTANTS FOR NEUTRALIZATION
-! ---------------------------------
+!* 0.2 Declaration of local variables
!
-XFQLIGHTC = 660. * MOMG(3.,3.,2.) / MOMG(3.,3.,3.) ! PI/A*lbda^(b-2) = 660.
+! variables used to cope with the module variables common to icex and lima
+REAL :: ZALPHAR, ZNUR, &
+ ZAI, ZBI, ZALPHAI, ZNUI, &
+ ZCCS, ZCXS, ZALPHAS, ZNUS, &
+ ZCCG, ZCXG, ZALPHAG, ZNUG, &
+ ZCCH, ZCXH, ZALPHAH, ZNUH
!
-XFQLIGHTR = XPI * XCCR * MOMG(XALPHAR,XNUR,2.)
-XEXQLIGHTR = XCXR - 2.
+!-------------------------------------------------------------------------------
!
-XEXQLIGHTI = 2. / XBI
-XFQLIGHTI = XPI / 4. * MOMG(XALPHAI,XNUI,2.) * &
- (XAI * MOMG(XALPHAI,XNUI,XBI))**(-XEXQLIGHTI)
+!* 1. PRELIMINARIES
+! -------------
+!
+!* 1.1 Address module variables common to ICEx and LIMA
+!
+IF (HCLOUD(1:3) == 'ICE') THEN
+ ZALPHAR = XALPHAR_I
+ ZNUR = XNUR_I
+ !
+ ZAI = XAI_I
+ ZBI = XBI_I
+ ZALPHAI = XALPHAI_I
+ ZNUI = XNUI_I
+ !
+ ZCCS = XCCS_I
+ ZCXS = XCXS_I
+ ZALPHAS = XALPHAS_I
+ ZNUS = XNUS_I
+ !
+ ZCCG = XCCG_I
+ ZCXG = XCXG_I
+ ZALPHAG = XALPHAG_I
+ ZNUG = XNUG_I
+ !
+ ZCCH = XCCH_I
+ ZCXH = XCXH_I
+ ZALPHAH = XALPHAH_I
+ ZNUH = XNUH_I
+ !
+ELSE IF (HCLOUD == 'LIMA') THEN
+ ZALPHAR = XALPHAR_L
+ ZNUR = XNUR_L
+ !
+ ZAI = XAI_L
+ ZBI = XBI_L
+ ZALPHAI = XALPHAI_L
+ ZNUI = XNUI_L
+ !
+ ZCCS = XCCS_L
+ ZCXS = XCXS_L
+ ZALPHAS = XALPHAS_L
+ ZNUS = XNUS_L
+ !
+ ZCCG = XCCG_L
+ ZCXG = XCXG_L
+ ZALPHAG = XALPHAG_L
+ ZNUG = XNUG_L
+ !
+ ZCCH = XCCH_L
+ ZCXH = XCXH_L
+ ZALPHAH = XALPHAH_L
+ ZNUH = XNUH_L
+END IF
!
-XFQLIGHTS = XPI * XCCS * MOMG(XALPHAS,XNUS,2.)
-XEXQLIGHTS = XCXS - 2.
+!-------------------------------------------------------------------------------
!
-XFQLIGHTG = XPI * XCCG * MOMG(XALPHAG,XNUG,2.)
-XEXQLIGHTG = XCXG - 2.
+!* 2. SOME CONSTANTS FOR NEUTRALIZATION
+! ---------------------------------
!
+IF (HCLOUD(1:3) == 'ICE') THEN
+ XFQLIGHTC = 660. * MOMG(3.,3.,2.) / MOMG(3.,3.,3.) ! PI/A*lbda^(b-2) = 660.
+ELSE IF (HCLOUD == 'LIMA') THEN
+ XFQLIGHTC = XPI * MOMG(XALPHAC,XNUC,2.)
+END IF
+!
+IF (HCLOUD(1:3) == 'ICE') THEN
+ XFQLIGHTR = XPI * XCCR * MOMG(ZALPHAR,ZNUR,2.)
+ XEXQLIGHTR = XCXR - 2.
+ELSE IF (HCLOUD == 'LIMA') THEN
+ XFQLIGHTR = XPI * MOMG(ZALPHAR,ZNUR,2.)
+ XEXQLIGHTR = -2.
+END IF
+!
+XEXQLIGHTI = 2. / ZBI
+XFQLIGHTI = XPI / 4. * MOMG(ZALPHAI,ZNUI,2.) * &
+ (ZAI * MOMG(ZALPHAI,ZNUI,ZBI))**(-XEXQLIGHTI)
+!
+IF (HCLOUD(1:3) == 'ICE' .OR. &
+ (HCLOUD == 'LIMA' .AND. NMOM_S == 1)) THEN
+ XFQLIGHTS = XPI * ZCCS * MOMG(ZALPHAS,ZNUS,2.)
+ XEXQLIGHTS = ZCXS - 2.
+ELSE IF (HCLOUD == 'LIMA' .AND. NMOM_S == 2) THEN
+ XFQLIGHTS = XPI * MOMG(ZALPHAS,ZNUS,2.)
+ XEXQLIGHTS = -2.
+END IF
+!
+IF (HCLOUD(1:3) == 'ICE' .OR. &
+ (HCLOUD == 'LIMA' .AND. NMOM_G == 1)) THEN
+ XFQLIGHTG = XPI * ZCCG * MOMG(ZALPHAG,ZNUG,2.)
+ XEXQLIGHTG = ZCXG - 2.
+ELSE IF (HCLOUD == 'LIMA' .AND. NMOM_G == 2) THEN
+ XFQLIGHTG = XPI * MOMG(ZALPHAG,ZNUG,2.)
+ XEXQLIGHTG = -2.
+END IF
+!
+IF (HCLOUD(1:3) == 'ICE' .OR. &
+ (HCLOUD == 'LIMA' .AND. NMOM_H == 1)) THEN
+ XFQLIGHTH = XPI * ZCCH * MOMG(ZALPHAH,ZNUH,2.)
+ XEXQLIGHTH = ZCXH - 2.
+ELSE IF (HCLOUD == 'LIMA' .AND. NMOM_H == 2) THEN
+ XFQLIGHTH = XPI * MOMG(ZALPHAH,ZNUH,2.)
+ XEXQLIGHTH = -2.
+END IF
+!
+IF( .NOT.ALLOCATED(XNEUT_POS)) ALLOCATE( XNEUT_POS(NLGHTMAX) )
+IF( .NOT.ALLOCATED(XNEUT_NEG)) ALLOCATE( XNEUT_NEG(NLGHTMAX) )
+XNEUT_POS(:) = 0.
+XNEUT_NEG(:) = 0.
!
!----------------------------------------------------------------------------
!
-!* 2. INITIALIZE SOME THRESHOLDS
+!* 3. INITIALIZE SOME THRESHOLDS
! --------------------------
!
! electric field threshold for cell detection
diff --git a/src/MNH/ini_micron.f90 b/src/MNH/ini_micron.f90
index a4934ed55d020c7cdee8d443fa663083e790f54d..091b69f685fdca492605011e460cab3b1a783a07 100644
--- a/src/MNH/ini_micron.f90
+++ b/src/MNH/ini_micron.f90
@@ -314,14 +314,4 @@ IF (CCLOUD == 'LIMA') THEN
END IF
!
!
-!* 5. INITIALIZE ATMOSPHERIC ELECTRICITY
-! ----------------------------------
-!
-!
-!IF (CELEC /= 'NONE') THEN
-! CALL INI_ELEC(IMI,TPINIFILE,XTSTEP,ZDZMIN,NSPLITR, &
-! XDXX,XDYY,XDZZ,XDZX,XDZY )
-!END IF
-!
-!
END SUBROUTINE INI_MICRO_n
diff --git a/src/MNH/ini_modeln.f90 b/src/MNH/ini_modeln.f90
index f1b7d80691b9cfcba7d1951f2fd54abace79fd96..1ac91c3c2b8247c3fc48d6a176358570238f22db 100644
--- a/src/MNH/ini_modeln.f90
+++ b/src/MNH/ini_modeln.f90
@@ -295,7 +295,8 @@ END MODULE MODI_INI_MODEL_n
! J.L.Redelsperger 06/2011: OCEAN case
! R. Schoetter 12/2021 multi-level coupling between MesoNH and SURFEX
! R. Schoetter 12/2021 adds humidity and other mean diagnostics
-! A. Costes 12/2021: Blaze fire model
+! A. Costes 12/2021: Blaze fire model
+! C. Barthe 03/2023: if cloud electricity is activated, both ini_micron and ini_elecn are called
!---------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -2220,15 +2221,14 @@ END IF
!* 12. INITIALIZE THE MICROPHYSICS
! ----------------------------
!
-IF (CELEC == 'NONE') THEN
- CALL INI_MICRO_n(TPINIFILE,ILUOUT)
+CALL INI_MICRO_n(TPINIFILE,ILUOUT)
!
!-------------------------------------------------------------------------------
!
!* 13. INITIALIZE THE ATMOSPHERIC ELECTRICITY
! --------------------------------------
!
-ELSE
+IF (CELEC /= 'NONE') THEN
CALL INI_ELEC_n(ILUOUT, CELEC, CCLOUD, TPINIFILE, &
XTSTEP, XZZ, &
XDXX, XDYY, XDZZ, XDZX, XDZY )
@@ -2237,16 +2237,16 @@ ELSE
FMT='(/,"ELECTRIC VARIABLES ARE BETWEEN INDEX",I2," AND ",I2)')&
NSV_ELECBEG, NSV_ELECEND
!
- IF( CGETSVT(NSV_ELECBEG)=='INIT' ) THEN
- XSVT(:,:,:,NSV_ELECBEG) = XCION_POS_FW(:,:,:) ! Nb/kg
- XSVT(:,:,:,NSV_ELECEND) = XCION_NEG_FW(:,:,:)
+ IF( CGETSVT(NSV_ELECBEG)=='INIT' ) THEN
+ XSVT(:,:,:,NSV_ELECBEG) = XCION_POS_FW(:,:,:) ! Nb/kg
+ XSVT(:,:,:,NSV_ELECEND) = XCION_NEG_FW(:,:,:)
!
- XSVT(:,:,:,NSV_ELECBEG+1:NSV_ELECEND-1) = 0.0
- ELSE ! Convert elec_variables per m3 into elec_variables per kg of air
- DO JSV = NSV_ELECBEG, NSV_ELECEND
- XSVT(:,:,:,JSV) = XSVT(:,:,:,JSV) / XRHODREF(:,:,:)
- ENDDO
- END IF
+ XSVT(:,:,:,NSV_ELECBEG+1:NSV_ELECEND-1) = 0.0
+ ELSE ! Convert elec_variables per m3 into elec_variables per kg of air
+ DO JSV = NSV_ELECBEG, NSV_ELECEND
+ XSVT(:,:,:,JSV) = XSVT(:,:,:,JSV) / XRHODREF(:,:,:)
+ ENDDO
+ END IF
END IF
!
!-------------------------------------------------------------------------------
diff --git a/src/MNH/ini_nsv.f90 b/src/MNH/ini_nsv.f90
index 0d7358737ad6b6fbc37b3254fb5867691b27b86d..9c0ad2bd3bb4322ca79f32bb78447c6ba673c50a 100644
--- a/src/MNH/ini_nsv.f90
+++ b/src/MNH/ini_nsv.f90
@@ -73,6 +73,9 @@ END MODULE MODI_INI_NSV
! A. Costes 12/2021: smoke tracer for fire model
! P. Wautelet 14/01/2022: add CSV_CHEM_LIST(_A) to store the list of all chemical variables
! + NSV_CHEM_LIST(_A) the size of the list
+! C. Barthe 09/2022: enable CELLS to be used with LIMA
+! C. Barthe 09/2023: move CELLS variables initialization after aerosols initialization to avoid
+! problems when using LIMA+ORILAM+CELLS in resolved_cloud
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -112,7 +115,8 @@ USE MODD_LUNIT_n, ONLY: TLUOUT
USE MODD_NSV
USE MODD_PARAM_C2R2, ONLY: LSUPSAT
USE MODD_PARAMETERS, ONLY: NCOMMENTLGTMAX, NLONGNAMELGTMAX, NUNITLGTMAX
-USE MODD_PARAM_LIMA, ONLY: NINDICE_CCN_IMM, NIMM, NMOD_CCN, NMOD_IFN, NMOD_IMM, PARAM_LIMA_ALLOCATE, PARAM_LIMA_DEALLOCATE
+USE MODD_PARAM_LIMA, ONLY: NINDICE_CCN_IMM, NIMM, NMOD_CCN, NMOD_IFN, NMOD_IMM, PARAM_LIMA_ALLOCATE, &
+ PARAM_LIMA_DEALLOCATE, NMOM_H
USE MODD_PARAM_LIMA_COLD, ONLY: CLIMA_COLD_NAMES
USE MODD_PARAM_LIMA_WARM, ONLY: CAERO_MASS, CLIMA_WARM_NAMES
USE MODD_PARAM_n, ONLY: CCLOUD, CELEC
@@ -230,39 +234,6 @@ IF (CCLOUD == 'LIMA' ) THEN
END IF
END IF ! CCLOUD = LIMA
!
-!
-! Add one scalar for negative ion
-! First variable: positive ion (NSV_ELECBEG_A index number)
-! Last --------: negative ion (NSV_ELECEND_A index number)
-! Correspondence for ICE3:
-! Relative index 1 2 3 4 5 6 7
-! Charge for ion+ cloud rain ice snow graupel ion-
-!
-! Correspondence for ICE4:
-! Relative index 1 2 3 4 5 6 7 8
-! Charge for ion+ cloud rain ice snow graupel hail ion-
-!
-IF (CELEC /= 'NONE') THEN
- IF (CCLOUD == 'ICE3') THEN
- NSV_ELEC_A(KMI) = 7
- NSV_ELECBEG_A(KMI)= ISV+1
- NSV_ELECEND_A(KMI)= ISV+NSV_ELEC_A(KMI)
- ISV = NSV_ELECEND_A(KMI)
- CELECNAMES(7) = CELECNAMES(8)
- ELSE IF (CCLOUD == 'ICE4') THEN
- NSV_ELEC_A(KMI) = 8
- NSV_ELECBEG_A(KMI)= ISV+1
- NSV_ELECEND_A(KMI)= ISV+NSV_ELEC_A(KMI)
- ISV = NSV_ELECEND_A(KMI)
- END IF
-ELSE
- NSV_ELEC_A(KMI) = 0
-! force First index to be superior to last index
-! in order to create a null section
- NSV_ELECBEG_A(KMI) = 1
- NSV_ELECEND_A(KMI) = 0
-END IF
-!
! scalar variables used as lagragian variables
!
IF (LLG) THEN
@@ -527,6 +498,40 @@ ELSE
! in order to create a null section
END IF
!
+! scalar variables used in the electrical scheme
+!
+! Add one scalar for negative ion
+! First variable: positive ion (NSV_ELECBEG_A index number)
+! Last --------: negative ion (NSV_ELECEND_A index number)
+! Correspondence for ICE3:
+! Relative index 1 2 3 4 5 6 7
+! Charge for ion+ cloud rain ice snow graupel ion-
+!
+! Correspondence for ICE4:
+! Relative index 1 2 3 4 5 6 7 8
+! Charge for ion+ cloud rain ice snow graupel hail ion-
+!
+IF (CELEC /= 'NONE') THEN
+ IF (CCLOUD == 'ICE3' .OR. (CCLOUD == 'LIMA' .AND. (NMOM_H .LT. 1))) THEN
+ NSV_ELEC_A(KMI) = 7
+ NSV_ELECBEG_A(KMI)= ISV+1
+ NSV_ELECEND_A(KMI)= ISV+NSV_ELEC_A(KMI)
+ ISV = NSV_ELECEND_A(KMI)
+ CELECNAMES(7) = CELECNAMES(8)
+ ELSE IF (CCLOUD == 'ICE4' .OR. (CCLOUD == 'LIMA' .AND. (NMOM_H .GE. 1))) THEN
+ NSV_ELEC_A(KMI) = 8
+ NSV_ELECBEG_A(KMI)= ISV+1
+ NSV_ELECEND_A(KMI)= ISV+NSV_ELEC_A(KMI)
+ ISV = NSV_ELECEND_A(KMI)
+ END IF
+ELSE
+ NSV_ELEC_A(KMI) = 0
+! force First index to be superior to last index
+! in order to create a null section
+ NSV_ELECBEG_A(KMI) = 1
+ NSV_ELECEND_A(KMI) = 0
+END IF
+!
! scalar variables used in blowing snow model
!
IF (LBLOWSNOW) THEN
diff --git a/src/MNH/ion_attach_elec.f90 b/src/MNH/ion_attach_elec.f90
index cd0fcf1c3eb268b93d7eeceef9161bc5157122aa..cd99d72d40e24fd2b0fffa6ee0602e191888e8f2 100644
--- a/src/MNH/ion_attach_elec.f90
+++ b/src/MNH/ion_attach_elec.f90
@@ -3,49 +3,56 @@
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
-! ############################
+! ###########################
MODULE MODI_ION_ATTACH_ELEC
-! ############################
+! ###########################
!
INTERFACE
- SUBROUTINE ION_ATTACH_ELEC(KTCOUNT, KRR, PTSTEP, PRHODREF, &
- PRHODJ,PSVS, PRS, PTHT, PCIT, PPABST, PEFIELDU, &
- PEFIELDV, PEFIELDW, GATTACH, PTOWN, PSEA )
-
-
-INTEGER, INTENT(IN) :: KTCOUNT ! Temporal loop counter
-INTEGER, INTENT(IN) :: KRR ! Number of moist variables
-REAL, INTENT(IN) :: PTSTEP ! Time step
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Reference dry air density
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! dry air density* Jacobian
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVS ! Scalar variable vol. source
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRS ! Moist variable vol. source
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta (K) at time t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PCIT ! Pristine ice n.c. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! Absolute pressure at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PEFIELDU, PEFIELDV, PEFIELDW
- ! Electric field components
-LOGICAL, DIMENSION(:,:,:), INTENT(IN) :: GATTACH !Recombination and
- !Attachment if true
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PTOWN ! town fraction
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PSEA ! Land-sea mask
-
- END SUBROUTINE ION_ATTACH_ELEC
+ SUBROUTINE ION_ATTACH_ELEC(KTCOUNT, KRR, HCLOUD, PTSTEP, PRHODREF, &
+ PRHODJ, PSVS, PRS, PTHT, PCIT, PPABST, &
+ PEFIELDU, PEFIELDV, PEFIELDW, GATTACH, &
+ PTOWN, PSEA, &
+ PCCS, PCRS, PCSS, PCGS, PCHS )
+!
+INTEGER, INTENT(IN) :: KTCOUNT ! Temporal loop counter
+INTEGER, INTENT(IN) :: KRR ! Number of moist variables
+CHARACTER(LEN=4), INTENT(IN) :: HCLOUD ! kind of cloud paramerization
+REAL, INTENT(IN) :: PTSTEP ! Time step
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Reference dry air density
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! dry air density* Jacobian
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVS ! Scalar variable vol. source
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRS ! Moist variable vol. source
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta (K) at time t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCIT ! Pristine ice n.c.
+ ! - at time t (for ICE schemes)
+ ! - source (for LIMA)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! Absolute pressure at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PEFIELDU, PEFIELDV, PEFIELDW
+ ! Electric field components
+LOGICAL, DIMENSION(:,:,:), INTENT(IN) :: GATTACH ! Recombination and
+ ! Attachment if true
+REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PTOWN ! Town fraction
+REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PSEA ! Land-sea mask
+!
+REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(IN) :: PCCS ! Cld droplets nb conc source
+REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(IN) :: PCRS ! Rain nb conc source
+REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(IN) :: PCSS ! Snow nb conc source
+REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(IN) :: PCGS ! Graupel nb conc source
+REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(IN) :: PCHS ! Hail nb conc source
+!
+END SUBROUTINE ION_ATTACH_ELEC
END INTERFACE
END MODULE MODI_ION_ATTACH_ELEC
-
-
-
-! ######################################################################
- SUBROUTINE ION_ATTACH_ELEC(KTCOUNT, KRR, PTSTEP, PRHODREF, &
- PRHODJ,PSVS, PRS, PTHT, PCIT, PPABST, PEFIELDU, &
- PEFIELDV, PEFIELDW, GATTACH, PTOWN, PSEA )
-! ######################################################################
-
-
!
-!!**** * -
+!
+! ####################################################################
+ SUBROUTINE ION_ATTACH_ELEC(KTCOUNT, KRR, HCLOUD, PTSTEP, PRHODREF, &
+ PRHODJ, PSVS, PRS, PTHT, PCIT, PPABST, &
+ PEFIELDU, PEFIELDV, PEFIELDW, GATTACH, &
+ PTOWN, PSEA, &
+ PCCS, PCRS, PCSS, PCGS, PCHS )
+! ####################################################################
!!
!! PURPOSE
!! -------
@@ -77,25 +84,57 @@ END MODULE MODI_ION_ATTACH_ELEC
!! Modifications:
!! J.Escobar : 18/12/2015 : Correction of bug in bound in // for NHALO <>1
! P. Wautelet 03/2020: use the new data structures and subroutines for budgets
+! C. Barthe 09/2022: enable the use of LIMA for cloud electrification
+! C. Barthe 09/2023: enable the use of LIMA2 for cloud electrification
+!
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
use modd_budget, only : lbudget_sv, NBUDGET_SV1, tbudgets
-USE MODD_CONF, ONLY: CCONF
+USE MODD_CONF, ONLY : CCONF
USE MODD_CST
USE MODD_ELEC_DESCR
USE MODD_ELEC_n
USE MODD_ELEC_PARAM
-USE MODD_NSV, ONLY: NSV_ELECBEG, NSV_ELEC
-USE MODD_PARAMETERS, ONLY: JPHEXT, JPVEXT
-USE MODD_RAIN_ICE_DESCR_n
-USE MODD_RAIN_ICE_PARAM_n
-USE MODD_REF, ONLY: XTHVREFZ
+USE MODD_NSV, ONLY : NSV_ELECBEG, NSV_ELEC
+USE MODD_PARAMETERS, ONLY : JPHEXT, JPVEXT
+USE MODD_PARAM_LIMA, ONLY : XALPHAC_L=>XALPHAC, XNUC_L=>XNUC, &
+ XALPHAI_L=>XALPHAI, XNUI_L=>XNUI, &
+ XCEXVT_L=>XCEXVT, &
+ NMOM_S, NMOM_G, NMOM_H
+USE MODD_PARAM_LIMA_COLD, ONLY : XDI, XLBI, XLBEXI, XFSEDRI, &
+ XDS, XCCS_L=>XCCS, XCXS_L=>XCXS, XLBS_L=>XLBS, &
+ XEXSEDS_L=>XEXSEDS, XLBEXS_L=>XLBEXS, XFSEDS_L=>XFSEDS
+USE MODD_PARAM_LIMA_MIXED,ONLY : XDG, XCCG_L=>XCCG, XCXG_L=>XCXG, XLBG_L=>XLBG, &
+ XEXSEDG_L=>XEXSEDG, XLBEXG_L=>XLBEXG, XFSEDG_L=>XFSEDG, &
+ XDH, XALPHAH_L=>XALPHAH, XNUH_L=>XNUH, &
+ XCCH_L=>XCCH, XCXH_L=>XCXH, XLBH_L=>XLBH, &
+ XEXSEDH_L=>XEXSEDH, XLBEXH_L=>XLBEXH, XFSEDH_L=>XFSEDH
+USE MODD_PARAM_LIMA_WARM, ONLY : XCC_L=>XCC, XDC_L=>XDC, XLBC_L=>XLBC, XLBEXC_L=>XLBEXC, &
+ XFSEDC_L=>XFSEDRC, &
+ XLBR_L=>XLBR, XLBEXR_L=>XLBEXR, &
+ XFSEDR_L=>XFSEDRR, XBR, XDR
+USE MODD_RAIN_ICE_DESCR_n,ONLY : XALPHAC_I=>XALPHAC, XNUC_I=>XNUC, &
+ XALPHAI_I=>XALPHAI, XNUI_I=>XNUI, &
+ XALPHAH_I=>XALPHAH, XNUH_I=>XNUH, &
+ XCC_I=>XCC, XDC_I=>XDC, XLBC_I=>XLBC, XLBEXC_I=>XLBEXC, &
+ XCONC_SEA, XCONC_LAND, XCONC_URBAN, XALPHAC2, XNUC2, &
+ XCCR, XLBR_I=>XLBR, XLBEXR_I=>XLBEXR, &
+ XCCS_I=>XCCS, XCXS_I=>XCXS, XLBS_I=>XLBS, XLBEXS_I=>XLBEXS, &
+ XCCG_I=>XCCG, XCXG_I=>XCXG, XLBG_I=>XLBG, XLBEXG_I=>XLBEXG, &
+ XCCH_I=>XCCH, XCXH_I=>XCXH, XLBH_I=>XLBH, XLBEXH_I=>XLBEXH, &
+ XCEXVT_I=>XCEXVT
+USE MODD_RAIN_ICE_PARAM_n,ONLY : XFSEDC_I=>XFSEDC, &
+ XFSEDR_I=>XFSEDR, XEXSEDR, &
+ XFSEDS_I=>XFSEDS, XEXSEDS_I=>XEXSEDS, &
+ XFSEDG_I=>XFSEDG, XEXSEDG_I=>XEXSEDG, &
+ XFSEDH_I=>XFSEDH, XEXSEDH_I=>XEXSEDH
+USE MODD_REF, ONLY : XTHVREFZ
-use mode_budget, only: Budget_store_init, Budget_store_end
-use mode_tools_ll, only: GET_INDICE_ll
+use mode_budget, only : Budget_store_init, Budget_store_end
+use mode_tools_ll, only : GET_INDICE_ll
USE MODI_MOMG
@@ -103,32 +142,41 @@ IMPLICIT NONE
!
! 0.1 Declaration of arguments
!
-INTEGER, INTENT(IN) :: KTCOUNT ! Temporal loop counter
-INTEGER, INTENT(IN) :: KRR ! Number of moist variables
-REAL, INTENT(IN) :: PTSTEP ! Time step
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Reference dry air density
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! dry air density* Jacobian
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVS ! Scalar variable vol. source
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRS ! Moist variable vol. source
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta (K) at time t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PCIT ! Pristine ice n.c. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! Absolute pressure at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PEFIELDU, PEFIELDV, PEFIELDW
- ! Electric field components
-LOGICAL, DIMENSION(:,:,:), INTENT(IN) :: GATTACH !Recombination and
- !Attachment if true
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PTOWN ! town fraction
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PSEA ! Land-sea mask
-
+INTEGER, INTENT(IN) :: KTCOUNT ! Temporal loop counter
+INTEGER, INTENT(IN) :: KRR ! Number of moist variables
+CHARACTER(LEN=4), INTENT(IN) :: HCLOUD ! kind of cloud paramerization
+REAL, INTENT(IN) :: PTSTEP ! Time step
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Reference dry air density
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! dry air density* Jacobian
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVS ! Scalar variable vol. source
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRS ! Moist variable vol. source
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta (K) at time t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCIT ! Pristine ice n.c.
+ ! - at time t (for ICE schemes)
+ ! - source (for LIMA)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! Absolute pressure at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PEFIELDU, PEFIELDV, PEFIELDW
+ ! Electric field components
+LOGICAL, DIMENSION(:,:,:), INTENT(IN) :: GATTACH ! Recombination and
+ ! Attachment if true
+REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PTOWN ! Town fraction
+REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PSEA ! Land-sea mask
+!
+REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(IN) :: PCCS ! Cld droplets nb conc source
+REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(IN) :: PCRS ! Rain nb conc source
+REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(IN) :: PCSS ! Snow nb conc source
+REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(IN) :: PCGS ! Graupel nb conc source
+REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(IN) :: PCHS ! Hail nb conc source
!
!
! 0.2 Declaration of local variables
!
-REAL, DIMENSION(:), ALLOCATABLE :: ZT ! Temperature (K)
-REAL, DIMENSION(:), ALLOCATABLE :: ZCONC, ZVIT, ZRADIUS ! Number concentration
- !fallspeed, radius
-REAL :: ZCQD, ZCDIF ! computed coefficients
+REAL, DIMENSION(:), ALLOCATABLE :: ZT ! Temperature (K)
+REAL, DIMENSION(:), ALLOCATABLE :: ZCONC, & ! Number concentration
+ ZVIT, & ! Fallspeed
+ ZRADIUS ! Radius
+REAL :: ZCQD, ZCDIF ! Computed coefficients
INTEGER, DIMENSION(SIZE(PTHT)) :: IGI, IGJ, IGK ! Valid grid index
INTEGER :: IVALID ! Nb of valid grid
INTEGER :: IIB ! Beginning (B) and end (E) grid points
@@ -143,26 +191,138 @@ INTEGER :: ITYPE ! Hydrometeor category (2: cloud, 3: rain,
! 4: ice crystal, 5: snow, 6: graupel, 7: hail)
REAL :: ZCOMB ! Recombination
!
+! variables used to select between common parameters between ICEx and LIMA
+REAL :: ZALPHAC, ZNUC, ZCC, ZDC, &
+ ZFSEDC1, ZFSEDC2, ZLBC1, ZLBC2, ZLBEXC, &
+ ZALPHAI, ZNUI, &
+ ZLBR, ZLBEXR, ZFSEDR, &
+ ZCCS, ZCXS, ZLBS, ZLBEXS, ZFSEDS, ZEXSEDS, &
+ ZCCG, ZCXG, ZLBG, ZLBEXG, ZFSEDG, ZEXSEDG, &
+ ZCCH, ZCXH, ZLBH, ZLBEXH, ZFSEDH, ZEXSEDH, &
+ ZALPHAH, ZNUH, &
+ ZCEXVT
+!
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZCCT, & ! nb conc at t for cld droplets
+ ZCRT, & ! rain
+ ZCIT, & ! ice crystal
+ ZCST, & ! snow
+ ZCGT, & ! graupel
+ ZCHT ! hail
!
!-------------------------------------------------------------------------------
+!
if ( lbudget_sv ) then
do jrr = 1, nsv_elec
call Budget_store_init( tbudgets( NBUDGET_SV1 - 1 + nsv_elecbeg - 1 + jrr), 'NEUT', psvs(:, :, :, jrr) )
end do
end if
!
-!* 1. COMPUTE THE ION RECOMBINATION and TEMPERATURE
-! ---------------------------------------------
+!* 1. PRELIMINARIES
+! -------------
+!
+! select parameters between ICEx and LIMA
+!
+IF (HCLOUD(1:3) == 'ICE') THEN
+ !
+ ZALPHAC = XALPHAC_I
+ ZNUC = XNUC_I
+ ZCC = XCC_I
+ ZDC = XDC_I
+ ZFSEDC1 = XFSEDC_I(1)
+ ZFSEDC2 = XFSEDC_I(2)
+ ZLBC1 = XLBC_I(1)
+ ZLBC2 = XLBC_I(2)
+ ZLBEXC = XLBEXC_I
+ !
+ ZALPHAI = XALPHAI_I
+ ZNUI = XNUI_I
+ !
+ ZLBR = XLBR_I
+ ZLBEXR = XLBEXR_I
+ ZFSEDR = XFSEDR_I
+ !
+ ZCCS = XCCS_I
+ ZCXS = XCXS_I
+ ZLBS = XLBS_I
+ ZLBEXS = XLBEXS_I
+ ZFSEDS = XFSEDS_I
+ ZEXSEDS = XEXSEDS_I
+ !
+ ZCCG = XCCG_I
+ ZCXG = XCXG_I
+ ZLBG = XLBG_I
+ ZLBEXG = XLBEXG_I
+ ZFSEDG = XFSEDG_I
+ ZEXSEDG = XEXSEDG_I
+ !
+ ZALPHAH = XALPHAH_I
+ ZNUH = XNUH_I
+ ZCCH = XCCH_I
+ ZCXH = XCXH_I
+ ZLBH = XLBH_I
+ ZLBEXH = XLBEXH_I
+ ZFSEDH = XFSEDH_I
+ ZEXSEDH = XEXSEDH_I
+ !
+ ZCEXVT = XCEXVT_I
+ !
+ELSE IF (HCLOUD == 'LIMA') THEN
+ !
+ ZALPHAC = XALPHAC_L
+ ZNUC = XNUC_L
+ ZCC = XCC_L
+ ZDC = XDC_L
+ ZFSEDC1 = XFSEDC_L
+ ZLBC1 = XLBC_L
+ ZLBEXC = XLBEXC_L
+ !
+ ZALPHAI = XALPHAI_L
+ ZNUI = XNUI_L
+ !
+ ZLBR = XLBR_L
+ ZLBEXR = XLBEXR_L
+ ZFSEDR = XFSEDR_L
+ !
+ ZCCS = XCCS_L
+ ZCXS = XCXS_L
+ ZLBS = XLBS_L
+ ZLBEXS = XLBEXS_L
+ ZFSEDS = XFSEDS_L
+ ZEXSEDS = XEXSEDS_L
+ !
+ ZCCG = XCCG_L
+ ZCXG = XCXG_L
+ ZLBG = XLBG_L
+ ZLBEXG = XLBEXG_L
+ ZFSEDG = XFSEDG_L
+ ZEXSEDG = XEXSEDG_L
+ !
+ ZALPHAH = XALPHAH_L
+ ZNUH = XNUH_L
+ ZCCH = XCCH_L
+ ZCXH = XCXH_L
+ ZLBH = XLBH_L
+ ZLBEXH = XLBEXH_L
+ ZFSEDH = XFSEDH_L
+ ZEXSEDH = XEXSEDH_L
+ !
+ ZCEXVT = XCEXVT_L
+END IF
!
+!-------------------------------------------------------------------------------
+!
+!* 2. COMPUTE THE ION RECOMBINATION and TEMPERATURE
+! ---------------------------------------------
!
ZCQD = 4 * XPI * XEPSILON * XBOLTZ / XECHARGE
-ZCDIF = XBOLTZ /XECHARGE
+ZCDIF = XBOLTZ / XECHARGE
!
CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
IKB = 1 + JPVEXT
IKE = SIZE(PTHT,3) - JPVEXT
!
-!* 1.1 Add Ion Recombination source (PSVS in 1/(m3.s))
+!
+!* 2.1 Add Ion Recombination source (PSVS in 1/(m3.s))
! and count and localize valid grid points for ion source terms
!
IVALID = 0
@@ -170,13 +330,16 @@ DO IK = IKB, IKE
DO IJ = IJB, IJE
DO II = IIB, IIE
IF (GATTACH(II,IJ,IK)) THEN
-! Recombination
- ZCOMB = XIONCOMB * (PSVS(II,IJ,IK,1)*PTSTEP) * &
- (PSVS(II,IJ,IK,NSV_ELEC)*PTSTEP) * &
+! Recombination rate
+ ZCOMB = XIONCOMB * (PSVS(II,IJ,IK,1) * PTSTEP) * &
+ (PSVS(II,IJ,IK,NSV_ELEC) * PTSTEP) * &
PRHODREF(II,IJ,IK) / PRHODJ(II,IJ,IK)
ZCOMB = MIN(ZCOMB, PSVS(II,IJ,IK,1), PSVS(II,IJ,IK,NSV_ELEC))
- PSVS(II,IJ,IK,1) = PSVS(II,IJ,IK,1) - ZCOMB
+ !
+! Update the sources
+ PSVS(II,IJ,IK,1) = PSVS(II,IJ,IK,1) - ZCOMB
PSVS(II,IJ,IK,NSV_ELEC) = PSVS(II,IJ,IK,NSV_ELEC) - ZCOMB
+ !
! Counting
IVALID = IVALID + 1
IGI(IVALID) = II
@@ -187,7 +350,8 @@ DO IK = IKB, IKE
ENDDO
ENDDO
!
-!* 1.2 Compute the temperature
+!
+!* 2.2 Compute the temperature
!
IF( IVALID /= 0 ) THEN
ALLOCATE (ZT(IVALID))
@@ -197,21 +361,50 @@ IF( IVALID /= 0 ) THEN
ENDDO
END IF
!
+!-------------------------------------------------------------------------------
!
-!* 2. TRANSFORM VOLUM. SOURCE TERMS INTO MIXING RATIO
+!* 3. TRANSFORM VOLUM. SOURCE TERMS INTO MIXING RATIO
! FOR WATER SPECIES, AND VOLUMIC CONTENT FOR ELECTRIC VARIABLES
! -------------------------------------------------------------
!
DO JRR = 1, KRR
- PRS(:,:,:,JRR) = PRS(:,:,:,JRR) *PTSTEP / PRHODJ(:,:,:)
+ PRS(:,:,:,JRR) = PRS(:,:,:,JRR) * PTSTEP / PRHODJ(:,:,:)
ENDDO
!
+ALLOCATE(ZCIT(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)))
+! ICEx : pcit is really pcit
+IF (HCLOUD(1:3) == 'ICE') ZCIT(:,:,:) = PCIT(:,:,:)
+!
+IF (HCLOUD == 'LIMA') THEN
+ ALLOCATE(ZCCT(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)))
+ ALLOCATE(ZCRT(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)))
+ !
+ ZCCT(:,:,:) = PCCS(:,:,:) * PTSTEP / PRHODJ(:,:,:)
+ ZCRT(:,:,:) = PCRS(:,:,:) * PTSTEP / PRHODJ(:,:,:)
+! LIMA : pcit is pcis !
+ ZCIT(:,:,:) = PCIT(:,:,:) * PTSTEP / PRHODJ(:,:,:)
+ !
+ IF (PRESENT(PCSS)) THEN
+ ALLOCATE(ZCST(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)))
+ ZCST(:,:,:) = PCSS(:,:,:) * PTSTEP / PRHODJ(:,:,:)
+ END IF
+ IF (PRESENT(PCGS)) THEN
+ ALLOCATE(ZCGT(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)))
+ ZCGT(:,:,:) = PCGS(:,:,:) * PTSTEP / PRHODJ(:,:,:)
+ END IF
+ IF (PRESENT(PCHS)) THEN
+ ALLOCATE(ZCHT(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)))
+ ZCHT(:,:,:) = PCHS(:,:,:) * PTSTEP / PRHODJ(:,:,:)
+ END IF
+END IF
+!
DO JSV = 1, NSV_ELEC
- PSVS(:,:,:,JSV) = PSVS(:,:,:,JSV) *PTSTEP *PRHODREF(:,:,:) / PRHODJ(:,:,:)
+ PSVS(:,:,:,JSV) = PSVS(:,:,:,JSV) * PTSTEP * PRHODREF(:,:,:) / PRHODJ(:,:,:)
ENDDO
!
+!-------------------------------------------------------------------------------
!
-!* 3. COMPUTE ATTACHMENT DUE TO ION DIFFUSION AND CONDUCTION
+!* 4. COMPUTE ATTACHMENT DUE TO ION DIFFUSION AND CONDUCTION
! ------------------------------------------------------
!
! Attachment to cloud droplets, rain, cloud ice, snow, graupel,
@@ -220,7 +413,8 @@ ENDDO
!
IF( IVALID /= 0 ) THEN
!
-!* 3.1 Attachment to cloud droplets
+!
+!* 4.1 Attachment to cloud droplets
!
ALLOCATE (ZCONC(IVALID))
ALLOCATE (ZVIT (IVALID))
@@ -232,16 +426,17 @@ IF( IVALID /= 0 ) THEN
ELSE
CALL HYDROPARAM (IGI, IGJ, IGK, ZCONC, ZVIT, ZRADIUS, ITYPE)
ENDIF
-!
+!
CALL DIFF_COND (IGI, IGJ, IGK, PSVS(:,:,:,1), PSVS(:,:,:,NSV_ELEC), &
PSVS(:,:,:,ITYPE))
!
-!* 3.2 Attachment to raindrops, ice crystals, snow, graupel,
+!
+!* 4.2 Attachment to raindrops, ice crystals, snow, graupel,
! and hail (if activated)
!
DO ITYPE = 3, KRR
CALL HYDROPARAM (IGI, IGJ, IGK, ZCONC, ZVIT, ZRADIUS, ITYPE)
-!
+!
CALL DIFF_COND (IGI, IGJ, IGK, PSVS(:,:,:,1), PSVS(:,:,:,NSV_ELEC), &
PSVS(:,:,:,ITYPE))
END DO
@@ -250,8 +445,16 @@ IF( IVALID /= 0 ) THEN
DEALLOCATE (ZT)
ENDIF
!
+IF (ALLOCATED(ZCCT)) DEALLOCATE(ZCCT)
+IF (ALLOCATED(ZCRT)) DEALLOCATE(ZCRT)
+IF (ALLOCATED(ZCIT)) DEALLOCATE(ZCIT)
+IF (ALLOCATED(ZCST)) DEALLOCATE(ZCST)
+IF (ALLOCATED(ZCGT)) DEALLOCATE(ZCGT)
+IF (ALLOCATED(ZCHT)) DEALLOCATE(ZCHT)
+!
+!-------------------------------------------------------------------------------
!
-!* 4. RETURN TO VOLUMETRIC SOURCE (Prognostic units)
+!* 5. RETURN TO VOLUMETRIC SOURCE (Prognostic units)
! ---------------------------
!
DO JRR = 1, KRR
@@ -262,8 +465,9 @@ DO JSV = 1, NSV_ELEC
PSVS(:,:,:,JSV) = PSVS(:,:,:,JSV) * PRHODJ(:,:,:) / (PTSTEP * PRHODREF(:,:,:))
ENDDO
!
+!-------------------------------------------------------------------------------
!
-!* 5. BUDGET
+!* 6. BUDGET
! ------
!
if ( lbudget_sv ) then
@@ -278,7 +482,7 @@ CONTAINS
!
!------------------------------------------------------------------------------
!
- SUBROUTINE HYDROPARAM (IGRIDX, IGRIDY, IGRIDZ, ZCONC, &
+ SUBROUTINE HYDROPARAM (IGRIDX, IGRIDY, IGRIDZ, ZCONC, &
ZVIT, ZRADIUS, ITYPE, PSEA, PTOWN)
!
! Purpose : Compute in regions of valid grid points (IGRIDX, IGRIDY, IGRIDZ)
@@ -294,25 +498,28 @@ IMPLICIT NONE
!
!* 0.1 declaration of dummy arguments
!
-INTEGER, DIMENSION(:), INTENT(IN) :: IGRIDX, IGRIDY, IGRIDZ ! Index of
- ! valid gridpoints
-INTEGER, INTENT(IN) :: ITYPE ! Hydrometeor category
+INTEGER, DIMENSION(:), INTENT(IN) :: IGRIDX, & ! Index of
+ IGRIDY, & ! valid
+ IGRIDZ ! gridpoints
+INTEGER, INTENT(IN) :: ITYPE ! Hydrometeor category
! ITYPE= 2: cloud, 3: rain, 4: ice, 5: snow, 6: graupel, 7: hail
-REAL, DIMENSION(:), INTENT(INOUT) :: ZCONC, ZVIT, ZRADIUS
-! Number concentration, fallspeed, radius
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PTOWN ! town fraction
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PSEA ! Land-sea mask
+REAL, DIMENSION(:), INTENT(INOUT) :: ZCONC, & ! Number concentration
+ ZVIT, & ! Fallspeed
+ ZRADIUS ! Radius
+REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PTOWN ! Town fraction
+REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PSEA ! Land-sea mask
!
!* 0.2 declaration of local variables
!
-REAL :: ZCONC1, ZCONC2 ! for cloud
-REAL :: ZLBC
-REAL :: ZFSEDC
-REAL :: ZRAY
-REAL :: ZEXP1, ZEXP2, ZMOM1, ZMOM2
-REAL :: ZVCOEF, ZRHO00, ZLBI
-REAL :: ZLAMBDA
-INTEGER :: JI, JJ, JK, IV
+REAL :: ZCONC1, ZCONC2 ! for cloud
+REAL :: ZLBC
+REAL :: ZFSEDC
+REAL :: ZRAY
+REAL :: ZEXP1, ZEXP2, ZMOM1, ZMOM2
+REAL :: ZVCOEF, ZRHO00, ZLBI
+REAL :: ZLAMBDA
+REAL :: ZCOR ! correction factor for cloud droplet terminal fall speed
+INTEGER :: JI, JJ, JK, IV
!
!
ZCONC(:) = 0.
@@ -325,99 +532,148 @@ SELECT CASE (ITYPE)
! --------------------
CASE (2)
!
- IF (PRESENT(PSEA)) THEN
-
- ZMOM1 = 0.5*MOMG(XALPHAC,XNUC,1.)
- ZMOM2 = 0.5*MOMG(XALPHAC2,XNUC2,1.)
+ IF (HCLOUD(1:3) == 'ICE') THEN
+ IF (PRESENT(PSEA)) THEN
+ ZMOM1 = 0.5 * MOMG(ZALPHAC,ZNUC,1.)
+ ZMOM2 = 0.5 * MOMG(XALPHAC2,XNUC2,1.)
+ DO IV = 1, IVALID
+ JI = IGRIDX(IV)
+ JJ = IGRIDY(IV)
+ JK = IGRIDZ(IV)
+ IF( PRS(JI,JJ,JK,2)/PRHODREF(JI,JJ,JK) > XRTMIN_ELEC(2) .AND. &
+ PSVS(JI,JJ,JK,2) /= 0. ) THEN
+ ZCONC1 = PSEA(JI,JJ) * XCONC_SEA + (1. - PSEA(JI,JJ)) * XCONC_LAND
+ ZLBC = PSEA(JI,JJ) * ZLBC2 + (1. - PSEA(JI,JJ)) * ZLBC1
+ ZFSEDC = PSEA(JI,JJ) * ZFSEDC2 + (1. - PSEA(JI,JJ)) * ZFSEDC1
+ ZFSEDC = MAX(MIN(ZFSEDC1,ZFSEDC2), ZFSEDC)
+ ZCONC2 = (1. - PTOWN(JI,JJ)) * ZCONC1 + PTOWN(JI,JJ) * XCONC_URBAN
+ ZRAY = (1. - PSEA(JI,JJ)) * ZMOM1 + PSEA(JI,JJ) * ZMOM2
+ ZCONC(IV) = ZCONC2 ! Number concentration
+ ZLAMBDA = (ZLBC * ZCONC2 / (PRHODREF(JI,JJ,JK) * PRS(JI,JJ,JK,2)))**ZLBEXC
+ ZRADIUS(IV) = ZRAY / ZLAMBDA
+ ZVIT(IV) = ZCC * ZFSEDC * ZLAMBDA**(-ZDC) * PRHODREF(JI,JJ,JK)**(-ZCEXVT)
+ END IF
+ ENDDO
+ ELSE
+ ZRAY = 0.5 * MOMG(ZALPHAC,ZNUC,1.)
+ ZLBC = ZLBC1 * XCONC_LAND
+ DO IV = 1, IVALID
+ JI = IGRIDX(IV)
+ JJ = IGRIDY(IV)
+ JK = IGRIDZ(IV)
+ IF( PRS(JI,JJ,JK,2)/PRHODREF(JI,JJ,JK) > XRTMIN_ELEC(2) .AND. &
+ PSVS(JI,JJ,JK,2) /= 0. ) THEN
+ ZCONC(IV) = XCONC_LAND ! Number concentration
+ ZLAMBDA = (ZLBC / (PRHODREF(JI,JJ,JK) * PRS(JI,JJ,JK,2)))**ZLBEXC
+ ZRADIUS(IV) = ZRAY / ZLAMBDA
+ ZVIT(IV) = ZCC * ZFSEDC1 * ZLAMBDA**(-ZDC) * PRHODREF(JI,JJ,JK)**(-ZCEXVT)
+ END IF
+ ENDDO
+ END IF
+ ELSE IF (HCLOUD == 'LIMA') THEN
+ ZRAY = 0.5 * MOMG(ZALPHAC,ZNUC,1.)
+ DO IV = 1, IVALID
+ JI = IGRIDX(IV)
+ JJ = IGRIDY(IV)
+ JK = IGRIDZ(IV)
+ IF( PRS(JI,JJ,JK,2)/PRHODREF(JI,JJ,JK) > XRTMIN_ELEC(2) .AND. &
+ ZCCT(JI,JJ,JK) > 0. .AND. PSVS(JI,JJ,JK,2) /= 0. ) THEN
+ ZCONC(IV) = ZCCT(JI,JJ,JK) * PRHODREF(JI,JJ,JK) ! Number concentration (m-3)
+ ZLAMBDA = (ZLBC1 * ZCCT(JI,JJ,JK) / PRS(JI,JJ,JK,2))**ZLBEXC
+ ZRADIUS(IV) = ZRAY / ZLAMBDA
+! correction factor for cloud droplet terminal fall speed
+ ZCOR = 1. + 1.26 * 6.6E-8 * (101325. / PPABST(JI,JJ,JK)) * (ZT(IV) / 293.15) / ZRADIUS(IV)
+ ZVIT(IV) = ZCOR * ZFSEDC1 * ZLAMBDA**(-ZDC) * PRHODREF(JI,JJ,JK)**(-ZCEXVT)
+ END IF
+ ENDDO
+ END IF
+!
+!
+!* 2. PARAMETERS FOR RAIN
+! -------------------
+ CASE (3)
+!
+ IF (HCLOUD(1:3) == 'ICE') THEN
+ ZEXP1 = XEXSEDR - 1.
+ ZEXP2 = ZEXP1 - ZCEXVT
+!
DO IV = 1, IVALID
JI = IGRIDX(IV)
JJ = IGRIDY(IV)
JK = IGRIDZ(IV)
- IF( PRS(JI, JJ, JK, 2)/PRHODREF(JI, JJ, JK) >XRTMIN_ELEC(2) .AND. &
- PSVS(JI, JJ, JK, 2) /=0. ) THEN
- ZCONC1 = PSEA(JI,JJ) * XCONC_SEA + (1. - PSEA(JI,JJ)) * XCONC_LAND
- ZLBC = PSEA(JI,JJ) * XLBC(2) + (1. - PSEA(JI,JJ)) * XLBC(1)
- ZFSEDC = PSEA(JI,JJ) * XFSEDC(2) + (1. - PSEA(JI,JJ)) * XFSEDC(1)
- ZFSEDC = MAX(MIN(XFSEDC(1),XFSEDC(2)), ZFSEDC)
- ZCONC2 = (1. - PTOWN(JI,JJ)) * ZCONC1 + PTOWN(JI,JJ) * XCONC_URBAN
- ZRAY = (1. - PSEA(JI,JJ)) * ZMOM1 + PSEA(JI,JJ) * ZMOM2
- ZCONC (IV) = ZCONC2 ! Number concentration
- ZLAMBDA = (ZLBC *ZCONC2 / (PRHODREF(JI,JJ,JK) * PRS(JI,JJ,JK,2)))**XLBEXC
- ZRADIUS (IV) = ZRAY / ZLAMBDA
- ZVIT (IV) = XCC * ZFSEDC * ZLAMBDA**(-XDC) * &
- PRHODREF(JI,JJ,JK)**(-XCEXVT)
+ IF( PRS(JI,JJ,JK,3)/PRHODREF(JI,JJ,JK) > XRTMIN_ELEC(3) .AND. &
+ PSVS(JI,JJ,JK,3) /= 0. ) THEN
+ ZLAMBDA = ZLBR * (PRHODREF(JI,JJ,JK) * PRS(JI,JJ,JK,3))**ZLBEXR
+! dans ice3, alpha_r = 1 et nu_r = 1
+ ZRADIUS(IV) = 0.5 / ZLAMBDA
+ ZCONC(IV) = XCCR / ZLAMBDA
+ ZVIT(IV) = ZFSEDR * PRHODREF(JI,JJ,JK)**ZEXP2 &
+ * PRS(JI,JJ,JK,3)**ZEXP1
END IF
ENDDO
- ELSE
- ZRAY = 0.5*MOMG(XALPHAC,XNUC,1.)
- ZLBC = XLBC(1) * XCONC_LAND
+ ELSE IF (HCLOUD == 'LIMA') THEN
DO IV = 1, IVALID
JI = IGRIDX(IV)
JJ = IGRIDY(IV)
JK = IGRIDZ(IV)
- IF( PRS(JI, JJ, JK, 2)/PRHODREF(JI, JJ, JK) >XRTMIN_ELEC(2) .AND. &
- PSVS(JI, JJ, JK, 2) /=0. ) THEN
- ZCONC (IV) = XCONC_LAND ! Number concentration
- ZLAMBDA = (ZLBC / (PRHODREF(JI,JJ,JK) * PRS(JI,JJ,JK,2)))**XLBEXC
- ZRADIUS (IV) = ZRAY / ZLAMBDA
- ZVIT (IV) = XCC * XFSEDC(1) * ZLAMBDA**(-XDC) * &
- PRHODREF(JI,JJ,JK)**(-XCEXVT)
+ IF( PRS(JI,JJ,JK,3)/PRHODREF(JI,JJ,JK) > XRTMIN_ELEC(3) .AND. &
+ ZCRT(JI,JJ,JK) > 0. .AND. PSVS(JI,JJ,JK,3) /= 0. ) THEN
+ ZLAMBDA = (ZLBR * ZCRT(JI,JJ,JK) / PRS(JI,JJ,JK,3))**ZLBEXR
+! dans lima, alpha_r = 1 et nu_r = 2
+ ZRADIUS(IV) = 1. / ZLAMBDA
+ ZCONC(IV) = ZCRT(JI,JJ,JK) * PRHODREF(JI,JJ,JK) ! Number concentration (m-3)
+ ! zvit = zwsedr / (r * rho_dref)
+ ZVIT(IV) = ZFSEDR * ZLAMBDA**(-XDR) * PRHODREF(JI,JJ,JK)**(-ZCEXVT)
END IF
ENDDO
END IF
!
!
-!* 2. PARAMETERS FOR RAIN
-! -------------------
- CASE (3)
- ZEXP1 = XEXSEDR - 1.
- ZEXP2 = ZEXP1 - XCEXVT
-!
- DO IV = 1, IVALID
- JI = IGRIDX(IV)
- JJ = IGRIDY(IV)
- JK = IGRIDZ(IV)
- IF( PRS(JI, JJ, JK, 3)/PRHODREF(JI, JJ, JK) >XRTMIN_ELEC(3) .AND. &
- PSVS(JI, JJ, JK, 3) /=0. ) THEN
- ZLAMBDA = XLBR * (PRHODREF(JI,JJ,JK) * PRS(JI,JJ,JK,3))**XLBEXR
- ZRADIUS (IV) = 0.5 / ZLAMBDA
- ZCONC (IV) = XCCR / ZLAMBDA
- ZVIT (IV) = XFSEDR * PRHODREF(JI,JJ,JK)**ZEXP2 &
- * PRS(JI,JJ,JK,3)**ZEXP1
- END IF
- ENDDO
-!
-!
!* 3. PARAMETERS FOR ICE
! ------------------
!
CASE (4)
!
- ZRAY = 0.5*MOMG(XALPHAI,XNUI,1.)
- ZRHO00 = XP00 / (XRD * XTHVREFZ(IKB))
-! ZVCOEF= XC_I * (GAMMA(XNUI+(XBI+XDI)/XALPHAI) / GAMMA(XNUI+XBI/XALPHAI)) &
-! * ZRHO00**XCEXVT
+ ZRAY = 0.5 * MOMG(ZALPHAI,ZNUI,1.)
+ !
+ IF (HCLOUD(1:3) == 'ICE') THEN
+ ZRHO00 = XP00 / (XRD * XTHVREFZ(IKB))
! Computations for Columns (see ini_rain_ice_elec.f90)
- ZVCOEF = 2.1E5 * MOMG(XALPHAI,XNUI, 3.285) / MOMG(XALPHAI,XNUI, 1.7) &
- * ZRHO00**XCEXVT
- ZLBI = (2.14E-3 * MOMG(XALPHAI,XNUI,1.7)) **0.588235
-
- DO IV = 1, IVALID
- JI = IGRIDX(IV)
- JJ = IGRIDY(IV)
- JK = IGRIDZ(IV)
- IF( PRS(JI, JJ, JK, 4)/PRHODREF(JI, JJ, JK) > XRTMIN_ELEC(4) .AND. &
- PSVS(JI, JJ, JK, 4) /=0.) THEN
- ZCONC (IV) = XFCI * PRHODREF(JI,JJ,JK) * PRS(JI,JJ,JK,4) * &
- MAX(0.05E6, -0.15319E6 - 0.021454E6 * &
- ALOG(PRHODREF(JI,JJ,JK) * PRS(JI,JJ,JK,4)))**3
- ZLAMBDA = ZLBI * (ZCONC(IV) / (PRHODREF(JI,JJ,JK) * &
- PRS(JI,JJ,JK,4)))**0.588235
- ZRADIUS (IV) = ZRAY / ZLAMBDA
- ZVIT (IV) = ZVCOEF * ZLAMBDA**(-1.585) * & !(-XDI) * &
- PRHODREF(JI,JJ,JK)**(-XCEXVT)
- END IF
- ENDDO
+ ZVCOEF = 2.1E5 * MOMG(ZALPHAI,ZNUI, 3.285) / MOMG(ZALPHAI,ZNUI, 1.7) &
+ * ZRHO00**ZCEXVT
+ ZLBI = (2.14E-3 * MOMG(ZALPHAI,ZNUI,1.7)) **0.588235
+ !
+ DO IV = 1, IVALID
+ JI = IGRIDX(IV)
+ JJ = IGRIDY(IV)
+ JK = IGRIDZ(IV)
+ IF( PRS(JI, JJ, JK, 4)/PRHODREF(JI, JJ, JK) > XRTMIN_ELEC(4) .AND. &
+ PSVS(JI, JJ, JK, 4) /=0.) THEN
+ ZCONC(IV) = XFCI * PRHODREF(JI,JJ,JK) * PRS(JI,JJ,JK,4) * &
+ MAX(0.05E6, -0.15319E6 - 0.021454E6 * &
+ ALOG(PRHODREF(JI,JJ,JK) * PRS(JI,JJ,JK,4)))**3
+ ZLAMBDA = ZLBI * (ZCONC(IV) / (PRHODREF(JI,JJ,JK) * &
+ PRS(JI,JJ,JK,4)))**0.588235
+ ZRADIUS(IV) = ZRAY / ZLAMBDA
+ ZVIT(IV) = ZVCOEF * ZLAMBDA**(-1.585) * & !(-XDI) * &
+ PRHODREF(JI,JJ,JK)**(-ZCEXVT)
+ END IF
+ ENDDO
+ ELSE IF (HCLOUD == 'LIMA') THEN
+ DO IV = 1, IVALID
+ JI = IGRIDX(IV)
+ JJ = IGRIDY(IV)
+ JK = IGRIDZ(IV)
+ IF( PRS(JI,JJ,JK,4)/PRHODREF(JI,JJ,JK) > XRTMIN_ELEC(4) .AND. &
+ ZCIT(JI,JJ,JK) > 0. .AND. PSVS(JI,JJ,JK,4) /= 0.) THEN
+ ZCONC(IV) = ZCIT(JI,JJ,JK) * PRHODREF(JI,JJ,JK) ! Number concentration (m-3)
+ ZLAMBDA = (XLBI * ZCIT(JI,JJ,JK) / PRS(JI,JJ,JK,4))**XLBEXI
+ ZRADIUS(IV) = ZRAY / ZLAMBDA
+ ! zvit = zwsedr / (r * rho_dref)
+ ZVIT(IV) = XFSEDRI * ZLAMBDA**(-XDI) * PRHODREF(JI,JJ,JK)**(-ZCEXVT)
+ END IF
+ ENDDO
+ END IF
!
!
!* 4. PARAMETERS FOR SNOW
@@ -425,22 +681,37 @@ SELECT CASE (ITYPE)
!
CASE (5)
!
- ZEXP1 = XEXSEDS - 1.
- ZEXP2 = ZEXP1 - XCEXVT
-!
- DO IV = 1, IVALID
- JI = IGRIDX(IV)
- JJ = IGRIDY(IV)
- JK = IGRIDZ(IV)
- IF( PRS(JI, JJ, JK, 5)/PRHODREF(JI, JJ, JK) >XRTMIN_ELEC(5) .AND. &
- PSVS(JI, JJ, JK, 5) /=0. ) THEN
- ZLAMBDA = XLBS * (PRHODREF(JI,JJ,JK) * PRS(JI,JJ,JK,5))**XLBEXS
- ZRADIUS (IV) = 0.5 / ZLAMBDA
- ZCONC (IV) = XCCS * ZLAMBDA**XCXS
- ZVIT (IV) = XFSEDS * PRHODREF(JI,JJ,JK)**ZEXP2 &
- * PRS(JI,JJ,JK,5)**ZEXP1
- END IF
- ENDDO
+ IF ((HCLOUD(1:3) == 'ICE') .OR. (HCLOUD == 'LIMA' .AND. NMOM_S == 1)) THEN
+ ZEXP1 = ZEXSEDS - 1.
+ ZEXP2 = ZEXP1 - ZCEXVT
+!
+ DO IV = 1, IVALID
+ JI = IGRIDX(IV)
+ JJ = IGRIDY(IV)
+ JK = IGRIDZ(IV)
+ IF( PRS(JI,JJ,JK,5)/PRHODREF(JI,JJ,JK) > XRTMIN_ELEC(5) .AND. &
+ PSVS(JI,JJ,JK,5) /= 0. ) THEN
+ ZLAMBDA = ZLBS * (PRHODREF(JI,JJ,JK) * PRS(JI,JJ,JK,5))**ZLBEXS
+ ZRADIUS(IV) = 0.5 / ZLAMBDA
+ ZCONC(IV) = ZCCS * ZLAMBDA**ZCXS
+ ZVIT(IV) = ZFSEDS * PRHODREF(JI,JJ,JK)**ZEXP2 &
+ * PRS(JI,JJ,JK,5)**ZEXP1
+ END IF
+ ENDDO
+ ELSE IF (HCLOUD == 'LIMA' .AND. NMOM_S == 2) THEN
+ DO IV = 1, IVALID
+ JI = IGRIDX(IV)
+ JJ = IGRIDY(IV)
+ JK = IGRIDZ(IV)
+ IF( PRS(JI,JJ,JK,5)/PRHODREF(JI,JJ,JK) > XRTMIN_ELEC(5) .AND. &
+ ZCST(JI,JJ,JK) > 0. .AND. PSVS(JI,JJ,JK,5) /= 0. ) THEN
+ ZLAMBDA = (ZLBS * ZCST(JI,JJ,JK) / PRS(JI,JJ,JK,5))**ZLBEXS
+ ZRADIUS(IV) = 1. / ZLAMBDA
+ ZCONC(IV) = ZCST(JI,JJ,JK) * PRHODREF(JI,JJ,JK) ! Number concentration (m-3)
+ ZVIT(IV) = ZFSEDS * ZLAMBDA**(-XDS) * PRHODREF(JI,JJ,JK)**(-ZCEXVT)
+ END IF
+ ENDDO
+ END IF
!
!
!* 5. PARAMETERS FOR GRAUPEL
@@ -448,22 +719,37 @@ SELECT CASE (ITYPE)
!
CASE (6)
!
- ZEXP1 = XEXSEDG - 1.
- ZEXP2 = ZEXP1 - XCEXVT
-!
- DO IV = 1, IVALID
- JI = IGRIDX(IV)
- JJ = IGRIDY(IV)
- JK = IGRIDZ(IV)
- IF( PRS(JI, JJ, JK, 6)/PRHODREF(JI, JJ, JK) >XRTMIN_ELEC(6) .AND. &
- PSVS(JI, JJ, JK, 6) /=0. ) THEN
- ZLAMBDA = XLBG * (PRHODREF(JI,JJ,JK) * PRS(JI,JJ,JK,6))**XLBEXG
- ZRADIUS (IV) = 0.5 / ZLAMBDA
- ZCONC (IV) = XCCG * ZLAMBDA**XCXG
- ZVIT (IV) = XFSEDG * PRHODREF(JI,JJ,JK)**ZEXP2 &
- * PRS(JI,JJ,JK,6)**ZEXP1
- END IF
- ENDDO
+ IF ((HCLOUD(1:3) == 'ICE') .OR. (HCLOUD == 'LIMA' .AND. NMOM_G == 1)) THEN
+ ZEXP1 = ZEXSEDG - 1.
+ ZEXP2 = ZEXP1 - ZCEXVT
+!
+ DO IV = 1, IVALID
+ JI = IGRIDX(IV)
+ JJ = IGRIDY(IV)
+ JK = IGRIDZ(IV)
+ IF( PRS(JI,JJ,JK,6)/PRHODREF(JI,JJ,JK) > XRTMIN_ELEC(6) .AND. &
+ PSVS(JI,JJ,JK,6) /= 0. ) THEN
+ ZLAMBDA = ZLBG * (PRHODREF(JI,JJ,JK) * PRS(JI,JJ,JK,6))**ZLBEXG
+ ZRADIUS(IV) = 0.5 / ZLAMBDA
+ ZCONC(IV) = ZCCG * ZLAMBDA**ZCXG
+ ZVIT(IV) = ZFSEDG * PRHODREF(JI,JJ,JK)**ZEXP2 &
+ * PRS(JI,JJ,JK,6)**ZEXP1
+ END IF
+ ENDDO
+ ELSE IF (HCLOUD == 'LIMA' .AND. NMOM_G == 2) THEN
+ DO IV = 1, IVALID
+ JI = IGRIDX(IV)
+ JJ = IGRIDY(IV)
+ JK = IGRIDZ(IV)
+ IF( PRS(JI,JJ,JK,6)/PRHODREF(JI,JJ,JK) > XRTMIN_ELEC(6) .AND. &
+ ZCGT(JI,JJ,JK) > 0. .AND. PSVS(JI,JJ,JK,6) /= 0. ) THEN
+ ZLAMBDA = (ZLBG * ZCGT(JI,JJ,JK) / PRS(JI,JJ,JK,6))**ZLBEXG
+ ZRADIUS(IV) = 1. / ZLAMBDA
+ ZCONC(IV) = ZCGT(JI,JJ,JK) * PRHODREF(JI,JJ,JK) ! Number concentration (m-3)
+ ZVIT(IV) = ZFSEDG * ZLAMBDA**(-XDG) * PRHODREF(JI,JJ,JK)**(-ZCEXVT)
+ END IF
+ ENDDO
+ END IF
!
!
!* 6. PARAMETERS FOR HAIL
@@ -471,23 +757,37 @@ SELECT CASE (ITYPE)
!
CASE (7)
!
- ZEXP1 = XEXSEDH - 1.
- ZEXP2 = ZEXP1-XCEXVT
- ZRAY = 0.5*MOMG(XALPHAH, XNUH, 1.)
-!
- DO IV = 1, IVALID
- JI = IGRIDX(IV)
- JJ = IGRIDY(IV)
- JK = IGRIDZ(IV)
- IF( PRS(JI, JJ, JK, 7)/PRHODREF(JI, JJ, JK) >XRTMIN_ELEC(7) .AND. &
- PSVS(JI, JJ, JK, 7) /=0. ) THEN
- ZLAMBDA = XLBH * (PRHODREF(JI,JJ,JK) * PRS(JI,JJ,JK,7))**XLBEXH
- ZRADIUS (IV) = ZRAY / ZLAMBDA
- ZCONC (IV) = XCCG * ZLAMBDA**XCXG
- ZVIT (IV) = XFSEDH * PRHODREF(JI,JJ,JK)**ZEXP2 &
- * PRS(JI,JJ,JK,7)**ZEXP1
- END IF
- ENDDO
+ IF ((HCLOUD(1:3) == 'ICE') .OR. (HCLOUD == 'LIMA' .AND. NMOM_H == 1)) THEN
+ ZEXP1 = ZEXSEDH - 1.
+ ZEXP2 = ZEXP1 - ZCEXVT
+!
+ DO IV = 1, IVALID
+ JI = IGRIDX(IV)
+ JJ = IGRIDY(IV)
+ JK = IGRIDZ(IV)
+ IF( PRS(JI,JJ,JK,7)/PRHODREF(JI,JJ,JK) > XRTMIN_ELEC(7) .AND. &
+ PSVS(JI,JJ,JK,7) /= 0. ) THEN
+ ZLAMBDA = ZLBH * (PRHODREF(JI,JJ,JK) * PRS(JI,JJ,JK,7))**ZLBEXH
+ ZRADIUS(IV) = 0.5 / ZLAMBDA
+ ZCONC(IV) = ZCCH * ZLAMBDA**ZCXH
+ ZVIT(IV) = ZFSEDH * PRHODREF(JI,JJ,JK)**ZEXP2 &
+ * PRS(JI,JJ,JK,7)**ZEXP1
+ END IF
+ ENDDO
+ ELSE IF (HCLOUD == 'LIMA' .AND. NMOM_H == 2) THEN
+ DO IV = 1, IVALID
+ JI = IGRIDX(IV)
+ JJ = IGRIDY(IV)
+ JK = IGRIDZ(IV)
+ IF( PRS(JI,JJ,JK,7)/PRHODREF(JI,JJ,JK) > XRTMIN_ELEC(7) .AND. &
+ ZCHT(JI,JJ,JK) > 0. .AND. PSVS(JI,JJ,JK,7) /= 0. ) THEN
+ ZLAMBDA = (ZLBH * ZCHT(JI,JJ,JK) / PRS(JI,JJ,JK,7))**ZLBEXH
+ ZRADIUS(IV) = 1. / ZLAMBDA
+ ZCONC(IV) = ZCHT(JI,JJ,JK) * PRHODREF(JI,JJ,JK) ! Number concentration (m-3)
+ ZVIT(IV) = ZFSEDH * ZLAMBDA**(-XDH) * PRHODREF(JI,JJ,JK)**(-ZCEXVT)
+ END IF
+ ENDDO
+ END IF
!
END SELECT
!
@@ -552,8 +852,8 @@ DO IV = 1, IVALID
ZQ = PQVS(JI,JJ,JK) / ZNC
ZX = ZQ / (ZCQD * ZRADI * ZT(IV))
!
- IF(ZX /= 0. .AND. ABS(ZX) <= 20.0) THEN
- IF( ABS(ZX) < 1.0E-15) THEN
+ IF (ZX /= 0. .AND. ABS(ZX) <= 20.0) THEN
+ IF (ABS(ZX) < 1.0E-15) THEN
ZFXP = 1.
ZFXN = 1.
ELSE
@@ -574,7 +874,7 @@ DO IV = 1, IVALID
!
PQPIS(JI,JJ,JK) = PQPIS(JI,JJ,JK) - ZDELPI
PQNIS(JI,JJ,JK) = PQNIS(JI,JJ,JK) - ZDELNI
- PQVS(JI,JJ,JK) = PQVS(JI,JJ,JK) + XECHARGE * (ZDELPI - ZDELNI)
+ PQVS(JI,JJ,JK) = PQVS(JI,JJ,JK) + XECHARGE * (ZDELPI - ZDELNI)
ENDIF
!
!
@@ -620,7 +920,7 @@ DO IV = 1, IVALID
!
PQPIS(JI,JJ,JK) = PQPIS(JI,JJ,JK) - ZDELPI
PQNIS(JI,JJ,JK) = PQNIS(JI,JJ,JK) - ZDELNI
- PQVS(JI,JJ,JK) = PQVS(JI,JJ,JK) + XECHARGE *(ZDELPI - ZDELNI)
+ PQVS(JI,JJ,JK) = PQVS(JI,JJ,JK) + XECHARGE * (ZDELPI - ZDELNI)
END IF
ENDDO
!
diff --git a/src/MNH/ion_bound4drift.f90 b/src/MNH/ion_bound4drift.f90
index 0c2454557b2d446eddfcf6610549afcd8d3c904a..6dfe884eedc1c07e2be1e1dee0f17a6e4f003fb0 100644
--- a/src/MNH/ion_bound4drift.f90
+++ b/src/MNH/ion_bound4drift.f90
@@ -8,11 +8,12 @@ MODULE MODI_ION_BOUND4DRIFT
!
INTERFACE
!
- SUBROUTINE ION_BOUND4DRIFT (HLBCX,HLBCY,PEFIELDU,PEFIELDV,PSVT)
+ SUBROUTINE ION_BOUND4DRIFT (KRR, HLBCX,HLBCY,PEFIELDU,PEFIELDV,PSVT)
-CHARACTER(LEN=4), DIMENSION(2), INTENT(IN) :: HLBCX,HLBCY
+INTEGER, INTENT(IN) :: KRR ! Number of moist variables
+CHARACTER(LEN=4), DIMENSION(2), INTENT(IN) :: HLBCX,HLBCY
REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVT
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PEFIELDU,PEFIELDV
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PEFIELDU,PEFIELDV
!
END SUBROUTINE ION_BOUND4DRIFT
!
@@ -22,7 +23,7 @@ END MODULE MODI_ION_BOUND4DRIFT
!
!
! ####################################################################
- SUBROUTINE ION_BOUND4DRIFT (HLBCX,HLBCY,PEFIELDU,PEFIELDV,PSVT)
+ SUBROUTINE ION_BOUND4DRIFT (KRR, HLBCX,HLBCY,PEFIELDU,PEFIELDV,PSVT)
! ####################################################################
!
!!**** *ION_BOUND4DRIFT* - routine to force the Lateral Boundary Conditions for
@@ -73,9 +74,10 @@ IMPLICIT NONE
!* 0.1 declarations of arguments
!
!
-CHARACTER(LEN=4), DIMENSION(2), INTENT(IN) :: HLBCX,HLBCY
+INTEGER, INTENT(IN) :: KRR ! Number of moist variables
+CHARACTER(LEN=4), DIMENSION(2), INTENT(IN) :: HLBCX,HLBCY
REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVT
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PEFIELDU,PEFIELDV
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PEFIELDU,PEFIELDV
!
!
!* 0.2 declarations of local variables
@@ -100,13 +102,13 @@ CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
IF (LWEST_ll( ) .AND. HLBCX(1)=='OPEN') THEN
!
WHERE ( PEFIELDU(IIB,:,:) <= 0. ) ! OUT(IN)FLOW for POS(NEG) IONS
- PSVT(IIB-1,:,:,NSV_ELECBEG) = MAX( 2.*PSVT(IIB,:,:,NSV_ELECBEG) - &
- PSVT(IIB+1,:,:,NSV_ELECBEG), XSVMIN(NSV_ELECBEG) )
- PSVT(IIB-1,:,:,NSV_ELECEND) = XCION_NEG_FW(IIB,:,:) ! Nb/kg
+ PSVT(IIB-1,:,:,1) = MAX( 2.*PSVT(IIB,:,:,1) - &
+ PSVT(IIB+1,:,:,1), XSVMIN(NSV_ELECBEG) )
+ PSVT(IIB-1,:,:,KRR+1) = XCION_NEG_FW(IIB,:,:) ! Nb/kg
ELSEWHERE ! IN(OUT)FLOW for NEG(POS) IONS
- PSVT(IIB-1,:,:,NSV_ELECBEG) = XCION_POS_FW(IIB,:,:) ! Nb/kg
- PSVT(IIB-1,:,:,NSV_ELECEND) = MAX( 2.*PSVT(IIB,:,:,NSV_ELECEND) - &
- PSVT(IIB+1,:,:,NSV_ELECEND), XSVMIN(NSV_ELECEND) )
+ PSVT(IIB-1,:,:,1) = XCION_POS_FW(IIB,:,:) ! Nb/kg
+ PSVT(IIB-1,:,:,KRR+1) = MAX( 2.*PSVT(IIB,:,:,KRR+1) - &
+ PSVT(IIB+1,:,:,KRR+1), XSVMIN(NSV_ELECEND) )
ENDWHERE
END IF
!
@@ -119,13 +121,13 @@ END IF
IF (LEAST_ll( ) .AND. HLBCX(2)=='OPEN') THEN
!
WHERE ( PEFIELDU(IIE+1,:,:) >= 0. ) ! OUT(IN)FLOW for POS(NEG) IONS
- PSVT(IIE+1,:,:,NSV_ELECBEG) = MAX( 2.*PSVT(IIE,:,:,NSV_ELECBEG) - &
- PSVT(IIE-1,:,:,NSV_ELECBEG), XSVMIN(NSV_ELECBEG) )
- PSVT(IIE+1,:,:,NSV_ELECEND) = XCION_NEG_FW(IIE,:,:) ! Nb/kg
+ PSVT(IIE+1,:,:,1) = MAX( 2.*PSVT(IIE,:,:,1) - &
+ PSVT(IIE-1,:,:,1), XSVMIN(NSV_ELECBEG) )
+ PSVT(IIE+1,:,:,KRR+1) = XCION_NEG_FW(IIE,:,:) ! Nb/kg
ELSEWHERE ! IN(OUT)FLOW for NEG(POS) IONS
- PSVT(IIE+1,:,:,NSV_ELECBEG) = XCION_POS_FW(IIE,:,:) ! Nb/kg
- PSVT(IIE+1,:,:,NSV_ELECEND) = MAX( 2.*PSVT(IIE,:,:,NSV_ELECEND) - &
- PSVT(IIE-1,:,:,NSV_ELECEND), XSVMIN(NSV_ELECEND) )
+ PSVT(IIE+1,:,:,1) = XCION_POS_FW(IIE,:,:) ! Nb/kg
+ PSVT(IIE+1,:,:,KRR+1) = MAX( 2.*PSVT(IIE,:,:,KRR+1) - &
+ PSVT(IIE-1,:,:,KRR+1), XSVMIN(NSV_ELECEND) )
ENDWHERE
END IF
!
@@ -138,13 +140,13 @@ END IF
IF (LSOUTH_ll( ) .AND. HLBCY(1)=='OPEN') THEN
!
WHERE ( PEFIELDV(:,IJB,:) <= 0. ) ! OUT(IN)FLOW for POS(NEG) IONS
- PSVT(:,IJB-1,:,NSV_ELECBEG) = MAX( 2.*PSVT(:,IJB,:,NSV_ELECBEG) - &
- PSVT(:,IJB+1,:,NSV_ELECBEG), XSVMIN(NSV_ELECBEG) )
- PSVT(:,IJB-1,:,NSV_ELECEND) = XCION_NEG_FW(:,IJB,:) ! Nb/kg
+ PSVT(:,IJB-1,:,1) = MAX( 2.*PSVT(:,IJB,:,1) - &
+ PSVT(:,IJB+1,:,1), XSVMIN(NSV_ELECBEG) )
+ PSVT(:,IJB-1,:,KRR+1) = XCION_NEG_FW(:,IJB,:) ! Nb/kg
ELSEWHERE ! IN(OUT)FLOW for NEG(POS) IONS
- PSVT(:,IJB-1,:,NSV_ELECBEG) = XCION_POS_FW(:,IJB,:) ! Nb/kg
- PSVT(:,IJB-1,:,NSV_ELECEND) = MAX( 2.*PSVT(:,IJB,:,NSV_ELECEND) - &
- PSVT(:,IJB+1,:,NSV_ELECEND), XSVMIN(NSV_ELECEND) )
+ PSVT(:,IJB-1,:,1) = XCION_POS_FW(:,IJB,:) ! Nb/kg
+ PSVT(:,IJB-1,:,KRR+1) = MAX( 2.*PSVT(:,IJB,:,KRR+1) - &
+ PSVT(:,IJB+1,:,KRR+1), XSVMIN(NSV_ELECEND) )
ENDWHERE
END IF
!
@@ -157,13 +159,13 @@ END IF
IF (LNORTH_ll( ) .AND. HLBCY(2)=='OPEN') THEN
!
WHERE ( PEFIELDV(:,IJE+1,:) >= 0. ) ! OUT(IN)FLOW for POS(NEG) IONS
- PSVT(:,IJE+1,:,NSV_ELECBEG) = MAX( 2.*PSVT(:,IJE,:,NSV_ELECBEG) - &
- PSVT(:,IJE-1,:,NSV_ELECBEG), XSVMIN(NSV_ELECBEG) )
- PSVT(:,IJE+1,:,NSV_ELECEND) = XCION_NEG_FW(:,IJE,:) ! Nb/kg
+ PSVT(:,IJE+1,:,1) = MAX( 2.*PSVT(:,IJE,:,1) - &
+ PSVT(:,IJE-1,:,1), XSVMIN(NSV_ELECBEG) )
+ PSVT(:,IJE+1,:,KRR+1) = XCION_NEG_FW(:,IJE,:) ! Nb/kg
ELSEWHERE ! IN(OUT)FLOW for NEG(POS) IONS
- PSVT(:,IJE+1,:,NSV_ELECBEG) = XCION_POS_FW(:,IJE,:) ! Nb/kg
- PSVT(:,IJE+1,:,NSV_ELECEND) = MAX( 2.*PSVT(:,IJE,:,NSV_ELECEND) - &
- PSVT(:,IJE-1,:,NSV_ELECEND), XSVMIN(NSV_ELECEND) )
+ PSVT(:,IJE+1,:,1) = XCION_POS_FW(:,IJE,:) ! Nb/kg
+ PSVT(:,IJE+1,:,KRR+1) = MAX( 2.*PSVT(:,IJE,:,KRR+1) - &
+ PSVT(:,IJE-1,:,KRR+1), XSVMIN(NSV_ELECEND) )
ENDWHERE
END IF
!
diff --git a/src/MNH/ion_drift.f90 b/src/MNH/ion_drift.f90
index 7d863c9182faea2b9a54f8ecbf6c2186e74c0578..338b34ea11e40c151585b0009ea41ccf135da4a2 100644
--- a/src/MNH/ion_drift.f90
+++ b/src/MNH/ion_drift.f90
@@ -9,8 +9,9 @@
INTERFACE
!
- SUBROUTINE ION_DRIFT(PDRIFTP, PDRIFTM, PSVT, HLBCX, HLBCY)
+ SUBROUTINE ION_DRIFT(KRR, PDRIFTP, PDRIFTM, PSVT, HLBCX, HLBCY)
!
+INTEGER, INTENT(IN) :: KRR ! Number of moist variables
CHARACTER(LEN=4), DIMENSION(2), INTENT(IN) :: HLBCX,HLBCY
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PDRIFTP, PDRIFTM
REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVT
@@ -19,9 +20,9 @@ END SUBROUTINE ION_DRIFT
END INTERFACE
END MODULE MODI_ION_DRIFT
!
-! ##########################################################
- SUBROUTINE ION_DRIFT(PDRIFTP, PDRIFTM, PSVT, HLBCX, HLBCY)
-! ##########################################################
+! ###############################################################
+ SUBROUTINE ION_DRIFT(KRR, PDRIFTP, PDRIFTM, PSVT, HLBCX, HLBCY)
+! ###############################################################
!
!! PURPOSE
!! -------
@@ -37,6 +38,7 @@ END MODULE MODI_ION_DRIFT
!! M. Chong 01/2010
!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
! P. Wautelet 20/05/2019: add name argument to ADDnFIELD_ll + new ADD4DFIELD_ll subroutine
+! C. Barthe 30/11/2022: change the indexes from nsv_elecbeg/nsv_elecend to 1-krr+1
!
!-------------------------------------------------------------------------------
!
@@ -64,6 +66,7 @@ IMPLICIT NONE
!
!* 0.1 declarations of arguments
!
+INTEGER, INTENT(IN) :: KRR ! Number of moist variableS
CHARACTER(LEN=4), DIMENSION(2), INTENT(IN) :: HLBCX,HLBCY
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PDRIFTP, PDRIFTM
REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVT
@@ -123,22 +126,22 @@ CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
CALL CLEANLIST_ll(TZFIELDS_ll)
!
! specify lateral boundary ion mixing ratio
-CALL ION_BOUND4DRIFT (HLBCX,HLBCY,XEFIELDU,XEFIELDV,PSVT)
+CALL ION_BOUND4DRIFT (KRR,HLBCX,HLBCY,XEFIELDU,XEFIELDV,PSVT)
!
-CALL ADD3DFIELD_ll( TZFIELDS_ll, PSVT(:,:,:,NSV_ELECBEG), 'ION_DRIFT::PSVT(:,:,:,NSV_ELECBEG)' )
-CALL ADD3DFIELD_ll( TZFIELDS_ll, PSVT(:,:,:,NSV_ELECEND), 'ION_DRIFT::PSVT(:,:,:,NSV_ELECEND)' )
+CALL ADD3DFIELD_ll( TZFIELDS_ll, PSVT(:,:,:,1), 'ION_DRIFT::PSVT(:,:,:,1)' )
+CALL ADD3DFIELD_ll( TZFIELDS_ll, PSVT(:,:,:,KRR+1), 'ION_DRIFT::PSVT(:,:,:,KRR+1)' )
CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
CALL CLEANLIST_ll(TZFIELDS_ll)
!
! specify upper boundary ion mixing ratio
WHERE (XEFIELDW(:,:,IKE+1) .GE. 0.) ! Out(In)flow for positive (negative) ions
- PSVT (:,:,IKE+1,NSV_ELECBEG) = MAX(2. * PSVT (:,:,IKE,NSV_ELECBEG) - &
- PSVT (:,:,IKE-1,NSV_ELECBEG),XSVMIN(NSV_ELECBEG))
- PSVT (:,:,IKE+1,NSV_ELECEND) = XCION_NEG_FW(:,:,IKE+1)
+ PSVT (:,:,IKE+1,1) = MAX(2. * PSVT (:,:,IKE,1) - &
+ PSVT (:,:,IKE-1,1),XSVMIN(NSV_ELECBEG))
+ PSVT (:,:,IKE+1,KRR+1) = XCION_NEG_FW(:,:,IKE+1)
ELSE WHERE ! In(Out)flow for positive (negative) ions
- PSVT (:,:,IKE+1,NSV_ELECBEG) = XCION_POS_FW(:,:,IKE+1)
- PSVT (:,:,IKE+1,NSV_ELECEND) = MAX(2.* PSVT (:,:,IKE,NSV_ELECEND) - &
- PSVT (:,:,IKE-1,NSV_ELECEND),XSVMIN(NSV_ELECEND))
+ PSVT (:,:,IKE+1,1) = XCION_POS_FW(:,:,IKE+1)
+ PSVT (:,:,IKE+1,KRR+1) = MAX(2.* PSVT (:,:,IKE,KRR+1) - &
+ PSVT (:,:,IKE-1,KRR+1),XSVMIN(NSV_ELECEND))
END WHERE
!
XEFIELDW(:,:,IKB-1) = XEFIELDW(:,:,IKB)
@@ -152,17 +155,17 @@ XEFIELDW(:,:,IKE+1) = XEFIELDW(:,:,IKE)
!* 3.1 positive ion source (drifting along E)
!
! x-component of div term
-ZDRIFTX(:,:,:) = PSVT(:,:,:,NSV_ELECBEG) * XMOBIL_POS(:,:,:)
+ZDRIFTX(:,:,:) = PSVT(:,:,:,1) * XMOBIL_POS(:,:,:)
ZDRIFTX(:,:,:) = ZDRIFTX(:,:,:) * XEFIELDU(:,:,:)
ZDRIFTX(:,:,:) = -MXM(ZDRIFTX(:,:,:)) ! Put components at flux sides
!
! y-component of div term
-ZDRIFTY(:,:,:) = PSVT(:,:,:,NSV_ELECBEG) * XMOBIL_POS(:,:,:)
+ZDRIFTY(:,:,:) = PSVT(:,:,:,1) * XMOBIL_POS(:,:,:)
ZDRIFTY(:,:,:) = ZDRIFTY(:,:,:) * XEFIELDV(:,:,:)
ZDRIFTY(:,:,:) = -MYM(ZDRIFTY(:,:,:)) ! Put components at flux sides
!
! z-component of div term
-ZDRIFTZ(:,:,:) = PSVT(:,:,:,NSV_ELECBEG) * XMOBIL_POS(:,:,:)
+ZDRIFTZ(:,:,:) = PSVT(:,:,:,1) * XMOBIL_POS(:,:,:)
ZDRIFTZ(:,:,:) = ZDRIFTZ(:,:,:) * XEFIELDW(:,:,:)
ZDRIFTZ(:,:,:) = -MZM(ZDRIFTZ(:,:,:)) ! Put components at flux sides
!
@@ -178,17 +181,17 @@ CALL GDIV(HLBCX,HLBCY,XDXX,XDYY,XDZX,XDZY,XDZZ,ZDRIFTX,ZDRIFTY,ZDRIFTZ,PDRIFTP)
!* 3.2 negative ion source (drifting counter E)
!
! x-component of div term
-ZDRIFTX(:,:,:) = PSVT(:,:,:,NSV_ELECEND) * XMOBIL_NEG(:,:,:)
+ZDRIFTX(:,:,:) = PSVT(:,:,:,KRR+1) * XMOBIL_NEG(:,:,:)
ZDRIFTX(:,:,:) = ZDRIFTX(:,:,:) * XEFIELDU(:,:,:)
ZDRIFTX(:,:,:) = +MXM(ZDRIFTX(:,:,:)) ! Put components at flux sides
!
! y-component of div term
-ZDRIFTY(:,:,:) = PSVT(:,:,:,NSV_ELECEND) * XMOBIL_NEG(:,:,:)
+ZDRIFTY(:,:,:) = PSVT(:,:,:,KRR+1) * XMOBIL_NEG(:,:,:)
ZDRIFTY(:,:,:) = ZDRIFTY(:,:,:) * XEFIELDV(:,:,:)
ZDRIFTY(:,:,:) = +MYM(ZDRIFTY(:,:,:)) ! Put components at flux sides
!
! z-component of div term
-ZDRIFTZ(:,:,:) = PSVT(:,:,:,NSV_ELECEND) * XMOBIL_NEG(:,:,:)
+ZDRIFTZ(:,:,:) = PSVT(:,:,:,KRR+1) * XMOBIL_NEG(:,:,:)
ZDRIFTZ(:,:,:) = ZDRIFTZ(:,:,:) * XEFIELDW(:,:,:)
ZDRIFTZ(:,:,:) = +MZM(ZDRIFTZ(:,:,:)) ! Put components at flux sides
diff --git a/src/MNH/ion_source_elec.f90 b/src/MNH/ion_source_elec.f90
new file mode 100644
index 0000000000000000000000000000000000000000..867fa29b1b05a54156333f17dc9c14dc7698084b
--- /dev/null
+++ b/src/MNH/ion_source_elec.f90
@@ -0,0 +1,136 @@
+! ###########################
+ MODULE MODI_ION_SOURCE_ELEC
+! ###########################
+!
+INTERFACE
+ SUBROUTINE ION_SOURCE_ELEC (KTCOUNT, KRR, HLBCX, HLBCY, &
+ PRHODREF, PRHODJ, PRT, &
+ PSVT, PSVS, &
+ PEFIELDU, PEFIELDV, PEFIELDW)
+!
+INTEGER, INTENT(IN) :: KTCOUNT ! Temporal loop counter
+INTEGER, INTENT(IN) :: KRR ! Number of moist variables
+CHARACTER(LEN=4), DIMENSION(2), INTENT(IN) :: HLBCX,HLBCY ! X and Y-direc. LBC type
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Reference dry air density
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT ! Moist variables at time t
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVT ! Scalar variable at time t
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVS ! Scalar variable sources
+!
+REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(INOUT) :: PEFIELDU ! Electric field
+REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(INOUT) :: PEFIELDV ! components
+REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(INOUT) :: PEFIELDW ! along x, y and z
+!
+END SUBROUTINE ION_SOURCE_ELEC
+END INTERFACE
+END MODULE MODI_ION_SOURCE_ELEC
+!
+! #########################################################
+ SUBROUTINE ION_SOURCE_ELEC (KTCOUNT, KRR, HLBCX, HLBCY, &
+ PRHODREF, PRHODJ, PRT, &
+ PSVT, PSVS, &
+ PEFIELDU, PEFIELDV, PEFIELDW)
+! #########################################################
+!!
+!!**** * - compute the ion source from drift motion and cosmic rays
+!!
+!! AUTHOR
+!! ------
+!! Christelle Barthe * LAERO *
+!! extracted from resolved_elecn in MNH versions < 5-5-0
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 04/02/2022
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+use mode_budget, only: Budget_store_add
+USE MODE_ELEC_ll
+!
+use modd_budget, only: lbudget_sv, NBUDGET_SV1, tbudgets
+USE MODD_NSV, ONLY: NSV_ELECBEG, NSV_ELECEND ! Scalar variables for budgets
+USE MODD_ELEC_DESCR, ONLY: XECHARGE
+USE MODD_ELEC_n, ONLY: XIONSOURCEFW
+!
+USE MODI_ION_DRIFT
+USE MODI_TO_ELEC_FIELD_n
+!
+IMPLICIT NONE
+!
+!* 0.1 Declaration of dummy arguments
+!
+INTEGER, INTENT(IN) :: KTCOUNT ! Temporal loop counter
+INTEGER, INTENT(IN) :: KRR ! Number of moist variables
+CHARACTER(LEN=4), DIMENSION(2), INTENT(IN) :: HLBCX,HLBCY ! X and Y-direc. LBC type
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Reference dry air density
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT ! Moist variables at time t
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVT ! Scalar variable at time t
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVS ! Scalar variable sources
+!
+REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(INOUT) :: PEFIELDU ! Electric field
+REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(INOUT) :: PEFIELDV ! components
+REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(INOUT) :: PEFIELDW ! along x, y and z
+!
+!
+!* 0.2 Declaration of local variables
+!
+REAL, DIMENSION(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3)) :: ZDRIFTP ! positive ion drift
+REAL, DIMENSION(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3)) :: ZDRIFTN ! negative ion drift
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. COMPUTE THE ELECTRIC FIELD AT MASS POINTS
+! -----------------------------------------
+!
+PSVT(:,:,:,1) = XECHARGE * PSVT(:,:,:,1) ! 1/kg --> C/kg
+PSVT(:,:,:,KRR+1) = -XECHARGE * PSVT(:,:,:,KRR+1)
+!
+CALL TO_ELEC_FIELD_n (PRT, PSVT(:,:,:,1:KRR+1), PRHODJ, &
+ KTCOUNT, KRR, &
+ PEFIELDU, PEFIELDV, PEFIELDW )
+!
+PSVT(:,:,:,1) = PSVT(:,:,:,1) / XECHARGE ! back to 1/kg
+PSVT(:,:,:,KRR+1) = -PSVT(:,:,:,KRR+1) / XECHARGE
+!
+!-------------------------------------------------------------------------------
+!
+!* 2. ION SOURCE FROM DRIFT MOTION AND COSMIC RAYS
+! --------------------------------------------
+!
+!* 2.1 Compute source term from -/+(Div (N.mu E)) at mass points,
+! N positive or negative ion number per kg of air (= PSVT)
+! This is a contribution of drift motion to Source PSVS for ions
+! in 1/(kg.s)
+!
+!CALL MYPROC_ELEC_ll (IPROC) ! CB : utile ?
+!
+CALL ION_DRIFT(KRR, ZDRIFTP, ZDRIFTN, PSVT, HLBCX, HLBCY)
+!
+PSVS(:,:,:,1) = PSVS(:,:,:,1) + ZDRIFTP(:,:,:)
+PSVS(:,:,:,KRR+1) = PSVS(:,:,:,KRR+1) + ZDRIFTN(:,:,:)
+!
+if ( lbudget_sv ) then
+ call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg), 'DRIFT', zdriftp(:, :, :) * prhodj(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecend), 'DRIFT', zdriftn(:, :, :) * prhodj(:, :, :) )
+end if
+!
+!
+!* 2.2 Add Cosmic Ray source
+!
+PSVS(:,:,:,1) = PSVS(:,:,:,1) + XIONSOURCEFW(:,:,:) / PRHODREF(:,:,:)
+PSVS(:,:,:,KRR+1) = PSVS(:,:,:,KRR+1) + XIONSOURCEFW(:,:,:) / PRHODREF(:,:,:)
+!
+if ( lbudget_sv ) then
+ call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg), 'CORAY', xionsourcefw(:,:,:)/prhodref(:,:,:) * prhodj(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecend), 'CORAY', xionsourcefw(:,:,:)/prhodref(:,:,:) * prhodj(:, :, :) )
+end if
+!
+END SUBROUTINE ION_SOURCE_ELEC
diff --git a/src/MNH/modd_elec_param.f90 b/src/MNH/modd_elec_param.f90
index d05c1fac6cab10b75e14a3d3722dec7894712f37..c28725b3b8c40eebf2a1e8dc9b9dc4d6cb0afbab 100644
--- a/src/MNH/modd_elec_param.f90
+++ b/src/MNH/modd_elec_param.f90
@@ -18,7 +18,7 @@
!! PURPOSE
!! -------
! The purpose of this declarative module is to declare some precomputed
-! electrical parameters directly used in routine RAIN_ICE_ELEC.
+! electrical parameters directly used in routines related to cloud electricity
!!
!!** IMPLICIT ARGUMENTS
!! ------------------
@@ -35,131 +35,132 @@
!! MODIFICATIONS
!! -------------
!! Original 14/11/02
+!! C. Barthe 31/01/2022 add XFQUPDNCI
+!! C. Barthe 07/06/2022 add parameters for charge sedimentation in LIMA
+!! C. Barthe 28/03/2023 add parameters for sedimentation of cloud droplets charge
+!! C. Barthe 05/07/2023 new data structures for PHYEX - for sedimentation in ICE3
!!
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-REAL, SAVE :: XCOEF_RQ_V, XCOEF_RQ_C, & ! Constants for proportionality
- XCOEF_RQ_R, XCOEF_RQ_I, & ! between mass transfer and
- XCOEF_RQ_S, XCOEF_RQ_G, & ! charge transfer
- XCOEF_RQ_H
-!
-REAL :: XEGMIN, XEGMAX, XESMIN, XESMAX, & ! Max and min values for
- XEIMIN, XEIMAX, XECMIN, XECMAX, & ! e_x in q=e_x D^f_x
- XERMIN, XERMAX, XEHMIN, XEHMAX
-!
-REAL, SAVE :: XQHON ! Constant for spontaneous freezing of droplets if T<-35°
-!
-REAL, SAVE :: XFQSEDR, XEXQSEDR, & ! Constant for sedimentation of rain
- XFQSEDI, XEXQSEDI, & ! ice
- XFQSEDS, XEXQSEDS, & ! snow
- XFQSEDG, XEXQSEDG, & ! graupel
- XFQSEDH, XEXQSEDH ! hail
-REAL, SAVE :: XFCI ! Constant for sedimentation of the mixing ratio of ice
- ! which the computation is modified in regard of rain_ice.f90
-!
-REAL, SAVE :: XQSRIMCG, XEXQSRIMCG ! Constant for riming of cloud droplets
- ! on snow
-REAL, DIMENSION(:), SAVE, ALLOCATABLE :: XGAMINC_RIM3
-!
-REAL, SAVE :: XQRCFRIG, XEXQRCFRIG ! Constant for contact freezing between
- ! raindrops and pristine ice
-REAL, SAVE :: XFQRACCS ! Constant in RACCS
-!
-REAL, SAVE :: XFQIAGGSBH, & ! Constant for IAGGS charging
- XFQIAGGSBG, XEXFQIAGGSBG, & ! process for HELFA, GARDI,
- XFQIAGGSBS, & ! SAUND and TAKAH
- XFQIAGGSBT1, XFQIAGGSBT2, XFQIAGGSBT3
-!
-REAL, SAVE :: XLBQRACCS1, XLBQRACCS2, XLBQRACCS3 ! Integral of normalization
-REAL, SAVE :: XLBQSACCRG1, XLBQSACCRG2, XLBQSACCRG3 ! in accretion of raindrops
- ! on snow process
+USE MODD_PARAMETERS, ONLY: JPMODELMAX
+!
+IMPLICIT NONE
+!
+SAVE
+!
+REAL :: XCOEF_RQ_V, XCOEF_RQ_C, & ! Constants for proportionality
+ XCOEF_RQ_R, XCOEF_RQ_I, & ! between mass transfer and
+ XCOEF_RQ_S, XCOEF_RQ_G, & ! charge transfer
+ XCOEF_RQ_H
+!
+REAL :: XQHON ! Constant for spontaneous freezing of droplets if T<-35°
+!
+REAL, DIMENSION(:), ALLOCATABLE :: XFQSED ! Constant for sedimentation of
+ ! electric charge in LIMA
+REAL, DIMENSION(:), ALLOCATABLE :: XDQ ! Exponent for sedimentation of
+ ! electric charge in LIMA
+REAL :: XFQUPDNCI ! constant used to update e_i for sedimentation where
+ ! N_i follows McFarquhar and Heysmfield (1997)
+!
+REAL :: XQSRIMCG, XEXQSRIMCG ! Constant for riming of cloud droplets
+ ! on snow
+REAL, DIMENSION(:), ALLOCATABLE :: XGAMINC_RIM3
+!
+REAL :: XQRCFRIG, XEXQRCFRIG ! Constant for contact freezing between
+ ! raindrops and pristine ice
+REAL :: XFQRACCS ! Constant in RACCS
+!
+REAL :: XFQIAGGSBH, & ! Constant for IAGGS charging
+ XFQIAGGSBG, XEXFQIAGGSBG, & ! process for HELFA, GARDI,
+ XFQIAGGSBS, & ! SAUND and TAKAH
+ XFQIAGGSBT1, XFQIAGGSBT2, XFQIAGGSBT3
+!
+REAL :: XLBQRACCS1, XLBQRACCS2, XLBQRACCS3 ! Integral of normalization
+REAL :: XLBQSACCRG1, XLBQSACCRG2, XLBQSACCRG3 ! in accretion of raindrops
+ ! on snow process
!
-REAL, DIMENSION(:,:), SAVE, ALLOCATABLE & ! Normalized kernel for
- :: XKER_Q_RACCS, XKER_Q_RACCSS, XKER_Q_SACCRG ! RACCS, RACCSS, SACCRG
+REAL, DIMENSION(:,:), ALLOCATABLE & ! Normalized kernel for
+ :: XKER_Q_RACCS, XKER_Q_RACCSS, XKER_Q_SACCRG ! RACCS, RACCSS, SACCRG
!
-REAL, SAVE :: XFQSDRYG, XFQSDRYGB, XFQRDRYG ! Constant in SDRYG and RDRYG
+REAL :: XFQSDRYG, XFQSDRYGB, XFQRDRYG ! Constant in SDRYG and RDRYG
!
! charge separation
!
-REAL, DIMENSION(:,:), SAVE, ALLOCATABLE :: XKER_Q_LIMSG
-REAL, DIMENSION(:,:), SAVE, ALLOCATABLE &
- :: XKER_Q_SDRYGB, XKER_Q_SDRYGB1, XKER_Q_SDRYGB2
+REAL, DIMENSION(:,:), ALLOCATABLE :: XKER_Q_LIMSG
+REAL, DIMENSION(:,:), ALLOCATABLE :: XKER_Q_SDRYGB, XKER_Q_SDRYGB1, XKER_Q_SDRYGB2
!
! Helsdon-Farley
!
-REAL :: XHIDRYG ! Constant charge separated
-REAL :: XHSDRYG ! Constant charge separated
-REAL, SAVE :: XLBQSDRYGB4H, XLBQSDRYGB5H, XLBQSDRYGB6H ! Constants in QIDRYGB
-REAL, SAVE :: XFQSDRYGBH !
+REAL :: XHIDRYG ! Constant charge separated
+REAL :: XHSDRYG ! Constant charge separated
+REAL :: XLBQSDRYGB4H, XLBQSDRYGB5H, XLBQSDRYGB6H ! Constants in QIDRYGB
+REAL :: XFQSDRYGBH !
!
! Gardiner
!
-REAL, SAVE :: XLWCC ! LWC critic in Gardiner NI charging
-REAL, SAVE :: XFQIDRYGBG, XLBQIDRYGBG ! Constants in QIDRYGB
-REAL, SAVE :: XFQSDRYGBG ! Constants in QSDRYGB
-REAL, SAVE :: XLBQSDRYGB4G, XLBQSDRYGB5G, XLBQSDRYGB6G !
+REAL :: XLWCC ! LWC critic in Gardiner NI charging
+REAL :: XFQIDRYGBG, XLBQIDRYGBG ! Constants in QIDRYGB
+REAL :: XFQSDRYGBG ! Constants in QSDRYGB
+REAL :: XLBQSDRYGB4G, XLBQSDRYGB5G, XLBQSDRYGB6G !
!
! Saunders
!
-REAL, SAVE :: XIMP, XINP, XIKP, & ! Parameters m, n and k
- XIMN, XINN, XIKN, & ! for the NI processes
- XSMP, XSNP, XSKP, & ! following
- XSMN, XSNN, XSKN ! Saunders et al. (1991)
-REAL, SAVE :: XFQIAGGSP, XFQIAGGSN, & ! Auxiliary parameters
- XFQIDRYGBSP, XFQIDRYGBSN, & ! containing MOMG function
- XLBQSDRYGB1SP, XLBQSDRYGB1SN, &
- XLBQSDRYGB2SP, XLBQSDRYGB2SN, &
- XLBQSDRYGB3SP, XLBQSDRYGB3SN, &
- XAIGAMMABI
-REAL, SAVE :: XIKP_TAK, XIKN_TAK, XSKP_TAK, XSKN_TAK ! Using Takahashi charge
-REAL, SAVE :: XFQIAGGSP_TAK, XFQIAGGSN_TAK, XFQIDRYGBSP_TAK, XFQIDRYGBSN_TAK
-REAL, SAVE :: XVSCOEF, XVGCOEF
-REAL, SAVE :: XFQIDRYGBS, XLBQIDRYGBS ! Constants in QIDRYGB
-REAL, SAVE :: XFQSDRYGBS ! Constants in QSDRYGB
-REAL, SAVE :: XLBQSDRYGB1S, XLBQSDRYGB2S !
+REAL :: XIMP, XINP, XIKP, & ! Parameters m, n and k
+ XIMN, XINN, XIKN, & ! for the NI processes
+ XSMP, XSNP, XSKP, & ! following
+ XSMN, XSNN, XSKN ! Saunders et al. (1991)
+REAL :: XFQIAGGSP, XFQIAGGSN, & ! Auxiliary parameters
+ XFQIDRYGBSP, XFQIDRYGBSN, & ! containing MOMG function
+ XLBQSDRYGB1SP, XLBQSDRYGB1SN, &
+ XLBQSDRYGB2SP, XLBQSDRYGB2SN, &
+ XLBQSDRYGB3SP, XLBQSDRYGB3SN, &
+ XAIGAMMABI
+REAL :: XIKP_TAK, XIKN_TAK, XSKP_TAK, XSKN_TAK ! Using Takahashi charge
+REAL :: XFQIAGGSP_TAK, XFQIAGGSN_TAK, XFQIDRYGBSP_TAK, XFQIDRYGBSN_TAK
+REAL :: XVSCOEF, XVGCOEF
+REAL :: XFQIDRYGBS, XLBQIDRYGBS ! Constants in QIDRYGB
+REAL :: XFQSDRYGBS ! Constants in QSDRYGB
+REAL :: XLBQSDRYGB1S, XLBQSDRYGB2S !
!
! Takahashi
!
-INTEGER, SAVE :: NIND_TEMP ! number of indexes for temperature
-INTEGER, SAVE :: NIND_LWC ! number of indexes for liquid water content
-REAL, DIMENSION(:,:), SAVE, ALLOCATABLE :: XMANSELL ! F(LWC, T) for Takahashi(1978) /Mansell
-REAL, DIMENSION(:,:), SAVE, ALLOCATABLE :: XSAUNDER ! F(LWC, T) for SAUN1/SAUN2, BSMP1/BSMP2
-REAL, DIMENSION(:,:), SAVE, ALLOCATABLE :: XTAKA_TM ! F(LWC, T) for Takahashi/Tsenova and Mitzeva
+INTEGER :: NIND_TEMP ! number of indexes for temperature
+INTEGER :: NIND_LWC ! number of indexes for liquid water content
+REAL, DIMENSION(:,:), ALLOCATABLE :: XMANSELL ! F(LWC, T) for Takahashi(1978) /Mansell
+REAL, DIMENSION(:,:), ALLOCATABLE :: XSAUNDER ! F(LWC, T) for SAUN1/SAUN2, BSMP1/BSMP2
+REAL, DIMENSION(:,:), ALLOCATABLE :: XTAKA_TM ! F(LWC, T) for Takahashi/Tsenova and Mitzeva
!
-REAL, SAVE :: XFQIDRYGBT1, XFQIDRYGBT2, XFQIDRYGBT3, & ! IDRYGB
- XFQSDRYGBT1, XFQSDRYGBT2, XFQSDRYGBT3, & ! SDRYGB
- XFQSDRYGBT4, XFQSDRYGBT5, XFQSDRYGBT6, & ! SDRYGB
- XFQSDRYGBT7, XFQSDRYGBT8, XFQSDRYGBT9, & ! SDRYGB
- XFQSDRYGBT10, XFQSDRYGBT11, XFQSDRYGBT12 ! SDRYGB
+REAL :: XFQIDRYGBT1, XFQIDRYGBT2, XFQIDRYGBT3, & ! IDRYGB
+ XFQSDRYGBT1, XFQSDRYGBT2, XFQSDRYGBT3, & ! SDRYGB
+ XFQSDRYGBT4, XFQSDRYGBT5, XFQSDRYGBT6, & ! SDRYGB
+ XFQSDRYGBT7, XFQSDRYGBT8, XFQSDRYGBT9, & ! SDRYGB
+ XFQSDRYGBT10, XFQSDRYGBT11, XFQSDRYGBT12 ! SDRYGB
!
-REAL, SAVE :: XLBQRDRYG1, XLBQRDRYG2, XLBQRDRYG3 ! Integral of normalization in
-REAL, SAVE :: XLBQSDRYG1, XLBQSDRYG2, XLBQSDRYG3 ! the accretion of graupel on
+REAL :: XLBQRDRYG1, XLBQRDRYG2, XLBQRDRYG3 ! Integral of normalization in
+REAL :: XLBQSDRYG1, XLBQSDRYG2, XLBQSDRYG3 ! the accretion of graupel on
! raindrop and snow process
!
-REAL, DIMENSION(:,:), SAVE, ALLOCATABLE &
+REAL, DIMENSION(:,:), ALLOCATABLE &
:: XKER_Q_SDRYG, XKER_Q_RDRYG ! Normalized kernel for SDRYG and RDRYG
!
-REAL, SAVE :: XFQUPDC, XFQUPDR, XFQUPDI,& ! Update Q=f(D)
- XEXFQUPDI, XFQUPDS, XFQUPDG, XFQUPDH
-!
-REAL, SAVE :: XQREVAV1, XQREVAV2 ! Raindrops evaporation
+REAL :: XQREVAV1, XQREVAV2 ! Raindrops evaporation
!
! Add variables to limit the exchanged charge
!
-REAL, SAVE :: XAUX_LIM
-REAL, SAVE :: XAUX_LIM1, XAUX_LIM2, XAUX_LIM3
+REAL :: XAUX_LIM
+REAL :: XAUX_LIM1, XAUX_LIM2, XAUX_LIM3
!
!
! Inductive charging process
!
-REAL, SAVE :: XCOLCG_IND ! collision effiency
-REAL, SAVE :: XEBOUND ! rebound efficiency
-REAL, SAVE :: XALPHA_IND ! fraction of droplets with grazing trajectories
-REAL, SAVE :: XCOS_THETA ! average cosine of the angle of rebounding collision
-REAL, SAVE :: XIND1, XIND2, XIND3
+REAL :: XCOLCG_IND ! collision effiency
+REAL :: XEBOUND ! rebound efficiency
+REAL :: XALPHA_IND ! fraction of droplets with grazing trajectories
+REAL :: XCOS_THETA ! average cosine of the angle of rebounding collision
+REAL :: XIND1, XIND2, XIND3
!
! lightning
!
@@ -168,4 +169,98 @@ REAL :: XFQLIGHTC, XFQLIGHTR, XFQLIGHTI, &
REAL :: XEXQLIGHTR, XEXQLIGHTI, &
XEXQLIGHTS, XEXQLIGHTG, XEXQLIGHTH ! Exponent for charge redistribution
!
-END MODULE MODD_ELEC_PARAM
+! The following variables must be declared with a derived type to match with PHYEX requirements
+TYPE ELEC_PARAM_t
+ REAL :: XFCI ! Constant for sedimentation of the mixing ratio of ice
+ ! which the computation is modified in regard of rain_ice.f90
+ !
+ REAL :: XFQSEDC, XEXQSEDC, & ! Constant for sedimentation of cloud droplets
+ XFQSEDR, XEXQSEDR, & ! rain
+ XFQSEDI, XEXQSEDI, & ! ice
+ XFQSEDS, XEXQSEDS, & ! snow
+ XFQSEDG, XEXQSEDG, & ! graupel
+ XFQSEDH, XEXQSEDH ! hail
+ !
+ REAL :: XEGMIN, XEGMAX, XESMIN, XESMAX, & ! Max and min values for
+ XEIMIN, XEIMAX, XECMIN, XECMAX, & ! e_x in q=e_x D^f_x
+ XERMIN, XERMAX, XEHMIN, XEHMAX
+ !
+ REAL :: XFQUPDC, XFQUPDR, XFQUPDI,& ! Update Q=f(D)
+ XEXFQUPDI, XFQUPDS, XFQUPDG, XFQUPDH
+END TYPE ELEC_PARAM_t
+!
+TYPE(ELEC_PARAM_t), SAVE, TARGET :: ELEC_PARAM
+!
+REAL, POINTER :: XFCI => NULL(), &
+ XFQSEDC => NULL(), &
+ XEXQSEDC => NULL(), &
+ XFQSEDR => NULL(), &
+ XEXQSEDR => NULL(), &
+ XFQSEDI => NULL(), &
+ XEXQSEDI => NULL(), &
+ XFQSEDS => NULL(), &
+ XEXQSEDS => NULL(), &
+ XFQSEDG => NULL(), &
+ XEXQSEDG => NULL(), &
+ XFQSEDH => NULL(), &
+ XEXQSEDH => NULL(), &
+ XEGMIN => NULL(), &
+ XEGMAX => NULL(), &
+ XESMIN => NULL(), &
+ XESMAX => NULL(), &
+ XEIMIN => NULL(), &
+ XEIMAX => NULL(), &
+ XECMIN => NULL(), &
+ XECMAX => NULL(), &
+ XERMIN => NULL(), &
+ XERMAX => NULL(), &
+ XEHMIN => NULL(), &
+ XEHMAX => NULL(), &
+ XFQUPDC => NULL(), &
+ XFQUPDR => NULL(), &
+ XFQUPDI => NULL(), &
+ XEXFQUPDI => NULL(),&
+ XFQUPDS => NULL(), &
+ XFQUPDG => NULL(), &
+ XFQUPDH => NULL()
+!
+CONTAINS
+!
+SUBROUTINE ELEC_PARAM_ASSOCIATE()
+ IMPLICIT NONE
+ !
+ XFCI => ELEC_PARAM%XFCI
+ XFQSEDC => ELEC_PARAM%XFQSEDC
+ XEXQSEDC => ELEC_PARAM%XEXQSEDC
+ XFQSEDR => ELEC_PARAM%XFQSEDR
+ XEXQSEDR => ELEC_PARAM%XEXQSEDR
+ XFQSEDI => ELEC_PARAM%XFQSEDI
+ XEXQSEDI => ELEC_PARAM%XEXQSEDI
+ XFQSEDS => ELEC_PARAM%XFQSEDS
+ XEXQSEDS => ELEC_PARAM%XEXQSEDS
+ XFQSEDG => ELEC_PARAM%XFQSEDG
+ XEXQSEDG => ELEC_PARAM%XEXQSEDG
+ XFQSEDH => ELEC_PARAM%XFQSEDH
+ XEXQSEDH => ELEC_PARAM%XEXQSEDH
+ XEGMIN => ELEC_PARAM%XEGMIN
+ XEGMAX => ELEC_PARAM%XEGMAX
+ XESMIN => ELEC_PARAM%XESMIN
+ XESMAX => ELEC_PARAM%XESMAX
+ XEIMIN => ELEC_PARAM%XEIMIN
+ XEIMAX => ELEC_PARAM%XEIMAX
+ XECMIN => ELEC_PARAM%XECMIN
+ XECMAX => ELEC_PARAM%XECMAX
+ XERMIN => ELEC_PARAM%XERMIN
+ XERMAX => ELEC_PARAM%XERMAX
+ XEHMIN => ELEC_PARAM%XEHMIN
+ XEHMAX => ELEC_PARAM%XEHMAX
+ XFQUPDC => ELEC_PARAM%XFQUPDC
+ XFQUPDR => ELEC_PARAM%XFQUPDR
+ XFQUPDI => ELEC_PARAM%XFQUPDI
+ XEXFQUPDI => ELEC_PARAM%XEXFQUPDI
+ XFQUPDS => ELEC_PARAM%XFQUPDS
+ XFQUPDG => ELEC_PARAM%XFQUPDG
+ XFQUPDH => ELEC_PARAM%XFQUPDH
+END SUBROUTINE ELEC_PARAM_ASSOCIATE
+!
+END MODULE MODD_ELEC_PARAM
diff --git a/src/MNH/mode_elec_beard_effect.f90 b/src/MNH/mode_elec_beard_effect.f90
new file mode 100644
index 0000000000000000000000000000000000000000..b9330bee7720637952c580797a424852cca46ceb
--- /dev/null
+++ b/src/MNH/mode_elec_beard_effect.f90
@@ -0,0 +1,271 @@
+!
+MODULE MODE_ELEC_BEARD_EFFECT
+!
+IMPLICIT NONE
+CONTAINS
+!
+! ###################################################################
+ SUBROUTINE ELEC_BEARD_EFFECT(D, KID, OSEDIM, PT, PRHODREF, &
+ PRX, PQX, PEFIELDW, PLBDA, PBEARDCOEF)
+! ####################################################################
+!
+!! PURPOSE
+!! -------
+!! The purpose of this routine is to compute the effect of the electric field
+!! on the terminal velocity of hydrometeors.
+!!
+!! METHOD
+!! ------
+!! From Beard, K. V., 1980: The Effects of Altitude and Electrical Force on
+!! the Terminal Velocity of Hydrometeors. J. Atmos. Sci., 37, 1363–1374,
+!! https://doi.org/10.1175/1520-0469(1980)037<1363:TEOAAE>2.0.CO;2.
+!!
+!! AUTHOR
+!! ------
+!! J.-P. Pinty * LAERO *
+!! C. Barthe * LAERO *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 21/08/2013 first coded in rain_ice_elec
+!! C. Barthe 01/06/2023 : externalize the code to use it with ICE3 and LIMA
+!! C. Barthe 08/06/2023 : correction by 10-5 of the dynamic viscosity of air
+!! (unecessary for eta0/eta but necessary for Re0)
+!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CST, ONLY: XG, XRD, XP00, XTT
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+USE MODD_ELEC_DESCR, ONLY: XRTMIN_ELEC
+USE MODD_PARAMETERS, ONLY: JPVEXT
+USE MODD_PARAM_LIMA, ONLY: XALPHAC_L=>XALPHAC, XNUC_L=>XNUC, XALPHAR_L=>XALPHAR, XNUR_L=>XNUR, &
+ XALPHAI_L=>XALPHAI, XNUI_L=>XNUI, XALPHAS_L=>XALPHAS, XNUS_L=>XNUS, &
+ XALPHAG_L=>XALPHAG, XNUG_L=>XNUG, &
+ XCEXVT_L=>XCEXVT
+USE MODD_PARAM_LIMA_COLD, ONLY: XBI_L=>XBI, XC_I_L=>XC_I, XDI_L=>XDI, &
+ XBS_L=>XBS, XCS_L=>XCS, XDS_L=>XDS
+USE MODD_PARAM_LIMA_MIXED,ONLY: XBG_L=>XBG, XCG_L=>XCG, XDG_L=>XDG, &
+ XBH_L=>XBH, XCH_L=>XCH, XDH_L=>XDH, &
+ XALPHAH_L=>XALPHAH, XNUH_L=>XNUH
+USE MODD_PARAM_LIMA_WARM, ONLY: XBR_L=>XBR, XCR_L=>XCR, XDR_L=>XDR, &
+ XBC_L=>XBC, XCC_L=>XCC, XDC_L=>XDC
+USE MODD_PARAM_n, ONLY: CCLOUD
+USE MODD_RAIN_ICE_DESCR_n,ONLY: XALPHAC_I=>XALPHAC, XNUC_I=>XNUC, XALPHAR_I=>XALPHAR, XNUR_I=>XNUR, &
+ XALPHAI_I=>XALPHAI, XNUI_I=>XNUI, XALPHAS_I=>XALPHAS, XNUS_I=>XNUS, &
+ XALPHAG_I=>XALPHAG, XNUG_I=>XNUG, XALPHAH_I=>XALPHAH, XNUH_I=>XNUH, &
+ XBC_I=>XBC, XCC_I=>XCC, XDC_I=>XDC, &
+ XBR_I=>XBR, XCR_I=>XCR, XDR_I=>XDR, &
+ XBI_I=>XBI, XC_I_I=>XC_I, XDI_I=>XDI, &
+ XBS_I=>XBS, XCS_I=>XCS, XDS_I=>XDS, &
+ XBG_I=>XBG, XCG_I=>XCG, XDG_I=>XDG, &
+ XBH_I=>XBH, XCH_I=>XCH, XDH_I=>XDH, &
+ XCEXVT_I=>XCEXVT
+USE MODD_REF, ONLY: XTHVREFZ
+!
+USE MODI_MOMG
+!
+USE MODE_TOOLS_ll, ONLY: GET_INDICE_ll
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments
+!
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+INTEGER, INTENT(IN) :: KID ! Hydrometeor ID
+LOGICAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: OSEDIM ! if T, compute the sedim. proc.
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRHODREF ! Reference density
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PT ! Temperature
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRX ! m.r. source
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PQX ! Elec. charge density source
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PEFIELDW ! Vertical component of the electric field
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PLBDA ! Slope param. of the distribution
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT) :: PBEARDCOEF ! Beard coefficient
+!
+!* 0.2 Declarations of local variables
+!
+INTEGER :: JIJ, JK ! loop indexes
+INTEGER :: IIJB, IIJE, IKTB, IKTE
+REAL :: ZCEXVT, ZBX, ZCX, ZDX, ZALPHAX, ZNUX
+REAL :: ZRE0
+REAL :: ZETA0
+REAL :: ZVX
+REAL :: ZK
+REAL :: ZCOR00, ZRHO00
+REAL :: ZT ! Temperature (C)
+REAL :: ZCOR ! To remove the Foote-duToit correction
+REAL :: ZF0, ZF1 ! Coef. in Beard's equation
+real, dimension(D%NIJT,D%NKT) :: zreynolds
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. COMPUTE USEFULL PARAMETERS
+! --------------------------
+!
+IKTB = D%NKTB
+IKTE = D%NKTE
+IIJB = D%NIJB
+IIJE = D%NIJE
+!
+!* 1.1 Select the right parameters
+! --> depend on the microphysics scheme and the hydrometeor species
+!
+IF (CCLOUD(1:3) == 'ICE') THEN
+ ZCEXVT = XCEXVT_I
+ !
+ IF (KID == 2) THEN
+ ZBX = XBC_I
+ ZCX = XCC_I
+ ZDX = XDC_I
+ ZALPHAX = XALPHAC_I
+ ZNUX = XNUC_I
+ ELSE IF (KID == 3) THEN
+ ZBX = XBR_I
+ ZCX = XCR_I
+ ZDX = XDR_I
+ ZALPHAX = XALPHAR_I
+ ZNUX = XNUR_I
+ ELSE IF (KID == 4) THEN
+ ! values for columns are used to be consistent with the McF&H formula
+ ZBX = 1.7
+ ZCX = 2.1E5
+ ZDX = 1.585
+ ZALPHAX = XALPHAI_I
+ ZNUX = XNUI_I
+ ELSE IF (KID == 5) THEN
+ ZBX = XBS_I
+ ZCX = XCS_I
+ ZDX = XDS_I
+ ZALPHAX = XALPHAS_I
+ ZNUX = XNUS_I
+ ELSE IF (KID == 6) THEN
+ ZBX = XBG_I
+ ZCX = XCG_I
+ ZDX = XDG_I
+ ZALPHAX = XALPHAG_I
+ ZNUX = XNUG_I
+ ELSE IF (KID == 7) THEN
+ ZBX = XBH_I
+ ZCX = XCH_I
+ ZDX = XDH_I
+ ZALPHAX = XALPHAH_I
+ ZNUX = XNUH_I
+ END IF
+ELSE IF (CCLOUD == 'LIMA') THEN
+ ZCEXVT = XCEXVT_L
+ !
+ IF (KID == 2) THEN
+ ZBX = XBC_L
+ ZCX = XCC_L
+ ZDX = XDC_L
+ ZALPHAX = XALPHAC_L
+ ZNUX = XNUC_L
+ ELSE IF (KID == 3) THEN
+ ZBX = XBR_L
+ ZCX = XCR_L
+ ZDX = XDR_L
+ ZALPHAX = XALPHAR_L
+ ZNUX = XNUR_L
+ ELSE IF (KID == 4) THEN
+ ZBX = 1.7
+ ZCX = 2.1E5
+ ZDX = 1.585
+ ZALPHAX = XALPHAI_L
+ ZNUX = XNUI_L
+ ELSE IF (KID == 5) THEN
+ ZBX = XBS_L
+ ZCX = XCS_L
+ ZDX = XDS_L
+ ZALPHAX = XALPHAS_L
+ ZNUX = XNUS_L
+ ELSE IF (KID == 6) THEN
+ ZBX = XBG_L
+ ZCX = XCG_L
+ ZDX = XDG_L
+ ZALPHAX = XALPHAG_L
+ ZNUX = XNUG_L
+ ELSE IF (KID == 7) THEN
+ ZBX = XBH_L
+ ZCX = XCH_L
+ ZDX = XDH_L
+ ZALPHAX = XALPHAH_L
+ ZNUX = XNUH_L
+ END IF
+ !
+END IF
+!
+!* 1.2 Parameters from Table 1 in Beard (1980)
+!
+! Reference value of the dynamic viscosity of air
+ZETA0 = (1.718E-5 + 0.0049E-5 * (XTHVREFZ(IKTB) - XTT))
+!
+ZRHO00 = XP00 / (XRD * XTHVREFZ(IKTB))
+ZCOR00 = ZRHO00**ZCEXVT
+!
+! (rho_0 / eta_0) * (v * lambda^d)
+ZVX = (ZRHO00 / ZETA0) * ZCX * MOMG(ZALPHAX,ZNUX,ZBX+ZDX) / MOMG(ZALPHAX,ZNUX,ZBX)
+!
+!-------------------------------------------------------------------------------
+!
+!* 2. COMPUTE THE VELOCITY ADJUSTMENT FACTOR
+! --------------------------------------
+!
+zreynolds(:,:) = 0.
+PBEARDCOEF(:,:) = 1.0
+!
+DO JK = IKTB, IKTE
+ DO JIJ = IIJB, IIJE
+!++cb++ 09/06/23 on n'applique l'effet Beard que pour les points ou le rapport de melange est
+! suffisamment eleve pour eviter que qE >> mg => coef de Beard tres eleve !
+! Ce pb intervient avec ICE3 pour lequel xrtmin est tres bas par rapport a LIMA.
+ IF (OSEDIM(JIJ,JK) .AND. PRX(JIJ,JK) .GT. XRTMIN_ELEC(KID) .AND. PLBDA(JIJ,JK) .GT. 0.) THEN
+!--cb--
+ ! Temperature K --> C
+ ZT = PT(JIJ,JK) - XTT
+ !
+ ! Pre-factor of f_0
+ IF (ZT >= 0.0) THEN
+ ZF0 = ZETA0 / (1.718E-5 + 0.0049E-5 * ZT)
+ ELSE
+ ZF0 = ZETA0 / (1.718E-5 + 0.0049E-5 * ZT - 1.2E-10 * ZT * ZT)
+ END IF
+ !
+ ! Pre-factor of f_infty
+ ZF1 = SQRT(ZRHO00/PRHODREF(JIJ,JK))
+ !
+ ! compute (1 - K) = 1 - qE/mg
+ ZK = 1. - PQX(JIJ,JK) * PEFIELDW(JIJ,JK) / (PRX(JIJ,JK) * XG)
+ !
+ ! Hyp : K_0 ~ 0
+ ! Hyp : si qE > mg, K > 1
+ IF (ZK <= 0.0) THEN
+ PBEARDCOEF(JIJ,JK) = 0. ! levitation
+ ELSE
+ ! Reynolds number
+ ZRE0 = ZVX / PLBDA(JIJ,JK)**(1.+ZDX)
+ zreynolds(jij,jk) = zre0
+ IF (ZRE0 <= 0.2) THEN
+ PBEARDCOEF(JIJ,JK) = ZF0 * ZK
+ ELSE IF (ZRE0 >= 1000.) THEN
+ PBEARDCOEF(JIJ,JK) = ZF1 * SQRT(ZK)
+ ELSE
+ PBEARDCOEF(JIJ,JK) = ZF0 * ZK + &
+ (ZF1 * SQRT(ZK) - ZF0 * ZK) * &
+ (1.61 + LOG(ZRE0)) / 8.52
+ END IF
+ ! remove the Foote-duToit correction
+ ZCOR = (PRHODREF(JIJ,JK) / ZRHO00)**ZCEXVT
+ PBEARDCOEF(JIJ,JK) = PBEARDCOEF(JIJ,JK) * ZCOR
+ END IF
+ ELSE
+ PBEARDCOEF(JIJ,JK) = 1.0 ! No "Beard" effect
+ END IF
+ END DO
+END DO
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE ELEC_BEARD_EFFECT
+END MODULE MODE_ELEC_BEARD_EFFECT
diff --git a/src/MNH/modeln.f90 b/src/MNH/modeln.f90
index 8079f0d349befbd4bfe24c02d47f30d77d1f9ce2..77b062bf3cfd8eb836dee6e2d87523dedc2049ae 100644
--- a/src/MNH/modeln.f90
+++ b/src/MNH/modeln.f90
@@ -284,6 +284,7 @@ END MODULE MODI_MODEL_n
! P. Wautelet 13/01/2023: manage close of backup files outside of MODEL_n
! (useful to close them in reverse model order (child before parent, needed by WRITE_BALLOON_n)
! J. Wurtz 01/2023 : correction for mean in SURFEX outputs
+! C. Barthe 03/02/2022: cloud electrification is now called from resolved_cloud to avoid duplicated routines
!!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -351,10 +352,10 @@ USE MODD_PARAM_C1R3, ONLY: NSEDI => LSEDI, NHHONI => LHHONI
USE MODD_PARAM_C2R2, ONLY: NSEDC => LSEDC, NRAIN => LRAIN, NACTIT => LACTIT,LACTTKE,LDEPOC
USE MODD_PARAMETERS
USE MODD_PARAM_ICE_n, ONLY: LWARM,LSEDIC,LCONVHG,LDEPOSC, CSUBG_AUCV_RC
-USE MODD_PARAM_LIMA, ONLY: MSEDC => LSEDC, NMOM_C, NMOM_R, &
- MACTIT => LACTIT, LSCAV, NMOM_I, &
- MSEDI => LSEDI, MHHONI => LHHONI, NMOM_H, &
- XRTMIN_LIMA=>XRTMIN, MACTTKE=>LACTTKE
+USE MODD_PARAM_LIMA, ONLY: MSEDC => LSEDC, NMOM_C, NMOM_R, &
+ MACTIT => LACTIT, LSCAV, NMOM_I, &
+ MSEDI => LSEDI, MHHONI => LHHONI, NMOM_S, NMOM_G, NMOM_H, &
+ XRTMIN_LIMA=>XRTMIN, MACTTKE=>LACTTKE, LPTSPLIT
USE MODD_PARAM_MFSHALL_n
USE MODD_PARAM_n
USE MODD_PAST_FIELD_n
@@ -1469,7 +1470,7 @@ END IF
IF (CELEC.NE.'NONE' .AND. LRELAX2FW_ION) THEN
CALL RELAX2FW_ION (KTCOUNT, IMI, XTSTEP, XRHODJ, XSVT, NALBOT, &
XALK, LMASK_RELAX, XKWRELAX, XRSVS )
-END IF
+END IF
!
CALL SECOND_MNH2(ZTIME2)
!
@@ -1664,8 +1665,8 @@ XTIME_LES_BU_PROCESS = 0.
CALL MPPDB_CHECK3DM("before ADVEC_METSV:XU/V/W/TH/TKE/T,XRHODJ",PRECISION,&
& XUT, XVT, XWT, XTHT, XTKET,XRHODJ)
CALL ADVECTION_METSV ( TPBAKFILE, CUVW_ADV_SCHEME, &
- CMET_ADV_SCHEME, CSV_ADV_SCHEME, CCLOUD, NSPLIT, &
- LSPLIT_CFL, XSPLIT_CFL, LCFL_WRIT, &
+ CMET_ADV_SCHEME, CSV_ADV_SCHEME, CCLOUD, CELEC, &
+ NSPLIT, LSPLIT_CFL, XSPLIT_CFL, LCFL_WRIT, &
CLBCX, CLBCY, NRR, NSV, TDTCUR, XTSTEP, &
XUT, XVT, XWT, XTHT, XRT, XTKET, XSVT, XPABST, &
XTHVREF, XRHODJ, XDXX, XDYY, XDZZ, XDZX, XDZY, &
@@ -1921,7 +1922,7 @@ ZTIME1 = ZTIME2
XTIME_BU_PROCESS = 0.
XTIME_LES_BU_PROCESS = 0.
!
-IF (CCLOUD /= 'NONE' .AND. CELEC == 'NONE') THEN
+IF (CCLOUD /= 'NONE') THEN
!
IF (CCLOUD == 'C2R2' .OR. CCLOUD == 'KHKO' .OR. CCLOUD == 'C3R5' &
.OR. CCLOUD == "LIMA" ) THEN
@@ -1950,42 +1951,42 @@ IF (CCLOUD /= 'NONE' .AND. CELEC == 'NONE') THEN
ZSEA(:,:) = 0.
ZTOWN(:,:)= 0.
CALL MNHGET_SURF_PARAM_n (PSEA=ZSEA(:,:),PTOWN=ZTOWN(:,:))
- CALL RESOLVED_CLOUD ( CCLOUD, CACTCCN, CSCONV, CMF_CLOUD, NRR, NSPLITR, &
- NSPLITG, IMI, KTCOUNT, &
- CLBCX,CLBCY,TPBAKFILE, CRAD, CTURBDIM, &
- LSUBG_COND,LSIGMAS,CSUBG_AUCV_RC,XTSTEP, &
- XZZ, XRHODJ, XRHODREF, XEXNREF, &
- ZPABST, XTHT,XRT,XSIGS,VSIGQSAT,XMFCONV,XTHM,XRCM, &
- XPABST, XWT_ACT_NUC,XDTHRAD, XRTHS, XRRS, &
- XSVT, XRSVS, &
- XSRCT, XCLDFR,XICEFR, XCIT, &
- LSEDIC,KACTIT, KSEDC, KSEDI, KRAIN, KWARM, KHHONI, &
- LCONVHG, XCF_MF,XRC_MF, XRI_MF, &
- XINPRC,ZINPRC3D,XINPRR, XINPRR3D, XEVAP3D, &
- XINPRS,ZINPRS3D, XINPRG,ZINPRG3D, XINPRH,ZINPRH3D, &
+ CALL RESOLVED_CLOUD ( CCLOUD, CELEC, CACTCCN, CSCONV, CMF_CLOUD, NRR, NSPLITR, &
+ NSPLITG, IMI, KTCOUNT, &
+ CLBCX,CLBCY,TPBAKFILE, CRAD, CTURBDIM, &
+ LSUBG_COND,LSIGMAS,CSUBG_AUCV_RC,XTSTEP, &
+ XZZ, XRHODJ, XRHODREF, XEXNREF, &
+ ZPABST, XTHT,XRT,XSIGS,VSIGQSAT,XMFCONV,XTHM,XRCM, &
+ XPABST, XWT_ACT_NUC,XDTHRAD, XRTHS, XRRS, &
+ XSVT, XRSVS, &
+ XSRCT, XCLDFR,XICEFR, XCIT, &
+ LSEDIC,KACTIT, KSEDC, KSEDI, KRAIN, KWARM, KHHONI, &
+ LCONVHG, XCF_MF,XRC_MF, XRI_MF, &
+ XINPRC,ZINPRC3D,XINPRR, XINPRR3D, XEVAP3D, &
+ 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)
- DEALLOCATE(ZSEA)
+ XINDEP, XSUPSAT, XNACT, XNPRO,XSSPRO, XRAINFR, &
+ XHLC_HRC, XHLC_HCF, XHLI_HRI, XHLI_HCF, &
+ ZSEA, ZTOWN )
+ IF (CELEC == 'NONE') DEALLOCATE(ZTOWN)
+ IF (CELEC == 'NONE') DEALLOCATE(ZSEA)
ELSE
- CALL RESOLVED_CLOUD ( CCLOUD, CACTCCN, CSCONV, CMF_CLOUD, NRR, NSPLITR, &
- NSPLITG, IMI, KTCOUNT, &
- CLBCX,CLBCY,TPBAKFILE, CRAD, CTURBDIM, &
- LSUBG_COND,LSIGMAS,CSUBG_AUCV_RC, &
- XTSTEP,XZZ, XRHODJ, XRHODREF, XEXNREF, &
- ZPABST, XTHT,XRT,XSIGS,VSIGQSAT,XMFCONV,XTHM,XRCM, &
- XPABST, XWT_ACT_NUC,XDTHRAD, XRTHS, XRRS, &
- XSVT, XRSVS, &
- XSRCT, XCLDFR, XICEFR, XCIT, &
- LSEDIC,KACTIT, KSEDC, KSEDI, KRAIN, KWARM, KHHONI, &
- LCONVHG, XCF_MF,XRC_MF, XRI_MF, &
- XINPRC,ZINPRC3D,XINPRR, XINPRR3D, XEVAP3D, &
- XINPRS,ZINPRS3D, XINPRG,ZINPRG3D, XINPRH,ZINPRH3D, &
+ CALL RESOLVED_CLOUD ( CCLOUD, CELEC, CACTCCN, CSCONV, CMF_CLOUD, NRR, NSPLITR, &
+ NSPLITG, IMI, KTCOUNT, &
+ CLBCX,CLBCY,TPBAKFILE, CRAD, CTURBDIM, &
+ LSUBG_COND,LSIGMAS,CSUBG_AUCV_RC, &
+ XTSTEP,XZZ, XRHODJ, XRHODREF, XEXNREF, &
+ ZPABST, XTHT,XRT,XSIGS,VSIGQSAT,XMFCONV,XTHM,XRCM, &
+ XPABST, XWT_ACT_NUC,XDTHRAD, XRTHS, XRRS, &
+ XSVT, XRSVS, &
+ XSRCT, XCLDFR, XICEFR, XCIT, &
+ LSEDIC,KACTIT, KSEDC, KSEDI, KRAIN, KWARM, KHHONI, &
+ LCONVHG, XCF_MF,XRC_MF, XRI_MF, &
+ XINPRC,ZINPRC3D,XINPRR, XINPRR3D, XEVAP3D, &
+ 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 )
+ 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
@@ -2033,60 +2034,131 @@ XT_CLOUD = XT_CLOUD + ZTIME2 - ZTIME1 &
!* 21. CLOUD ELECTRIFICATION AND LIGHTNING FLASHES
! -------------------------------------------
!
+! Cloud electrification is now called directly from resolved_cloud
+! It avoids duplicating microphysics routines.
+! Resolved_elec solves the ion recombination and attachement, and
+! lightning flash triggering and propagation
+!
ZTIME1 = ZTIME2
XTIME_BU_PROCESS = 0.
XTIME_LES_BU_PROCESS = 0.
!
-IF (CELEC /= 'NONE' .AND. (CCLOUD(1:3) == 'ICE')) THEN
- XWT_ACT_NUC(:,:,:) = 0.
-!
- XRTHS_CLD = XRTHS
- XRRS_CLD = XRRS
- XRSVS_CLD = XRSVS
- IF (CSURF=='EXTE') THEN
- ALLOCATE (ZSEA(SIZE(XRHODJ,1),SIZE(XRHODJ,2)))
- ALLOCATE (ZTOWN(SIZE(XRHODJ,1),SIZE(XRHODJ,2)))
- ZSEA(:,:) = 0.
- ZTOWN(:,:)= 0.
- CALL MNHGET_SURF_PARAM_n (PSEA=ZSEA(:,:),PTOWN=ZTOWN(:,:))
- CALL RESOLVED_ELEC_n (CCLOUD, CSCONV, CMF_CLOUD, &
- NRR, NSPLITR, IMI, KTCOUNT, OEXIT, &
- CLBCX, CLBCY, CRAD, CTURBDIM, &
- LSUBG_COND, LSIGMAS,VSIGQSAT,CSUBG_AUCV_RC, &
- XTSTEP, XZZ, XRHODJ, XRHODREF, XEXNREF, &
- ZPABST, XTHT, XRTHS, XWT, XRT, XRRS, &
- XSVT, XRSVS, XCIT, &
- XSIGS, XSRCT, XCLDFR, XMFCONV, XCF_MF, XRC_MF, &
- XRI_MF, LSEDIC, LWARM, &
- XINPRC, XINPRR, XINPRR3D, XEVAP3D, &
- XINPRS, XINPRG, XINPRH, &
- ZSEA, ZTOWN )
- DEALLOCATE(ZTOWN)
- DEALLOCATE(ZSEA)
- ELSE
- CALL RESOLVED_ELEC_n (CCLOUD, CSCONV, CMF_CLOUD, &
- NRR, NSPLITR, IMI, KTCOUNT, OEXIT, &
- CLBCX, CLBCY, CRAD, CTURBDIM, &
- LSUBG_COND, LSIGMAS,VSIGQSAT, CSUBG_AUCV_RC, &
- XTSTEP, XZZ, XRHODJ, XRHODREF, XEXNREF, &
- ZPABST, XTHT, XRTHS, XWT, &
- XRT, XRRS, XSVT, XRSVS, XCIT, &
- XSIGS, XSRCT, XCLDFR, XMFCONV, XCF_MF, XRC_MF, &
- XRI_MF, LSEDIC, LWARM, &
- XINPRC, XINPRR, XINPRR3D, XEVAP3D, &
- XINPRS, XINPRG, XINPRH )
- END IF
- XRTHS_CLD = XRTHS - XRTHS_CLD
- XRRS_CLD = XRRS - XRRS_CLD
- XRSVS_CLD = XRSVS - XRSVS_CLD
-!
- XACPRR = XACPRR + XINPRR * XTSTEP
- IF ((CCLOUD(1:3) == 'ICE' .AND. LSEDIC)) &
- XACPRC = XACPRC + XINPRC * XTSTEP
+IF (CELEC /= 'NONE') THEN !++cb-- ATTENTION : le cas rain_ice_elec n'est pas traite !!!
IF (CCLOUD(1:3) == 'ICE') THEN
- XACPRS = XACPRS + XINPRS * XTSTEP
- XACPRG = XACPRG + XINPRG * XTSTEP
- IF (CCLOUD == 'ICE4') XACPRH = XACPRH + XINPRH * XTSTEP
+ IF (CSURF == 'EXTE') THEN
+ IF (LLNOX_EXPLICIT) THEN
+ CALL RESOLVED_ELEC_n (CCLOUD, NRR, IMI, KTCOUNT, OEXIT, &
+ XTSTEP, XZZ, XRHODJ, XRHODREF, XEXNREF, &
+ ZPABST, XTHT, XWT, XRT, XRRS, &
+ XSVT(:,:,:,NSV_ELECBEG:NSV_ELECEND), &
+ XRSVS(:,:,:,NSV_ELECBEG:NSV_ELECEND), &
+ XCIT, XINPRR, &
+ PSEA=ZSEA, PTOWN=ZTOWN, &
+ PSVS_LNOX=XRSVS(:,:,:,NSV_LNOXBEG) )
+ ELSE
+ CALL RESOLVED_ELEC_n (CCLOUD, NRR, IMI, KTCOUNT, OEXIT, &
+ XTSTEP, XZZ, XRHODJ, XRHODREF, XEXNREF, &
+ ZPABST, XTHT, XWT, XRT, XRRS, &
+ XSVT(:,:,:,NSV_ELECBEG:NSV_ELECEND), &
+ XRSVS(:,:,:,NSV_ELECBEG:NSV_ELECEND), &
+ XCIT, XINPRR, &
+ PSEA=ZSEA, PTOWN=ZTOWN )
+ END IF
+ DEALLOCATE(ZSEA)
+ DEALLOCATE(ZTOWN)
+ ELSE
+ IF (LLNOX_EXPLICIT) THEN
+ CALL RESOLVED_ELEC_n (CCLOUD, NRR, IMI, KTCOUNT, OEXIT, &
+ XTSTEP, XZZ, XRHODJ, XRHODREF, XEXNREF, &
+ ZPABST, XTHT, XWT, XRT, XRRS, &
+ XSVT(:,:,:,NSV_ELECBEG:NSV_ELECEND), &
+ XRSVS(:,:,:,NSV_ELECBEG:NSV_ELECEND), &
+ XCIT, XINPRR, &
+ PSVS_LNOX=XRSVS(:,:,:,NSV_LNOXBEG) )
+ ELSE
+ CALL RESOLVED_ELEC_n (CCLOUD, NRR, IMI, KTCOUNT, OEXIT, &
+ XTSTEP, XZZ, XRHODJ, XRHODREF, XEXNREF, &
+ ZPABST, XTHT, XWT, XRT, XRRS, &
+ XSVT(:,:,:,NSV_ELECBEG:NSV_ELECEND), &
+ XRSVS(:,:,:,NSV_ELECBEG:NSV_ELECEND), &
+ XCIT, XINPRR )
+ END IF
+ END IF
+ ELSE IF (CCLOUD == 'LIMA' .AND. LPTSPLIT) THEN
+ IF (LLNOX_EXPLICIT) THEN
+ IF ((NRR == 6 .AND. NMOM_S == 1 .AND. NMOM_G == 1) .OR. &
+ (NRR == 7 .AND. NMOM_S == 1 .AND. NMOM_G == 1 .AND. NMOM_H == 1)) THEN
+ CALL RESOLVED_ELEC_n (CCLOUD, NRR, IMI, KTCOUNT, OEXIT, &
+ XTSTEP, XZZ, XRHODJ, XRHODREF, XEXNREF, &
+ ZPABST, XTHT, XWT, XRT, XRRS, &
+ XSVT(:,:,:,NSV_ELECBEG:NSV_ELECEND), &
+ XRSVS(:,:,:,NSV_ELECBEG:NSV_ELECEND), &
+ XRSVS(:,:,:,NSV_LIMA_NI), XINPRR, &
+ PCCS=XRSVS(:,:,:,NSV_LIMA_NC), &
+ PCRS=XRSVS(:,:,:,NSV_LIMA_NR), &
+ PSVS_LNOX=XRSVS(:,:,:,NSV_LNOXBEG) )
+ ELSE IF (NRR == 6 .AND. NMOM_S == 2 .AND. NMOM_G == 2) THEN
+ CALL RESOLVED_ELEC_n (CCLOUD, NRR, IMI, KTCOUNT, OEXIT, &
+ XTSTEP, XZZ, XRHODJ, XRHODREF, XEXNREF, &
+ ZPABST, XTHT, XWT, XRT, XRRS, &
+ XSVT(:,:,:,NSV_ELECBEG:NSV_ELECEND), &
+ XRSVS(:,:,:,NSV_ELECBEG:NSV_ELECEND), &
+ XRSVS(:,:,:,NSV_LIMA_NI), XINPRR, &
+ PCCS=XRSVS(:,:,:,NSV_LIMA_NC), &
+ PCRS=XRSVS(:,:,:,NSV_LIMA_NR), &
+ PCSS=XRSVS(:,:,:,NSV_LIMA_NS), &
+ PCGS=XRSVS(:,:,:,NSV_LIMA_NG), &
+ PSVS_LNOX=XRSVS(:,:,:,NSV_LNOXBEG) )
+ ELSE IF (NRR == 7 .AND. NMOM_S == 2 .AND. NMOM_G == 2 .AND. NMOM_H == 2) THEN
+ CALL RESOLVED_ELEC_n (CCLOUD, NRR, IMI, KTCOUNT, OEXIT, &
+ XTSTEP, XZZ, XRHODJ, XRHODREF, XEXNREF, &
+ ZPABST, XTHT, XWT, XRT, XRRS, &
+ XSVT(:,:,:,NSV_ELECBEG:NSV_ELECEND), &
+ XRSVS(:,:,:,NSV_ELECBEG:NSV_ELECEND), &
+ XRSVS(:,:,:,NSV_LIMA_NI), XINPRR, &
+ PCCS=XRSVS(:,:,:,NSV_LIMA_NC), &
+ PCRS=XRSVS(:,:,:,NSV_LIMA_NR), &
+ PCSS=XRSVS(:,:,:,NSV_LIMA_NS), &
+ PCGS=XRSVS(:,:,:,NSV_LIMA_NG), &
+ PCHS=XRSVS(:,:,:,NSV_LIMA_NH), &
+ PSVS_LNOX=XRSVS(:,:,:,NSV_LNOXBEG) )
+ END IF
+ ELSE
+ IF ((NRR == 6 .AND. NMOM_S == 1 .AND. NMOM_G == 1) .OR. &
+ (NRR == 7 .AND. NMOM_S == 1 .AND. NMOM_G == 1 .AND. NMOM_H == 1)) THEN
+ CALL RESOLVED_ELEC_n (CCLOUD, NRR, IMI, KTCOUNT, OEXIT, &
+ XTSTEP, XZZ, XRHODJ, XRHODREF, XEXNREF, &
+ ZPABST, XTHT, XWT, XRT, XRRS, &
+ XSVT(:,:,:,NSV_ELECBEG:NSV_ELECEND), &
+ XRSVS(:,:,:,NSV_ELECBEG:NSV_ELECEND), &
+ XRSVS(:,:,:,NSV_LIMA_NI), XINPRR, &
+ PCCS=XRSVS(:,:,:,NSV_LIMA_NC), &
+ PCRS=XRSVS(:,:,:,NSV_LIMA_NR))
+ ELSE IF (NRR == 6 .AND. NMOM_S == 2 .AND. NMOM_G == 2) THEN
+ CALL RESOLVED_ELEC_n (CCLOUD, NRR, IMI, KTCOUNT, OEXIT, &
+ XTSTEP, XZZ, XRHODJ, XRHODREF, XEXNREF, &
+ ZPABST, XTHT, XWT, XRT, XRRS, &
+ XSVT(:,:,:,NSV_ELECBEG:NSV_ELECEND), &
+ XRSVS(:,:,:,NSV_ELECBEG:NSV_ELECEND), &
+ XRSVS(:,:,:,NSV_LIMA_NI), XINPRR, &
+ PCCS=XRSVS(:,:,:,NSV_LIMA_NC), &
+ PCRS=XRSVS(:,:,:,NSV_LIMA_NR), &
+ PCSS=XRSVS(:,:,:,NSV_LIMA_NS), &
+ PCGS=XRSVS(:,:,:,NSV_LIMA_NG))
+ ELSE IF (NRR == 7 .AND. NMOM_S == 2 .AND. NMOM_G == 2 .AND. NMOM_H == 2) THEN
+ CALL RESOLVED_ELEC_n (CCLOUD, NRR, IMI, KTCOUNT, OEXIT, &
+ XTSTEP, XZZ, XRHODJ, XRHODREF, XEXNREF, &
+ ZPABST, XTHT, XWT, XRT, XRRS, &
+ XSVT(:,:,:,NSV_ELECBEG:NSV_ELECEND), &
+ XRSVS(:,:,:,NSV_ELECBEG:NSV_ELECEND), &
+ XRSVS(:,:,:,NSV_LIMA_NI), XINPRR, &
+ PCCS=XRSVS(:,:,:,NSV_LIMA_NC), &
+ PCRS=XRSVS(:,:,:,NSV_LIMA_NR), &
+ PCSS=XRSVS(:,:,:,NSV_LIMA_NS), &
+ PCGS=XRSVS(:,:,:,NSV_LIMA_NG), &
+ PCHS=XRSVS(:,:,:,NSV_LIMA_NH))
+ END IF
+ END IF
END IF
END IF
!
diff --git a/src/MNH/phys_paramn.f90 b/src/MNH/phys_paramn.f90
index 6ac206daab1f8e77961e803fa395103266fe0737..bd98dacf0a9addaee29c37663fe6150767c04d8c 100644
--- a/src/MNH/phys_paramn.f90
+++ b/src/MNH/phys_paramn.f90
@@ -241,6 +241,7 @@ END MODULE MODI_PHYS_PARAM_n
! P. Wautelet 30/11/2022: compute XTHW_FLUX, XRCW_FLUX and XSVW_FLUX only when needed
! A. Costes 12/2021: add Blaze fire model
! Q. Rodier 2022 : integration with PHYEX
+! C. Barthe 03/2023: add CELEC in call to turbulence
!!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -1638,7 +1639,7 @@ END IF
LCOUPLES, LBLOWSNOW, LIBM,LFLYER, &
GCOMPUTE_SRC, XRSNOW, &
LOCEAN, LDEEPOC, LDIAG_IN_RUN, &
- CTURBLEN_CLOUD, CCLOUD, &
+ CTURBLEN_CLOUD, CCLOUD, CELEC, &
XTSTEP, TPFILE, &
XDXX, XDYY, XDZZ, XDZX, XDZY, XZZ, &
XDIRCOSXW, XDIRCOSYW, XDIRCOSZW, XCOSSLOPE, XSINSLOPE, &
diff --git a/src/MNH/read_exsegn.f90 b/src/MNH/read_exsegn.f90
index 1aa20763f3e5f7718a35250692619d1555dc8b76..c7c48d839fdc5de1b662de0ce34333b460264884 100644
--- a/src/MNH/read_exsegn.f90
+++ b/src/MNH/read_exsegn.f90
@@ -309,6 +309,7 @@ END MODULE MODI_READ_EXSEG_n
! P. Wautelet 24/06/2022: remove check on CSTORAGE_TYPE for restart of ForeFire variables
! P. Wautelet 13/07/2022: add namelist for flyers and balloons
! P. Wautelet 19/08/2022: add namelist for aircrafts
+! C. Barthe 11/07/2023: ELEC: only some combinations of microphysical options are allowed
!------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -393,7 +394,7 @@ USE MODN_PARAM_C1R3, ONLY : NAM_PARAM_C1R3, CPRISTINE_ICE_C1R3, &
USE MODN_PARAM_C2R2, ONLY : EPARAM_CCN=>HPARAM_CCN, EINI_CCN=>HINI_CCN, &
WNUC=>XNUC, WALPHAC=>XALPHAC, NAM_PARAM_C2R2
USE MODN_PARAM_ECRAD_n
-USE MODD_PARAM_ICE_n, ONLY : PARAM_ICEN_INIT, PARAM_ICEN, CSUBG_AUCV_RC, CSUBG_AUCV_RI
+USE MODD_PARAM_ICE_n, ONLY : PARAM_ICEN_INIT, PARAM_ICEN, CSUBG_AUCV_RC, CSUBG_AUCV_RI, LRED, LSNOW_T
USE MODN_PARAM_KAFR_n
USE MODD_PARAM_LIMA, ONLY : FINI_CCN=>HINI_CCN,PARAM_LIMA_INIT,NMOD_CCN,LSCAV, &
CPRISTINE_ICE_LIMA, CHEVRIMED_ICE_LIMA, NMOD_IFN, NMOD_IMM, &
@@ -1787,6 +1788,59 @@ IF (CELEC /= 'NONE') THEN
& "THE ELECTRICAL VARIABLES HAVE BEEN INITIALIZED TO ZERO ")')
CGETSVT(NSV_ELECBEG:NSV_ELECEND)='INIT'
END IF
+ !
+ IF (CCLOUD(1:3) == 'ICE') THEN
+ IF (.NOT. LRED .AND. CELEC == 'ELE3') THEN
+ WRITE(UNIT=ILUOUT,FMT='("THIS IS THE OLD VERSION OF THE ELECTRICAL SCHEME",/,&
+ & "BE AWARE ANOTHER VERSION IS AVAILABLE !")')
+ ELSE IF (LRED .AND. CELEC == 'ELE4') THEN
+ WRITE(UNIT=ILUOUT,FMT='("THIS IS THE NEW VERSION OF THE ELECTRICAL SCHEME",/,&
+ & "BUT WITH THE 1 MOMENT VERSION OF THE MICROPHYSICS SCHEME")')
+ ELSE
+ WRITE(UNIT=ILUOUT,FMT='("THIS VERSION OF THE ELECTRICAL SCHEME IS NOT COMPATIBLE",/,&
+ & "WITH THE ICE3 MICROPHYSICS SCHEME")')
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','') ! error
+ END IF
+ IF (LSNOW_T) THEN
+ WRITE(UNIT=ILUOUT,FMT='("THE ELECTRICAL SCHEME CANNOT BE USED WITH LSNOW_T")')
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','') ! error
+ END IF
+ ELSE IF (CCLOUD == 'LIMA' .AND. LPTSPLIT) THEN
+ IF (CELEC == 'ELE4' .AND. NMOM_C == 2 .AND. NMOM_R == 2 .AND. NMOM_I == 2 .AND. &
+ NMOM_S == 1 .AND. NMOM_G == 1 .AND. NMOM_H == 0) THEN
+ WRITE(UNIT=ILUOUT,FMT='("THE ELECTRICAL SCHEME IS USED WITH",/,&
+ & "THE PARTIAL 2-MOMENT MICROPHYSICS SCHEME LIMA")')
+ ELSE IF (CELEC == 'ELE4' .AND. NMOM_C == 2 .AND. NMOM_R == 2 .AND. NMOM_I == 2 .AND. &
+ NMOM_S == 2 .AND. NMOM_G == 2 .AND. NMOM_H == 0) THEN
+ WRITE(UNIT=ILUOUT,FMT='("THE ELECTRICAL SCHEME IS USED WITH",/,&
+ & "THE FULL 2-MOMENT MICROPHYSICS SCHEME LIMA",/,&
+ & "BE CAREFUL: NOT FULLY VALIDATED !!!")')
+ ELSE IF (CELEC == 'ELE4' .AND. NMOM_C == 2 .AND. NMOM_R == 2 .AND. NMOM_I == 2 .AND. &
+ NMOM_S == 1 .AND. NMOM_G == 1 .AND. NMOM_H == 1) THEN
+ WRITE(UNIT=ILUOUT,FMT='("THE ELECTRICAL SCHEME IS USED WITH",/,&
+ & "THE PARTIAL 2-MOMENT MICROPHYSICS SCHEME LIMA",/,&
+ & "WITH HAIL ACTIVATED",/,&
+ & "BE CAREFUL: NOT TESTED NOR VALIDATED !!!")')
+ ELSE IF (CELEC == 'ELE4' .AND. NMOM_C == 2 .AND. NMOM_R == 2 .AND. NMOM_I == 2 .AND. &
+ NMOM_S == 2 .AND. NMOM_G == 2 .AND. NMOM_H == 2) THEN
+ WRITE(UNIT=ILUOUT,FMT='("THE ELECTRICAL SCHEME IS USED WITH",/,&
+ & "THE FULL 2-MOMENT MICROPHYSICS SCHEME LIMA",/,&
+ & "WITH HAIL ACTIVATED",/,&
+ & "BE CAREFUL: NOT TESTED NOR VALIDATED !!!")')
+ ELSE
+ WRITE(UNIT=ILUOUT,FMT='("THE USE OF THE ELECTRICAL SCHEME IS NOT COMPATIBLE",/,&
+ & "WITH THE OPTIONS OF THE LIMA MICROPHYSICS SCHEME")')
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','') ! error
+ END IF
+ IF (LSNOW_T) THEN
+ WRITE(UNIT=ILUOUT,FMT='("THE ELECTRICAL SCHEME CANNOT BE USED WITH LSNOW_T")')
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','') ! error
+ END IF
+ ELSE
+ WRITE(UNIT=ILUOUT,FMT='("THE ELECTRICAL SCHEME IS NOT COMPATIBLE",/,&
+ & "WITH THE CHOSEN MICROPHYSICS SCHEME")')
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','') ! error
+ END IF
END IF
!
! (explicit) LINOx SV case
diff --git a/src/MNH/resolved_cloud.f90 b/src/MNH/resolved_cloud.f90
index aec42c0535e375182860e9e1ff46049510d13234..03b6d3493db5d41d37ff9f3e0e17c2853d470565 100644
--- a/src/MNH/resolved_cloud.f90
+++ b/src/MNH/resolved_cloud.f90
@@ -7,7 +7,7 @@
MODULE MODI_RESOLVED_CLOUD
! ##########################
INTERFACE
- SUBROUTINE RESOLVED_CLOUD ( HCLOUD, HACTCCN, HSCONV, HMF_CLOUD, &
+ SUBROUTINE RESOLVED_CLOUD ( HCLOUD, HELEC, HACTCCN, HSCONV, HMF_CLOUD, &
KRR, KSPLITR, KSPLITG, KMI, KTCOUNT, &
HLBCX, HLBCY, TPFILE, HRAD, HTURBDIM, &
OSUBG_COND, OSIGMAS, HSUBG_AUCV, &
@@ -30,6 +30,7 @@ INTERFACE
USE MODD_IO, ONLY: TFILEDATA
!
CHARACTER(LEN=4), INTENT(IN) :: HCLOUD ! kind of cloud
+CHARACTER(LEN=4), INTENT(IN) :: HELEC ! kind of electrical scheme
CHARACTER(LEN=4), INTENT(IN) :: HACTCCN ! kind of CCN activation scheme
! paramerization
CHARACTER(LEN=4), INTENT(IN) :: HSCONV ! Shallow convection scheme
@@ -146,8 +147,8 @@ END SUBROUTINE RESOLVED_CLOUD
END INTERFACE
END MODULE MODI_RESOLVED_CLOUD
!
-! ##########################################################################
- SUBROUTINE RESOLVED_CLOUD ( HCLOUD, HACTCCN, HSCONV, HMF_CLOUD, &
+! ##################################################################################
+ SUBROUTINE RESOLVED_CLOUD ( HCLOUD, HELEC, HACTCCN, HSCONV, HMF_CLOUD, &
KRR, KSPLITR, KSPLITG, KMI, KTCOUNT, &
HLBCX, HLBCY, TPFILE, HRAD, HTURBDIM, &
OSUBG_COND, OSIGMAS, HSUBG_AUCV, &
@@ -166,7 +167,7 @@ END MODULE MODI_RESOLVED_CLOUD
PINDEP, PSUPSAT, PNACT, PNPRO,PSSPRO, PRAINFR, &
PHLC_HRC, PHLC_HCF, PHLI_HRI, PHLI_HCF, &
PSEA,PTOWN )
-! ##########################################################################
+! ##################################################################################
!
!!**** * - compute the resolved clouds and precipitation
!!
@@ -284,6 +285,9 @@ END MODULE MODI_RESOLVED_CLOUD
! P. Wautelet 30/06/2020: move removal of negative scalar variables to Sources_neg_correct
! P. Wautelet 30/06/2020: remove non-local corrections
! B. Vie 06/2020: add prognostic supersaturation for LIMA
+! C. Barthe 20/03/2023: to avoid duplicating sources, cloud electrification is integrated in the microphysics
+! CELLS can be used with rain_ice with LRED=T and with LIMA with LPTSPLIT=T
+! the adjustement for cloud electricity is also externalized
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -294,11 +298,16 @@ USE MODD_DUST, ONLY: LDUST
USE MODD_CST, ONLY: CST
USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
USE MODD_DUST , ONLY: LDUST
+USE MODD_ELEC_n, ONLY: XEFIELDU, XEFIELDV, XEFIELDW
+USE MODD_ELEC_DESCR, ONLY: ELEC_DESCR, LSEDIM_BEARD, LIAGGS_LATHAM
+USE MODD_ELEC_PARAM, ONLY: ELEC_PARAM
USE MODD_IO, ONLY: TFILEDATA
USE MODD_NEB_n, ONLY: NEBN, CCONDENS, CLAMBDA3
USE MODD_NSV, ONLY: NSV, NSV_C1R3END, NSV_C2R2BEG, NSV_C2R2END, &
NSV_LIMA_BEG, NSV_LIMA_END, NSV_LIMA_CCN_FREE, NSV_LIMA_IFN_FREE, &
- NSV_LIMA_NC, NSV_LIMA_NI, NSV_LIMA_NR, NSV_AEREND,NSV_DSTEND,NSV_SLTEND
+ NSV_LIMA_NC, NSV_LIMA_NI, NSV_LIMA_NR, &
+ NSV_AEREND, NSV_DSTEND, NSV_SLTEND, &
+ NSV_ELECBEG, NSV_ELECEND
USE MODD_PARAM_C2R2, ONLY: LSUPSAT
USE MODD_PARAMETERS, ONLY: JPHEXT, JPVEXT
USE MODD_PARAM_ICE_n, ONLY: CSEDIM, LADJ_BEFORE, LADJ_AFTER, LRED, PARAM_ICEN
@@ -316,6 +325,7 @@ USE MODI_C2R2_ADJUST
USE MODI_FAST_TERMS
USE MODI_GET_HALO
USE MODI_ICE_ADJUST
+USE MODI_ICE_ADJUST_ELEC
USE MODI_KHKO_NOTADJUST
USE MODI_LIMA
USE MODI_LIMA_ADJUST
@@ -327,9 +337,12 @@ USE MODI_LIMA_WARM
USE MODI_RAIN_C2R2_KHKO
USE MODI_RAIN_ICE
USE MODI_RAIN_ICE_OLD
+USE MODI_RAIN_ICE_ELEC
USE MODI_SHUMAN
USE MODI_SLOW_TERMS
USE MODI_AER2LIMA
+USE MODI_ION_SOURCE_ELEC
+USE MODI_ELEC_ADJUST
!
IMPLICIT NONE
!
@@ -338,6 +351,7 @@ IMPLICIT NONE
!
!
CHARACTER(LEN=4), INTENT(IN) :: HCLOUD ! kind of cloud paramerization
+CHARACTER(LEN=4), INTENT(IN) :: HELEC ! kind of electrical scheme
CHARACTER(LEN=4), INTENT(IN) :: HACTCCN ! kind of CCN activation scheme
CHARACTER(LEN=4), INTENT(IN) :: HSCONV ! Shallow convection scheme
CHARACTER(LEN=4), INTENT(IN) :: HMF_CLOUD! Type of statistical cloud
@@ -493,6 +507,17 @@ REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)):: ZTM
REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2)) :: ZSIGQSAT2D
TYPE(DIMPHYEX_t) :: YLDIMPHYEX
REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)):: ZDUM
+!
+! variables for cloud electricity
+REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)) :: ZCND, ZDEP
+REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)) :: ZRCS_BEF, ZRIS_BEF
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZQCT, ZQRT, ZQIT, ZQST, ZQGT, ZQHT, ZQPIT, ZQNIT
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZQCS, ZQRS, ZQIS, ZQSS, ZQGS, ZQHS, ZQPIS, ZQNIS
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZLATHAM_IAGGS ! E Function to simulate
+ ! enhancement of IAGGS
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZEFIELDW
+LOGICAL :: GELEC ! if true, cloud electrification is activated
+!
ZSIGQSAT2D(:,:) = PSIGQSAT
!
!------------------------------------------------------------------------------
@@ -546,17 +571,17 @@ END IF
!
IF (HCLOUD == 'LIMA' .AND. ((LORILAM).OR.(LDUST).OR.(LSALT))) THEN
! ORILAM : tendance s --> variable instant t
-ALLOCATE(ZSVT(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3),NSV))
+ ALLOCATE(ZSVT(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3),NSV))
DO JSV = 1, NSV
ZSVT(:,:,:,JSV) = PSVS(:,:,:,JSV) * PTSTEP / PRHODJ(:,:,:)
END DO
-CALL AER2LIMA(ZSVT(IIB:IIE,IJB:IJE,IKB:IKE,:),&
- PRHODREF(IIB:IIE,IJB:IJE,IKB:IKE), &
- PRT(IIB:IIE,IJB:IJE,IKB:IKE,1),&
- PPABST(IIB:IIE,IJB:IJE,IKB:IKE),&
- PTHT(IIB:IIE,IJB:IJE,IKB:IKE), &
- PZZ(IIB:IIE,IJB:IJE,IKB:IKE))
+ CALL AER2LIMA(ZSVT(IIB:IIE,IJB:IJE,IKB:IKE,:),&
+ PRHODREF(IIB:IIE,IJB:IJE,IKB:IKE), &
+ PRT(IIB:IIE,IJB:IJE,IKB:IKE,1),&
+ PPABST(IIB:IIE,IJB:IJE,IKB:IKE),&
+ PTHT(IIB:IIE,IJB:IJE,IKB:IKE), &
+ PZZ(IIB:IIE,IJB:IJE,IKB:IKE))
! LIMA : variable instant t --> tendance s
PSVS(:,:,:,NSV_LIMA_CCN_FREE) = ZSVT(:,:,:,NSV_LIMA_CCN_FREE) * &
@@ -570,8 +595,8 @@ CALL AER2LIMA(ZSVT(IIB:IIE,IJB:IJE,IKB:IKE,:),&
PRHODJ(:,:,:) / PTSTEP
PSVS(:,:,:,NSV_LIMA_IFN_FREE+1) = ZSVT(:,:,:,NSV_LIMA_IFN_FREE+1) * &
PRHODJ(:,:,:) / PTSTEP
-
-DEALLOCATE(ZSVT)
+ !
+ DEALLOCATE(ZSVT)
END IF
!UPG*PT
@@ -594,15 +619,15 @@ ENDIF
! complete the lateral boundaries to avoid possible problems
!
DO JI=1,JPHEXT
- PTHS(JI,:,:) = PTHS(IIB,:,:)
- PTHS(IIE+JI,:,:) = PTHS(IIE,:,:)
- PTHS(:,JI,:) = PTHS(:,IJB,:)
- PTHS(:,IJE+JI,:) = PTHS(:,IJE,:)
-!
- PRS(JI,:,:,:) = PRS(IIB,:,:,:)
- PRS(IIE+JI,:,:,:) = PRS(IIE,:,:,:)
- PRS(:,JI,:,:) = PRS(:,IJB,:,:)
- PRS(:,IJE+JI,:,:) = PRS(:,IJE,:,:)
+ PTHS(JI,:,:) = PTHS(IIB,:,:)
+ PTHS(IIE+JI,:,:) = PTHS(IIE,:,:)
+ PTHS(:,JI,:) = PTHS(:,IJB,:)
+ PTHS(:,IJE+JI,:) = PTHS(:,IJE,:)
+!
+ PRS(JI,:,:,:) = PRS(IIB,:,:,:)
+ PRS(IIE+JI,:,:,:) = PRS(IIE,:,:,:)
+ PRS(:,JI,:,:) = PRS(:,IJB,:,:)
+ PRS(:,IJE+JI,:,:) = PRS(:,IJE,:,:)
END DO
!
! complete the physical boundaries to avoid some computations
@@ -647,62 +672,89 @@ IF (HCLOUD == 'C2R2' .OR. HCLOUD == 'C3R5' .OR. HCLOUD == 'KHKO' &
PSVT(:,:,IKE+1,ISVBEG:ISVEND) = PSVT(:,:,IKE,ISVBEG:ISVEND)
ENDIF
!
+! Same thing for cloud electricity
+IF (HELEC(1:3) == 'ELE') THEN
+ ! Transformation into physical tendencies
+ DO JSV = NSV_ELECBEG, NSV_ELECEND
+ PSVS(:,:,:,JSV) = PSVS(:,:,:,JSV) / PRHODJ(:,:,:)
+ ENDDO
+ !
+ ! complete the lateral boundaries to avoid possible problems
+ DO JI = 1, JPHEXT
+ ! positive ion source
+ PSVS(JI,:,:,NSV_ELECBEG) = PSVS(IIB,:,:,NSV_ELECBEG)
+ PSVS(IIE+JI,:,:,NSV_ELECBEG) = PSVS(IIE,:,:,NSV_ELECBEG)
+ PSVS(:,JI,:,NSV_ELECBEG) = PSVS(:,IJB,:,NSV_ELECBEG)
+ PSVS(:,IJE+JI,:,NSV_ELECBEG) = PSVS(:,IJE,:,NSV_ELECBEG)
+ ! source of hydrometeor charge
+ PSVS(JI,:,:,NSV_ELECBEG+1:NSV_ELECEND-1) = 0.0
+ PSVS(IIE+JI,:,:,NSV_ELECBEG+1:NSV_ELECEND-1) = 0.0
+ PSVS(:,JI,:,NSV_ELECBEG+1:NSV_ELECEND-1) = 0.0
+ PSVS(:,IJE+JI,:,NSV_ELECBEG+1:NSV_ELECEND-1) = 0.0
+ ! negative ion source
+ PSVS(JI,:,:,NSV_ELECEND) = PSVS(IIB,:,:,NSV_ELECEND)
+ PSVS(IIE+JI,:,:,NSV_ELECEND) = PSVS(IIE,:,:,NSV_ELECEND)
+ PSVS(:,JI,:,NSV_ELECEND) = PSVS(:,IJB,:,NSV_ELECEND)
+ PSVS(:,IJE+JI,:,NSV_ELECEND) = PSVS(:,IJE,:,NSV_ELECEND)
+ END DO
+ !
+ ! complete the physical boundaries to avoid some computations
+ IF(GWEST .AND. HLBCX(1) /= 'CYCL') PSVT(IIB-1,:,:,NSV_ELECBEG+1:NSV_ELECEND-1) = 0.0
+ IF(GEAST .AND. HLBCX(2) /= 'CYCL') PSVT(IIE+1,:,:,NSV_ELECBEG+1:NSV_ELECEND-1) = 0.0
+ IF(GSOUTH .AND. HLBCY(1) /= 'CYCL') PSVT(:,IJB-1,:,NSV_ELECBEG+1:NSV_ELECEND-1) = 0.0
+ IF(GNORTH .AND. HLBCY(2) /= 'CYCL') PSVT(:,IJE+1,:,NSV_ELECBEG+1:NSV_ELECEND-1) = 0.0
+ !
+ ! complete the vertical boundaries
+ PSVS(:,:,IKB-1,NSV_ELECBEG) = PSVS(:,:,IKB,NSV_ELECBEG) ! Positive ion
+ PSVT(:,:,IKB-1,NSV_ELECBEG) = PSVT(:,:,IKB,NSV_ELECBEG)
+ PSVS(:,:,IKB-1,NSV_ELECBEG+1:NSV_ELECEND-1) = 0.0 ! Hydrometeor charge
+ PSVS(:,:,IKE+1,NSV_ELECBEG+1:NSV_ELECEND-1) = 0.0
+ PSVT(:,:,IKB-1,NSV_ELECBEG+1:NSV_ELECEND-1) = 0.0
+ PSVT(:,:,IKE+1,NSV_ELECBEG+1:NSV_ELECEND-1) = 0.0
+ PSVS(:,:,IKB-1,NSV_ELECEND) = PSVS(:,:,IKB,NSV_ELECEND) ! Negative ion
+ PSVT(:,:,IKB-1,NSV_ELECEND) = PSVT(:,:,IKB,NSV_ELECEND)
+END IF
+!
+!
+!-------------------------------------------------------------------------------
!
!* 3. REMOVE NEGATIVE VALUES
! ----------------------
!
-!* 3.1 Non local correction for precipitating species (Rood 87)
-!
-! IF ( HCLOUD == 'KESS' &
-! .OR. HCLOUD == 'ICE3' .OR. HCLOUD == 'ICE4' &
-! .OR. HCLOUD == 'C2R2' .OR. HCLOUD == 'C3R5' &
-! .OR. HCLOUD == 'KHKO' .OR. HCLOUD == 'LIMA' ) THEN
-! !
-! DO JRR = 3,KRR
-! SELECT CASE (JRR)
-! CASE(3,5,6,7) ! rain, snow, graupel and hail
-!
-! IF ( MIN_ll( PRS(:,:,:,JRR), IINFO_ll) < 0.0 ) THEN
-! !
-! ! compute the total water mass computation
-! !
-! ZMASSTOT = MAX( 0. , SUM3D_ll( PRS(:,:,:,JRR), IINFO_ll ) )
-! !
-! ! remove the negative values
-! !
-! PRS(:,:,:,JRR) = MAX( 0., PRS(:,:,:,JRR) )
-! !
-! ! compute the new total mass
-! !
-! ZMASSPOS = MAX(XMNH_TINY,SUM3D_ll( PRS(:,:,:,JRR), IINFO_ll ) )
-! !
-! ! correct again in such a way to conserve the total mass
-! !
-! ZRATIO = ZMASSTOT / ZMASSPOS
-! PRS(:,:,:,JRR) = PRS(:,:,:,JRR) * ZRATIO
-! !
-! END IF
-! END SELECT
-! END DO
-! END IF
-!
-!* 3.2 Adjustement for liquid and solid cloud
-!
! Remove non-physical negative values (unnecessary in a perfect world) + corresponding budgets
-call Sources_neg_correct( hcloud, 'NEGA', krr, ptstep, ppabst, ptht, prt, pths, prs, psvs, prhodj )
+call Sources_neg_correct( hcloud, helec, 'NEGA', krr, ptstep, ppabst, ptht, prt, pths, prs, psvs, prhodj )
+!
!
-!* 3.4 Limitations of Na and Nc to the CCN max number concentration
+!-------------------------------------------------------------------------------
+!
+!* 4. CLOUD ELECTRICITY
+! -----------------
+!
+!++cb++ 01/06/23
+!IF (HELEC == 'ELE4') &
+IF (HELEC(1:3) == 'ELE') THEN
+!--cb--
+!
+!* 4.1 Ion source from drift motion and cosmic rays
+!
+ CALL ION_SOURCE_ELEC (KTCOUNT, KRR, HLBCX, HLBCY, &
+ PRHODREF, PRHODJ, PRT, &
+ PSVT(:,:,:,NSV_ELECBEG:NSV_ELECEND), &
+ PSVS(:,:,:,NSV_ELECBEG:NSV_ELECEND), &
+ XEFIELDU, XEFIELDV, XEFIELDW )
+!
+!* 4.2 Compute the coefficient that modifies the efficiency of IAGGS
!
-! Commented by O.Thouron 03/2013
-!IF ((HCLOUD == 'C2R2' .OR. HCLOUD == 'C3R5' .OR. HCLOUD == 'KHKO') &
-! .AND.(XCONC_CCN > 0)) THEN
-! IF ((HACTCCN /= 'ABRK')) THEN
-! ZSVT(:,:,:,1) = MIN( ZSVT(:,:,:,1),XCONC_CCN )
-! ZSVT(:,:,:,2) = MIN( ZSVT(:,:,:,2),XCONC_CCN )
-! ZSVS(:,:,:,1) = MIN( ZSVS(:,:,:,1),XCONC_CCN )
-! ZSVS(:,:,:,2) = MIN( ZSVS(:,:,:,2),XCONC_CCN )
-! END IF
-!END IF
+ ALLOCATE(ZLATHAM_IAGGS(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)))
+ IF (LIAGGS_LATHAM) THEN
+ ZLATHAM_IAGGS(:,:,:) = 1.0 + 0.4E-10 * MIN( 2.25E10, &
+ XEFIELDU(:,:,:)**2+XEFIELDV(:,:,:)**2+XEFIELDW(:,:,:)**2 )
+ ELSE
+ ZLATHAM_IAGGS(:,:,:) = 1.0
+ END IF
+ELSE
+ ALLOCATE(ZLATHAM_IAGGS(0,0,0))
+END IF
!
!
!-------------------------------------------------------------------------------
@@ -805,6 +857,13 @@ SELECT CASE ( HCLOUD )
ENDDO
ZZZ = MZF( PZZ )
IF(LRED .AND. LADJ_BEFORE) THEN
+ IF (HELEC == 'ELE4') THEN
+ ! save the cloud droplets and ice crystals m.r. source before adjustement
+ ZRCS_BEF(:,:,:) = PRS(:,:,:,2)
+ ZRIS_BEF(:,:,:) = PRS(:,:,:,4)
+ END IF
+ !
+ ! Performe the saturation ajdustment
CALL ICE_ADJUST (YLDIMPHYEX,CST, RAIN_ICE_PARAMN, NEBN, TURBN, &
PARAM_ICEN, TBUCONF, KRR, &
'ADJU', &
@@ -823,34 +882,171 @@ SELECT CASE ( HCLOUD )
TBUDGETS=TBUDGETS,KBUDGETS=SIZE(TBUDGETS), &
PHLC_HRC=PHLC_HRC, PHLC_HCF=PHLC_HCF, &
PHLI_HRI=PHLI_HRI, PHLI_HCF=PHLI_HCF )
+ !
+ IF (HELEC == 'ELE4') THEN
+ ! Compute the condensation and sublimation rates
+ ZCND(:,:,:) = PRS(:,:,:,2) - ZRCS_BEF(:,:,:)
+ ZDEP(:,:,:) = PRS(:,:,:,4) - ZRIS_BEF(:,:,:)
+ !
+ ! Compute the charge exchanged during evaporation of cloud droplets (negative ZCND) and
+ ! during sublimation of ice crystals (negative ZDEP)
+ CALL ELEC_ADJUST (KRR, PRHODJ, HCLOUD, 'ADJU', &
+ PRC=ZRCS_BEF(:,:,:)*PTSTEP, PRI=ZRIS_BEF(:,:,:)*PTSTEP, &
+ PQC=PSVS(:,:,:,NSV_ELECBEG+1)*PTSTEP, &
+ PQI=PSVS(:,:,:,NSV_ELECBEG+3)*PTSTEP, &
+ PQCS=PSVS(:,:,:,NSV_ELECBEG+1), PQIS=PSVS(:,:,:,NSV_ELECBEG+3),&
+ PQPIS=PSVS(:,:,:,NSV_ELECBEG), PQNIS=PSVS(:,:,:,NSV_ELECEND), &
+ PCND=ZCND, PDEP=ZDEP)
+ END IF
ENDIF
IF (LRED) THEN
- CALL RAIN_ICE (YLDIMPHYEX,CST, PARAM_ICEN, RAIN_ICE_PARAMN, &
- RAIN_ICE_DESCRN, TBUCONF, &
- PTSTEP, KRR, 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, PEVAP3D, &
- PINPRS, PINPRG, PINDEP, PRAINFR, PSIGS, &
- TBUDGETS,SIZE(TBUDGETS), &
- PSEA,PTOWN, PFPR=ZFPR )
+ IF (HELEC == 'ELE4') THEN
+ ! to match with PHYEX, electric charge variables are no more optional, but their size
+ ! depends on the activation (or not) of the electrification scheme
+ GELEC = .TRUE.
+ ALLOCATE(ZQPIT(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)))
+ ALLOCATE(ZQNIT(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)))
+ ALLOCATE(ZQCT(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)))
+ ALLOCATE(ZQRT(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)))
+ ALLOCATE(ZQIT(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)))
+ ALLOCATE(ZQST(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)))
+ ALLOCATE(ZQGT(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)))
+ ALLOCATE(ZQPIS(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)))
+ ALLOCATE(ZQNIS(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)))
+ ALLOCATE(ZQCS(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)))
+ ALLOCATE(ZQRS(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)))
+ ALLOCATE(ZQIS(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)))
+ ALLOCATE(ZQSS(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)))
+ ALLOCATE(ZQGS(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)))
+ ZQPIT(:,:,:) = PSVT(:,:,:,NSV_ELECBEG)
+ ZQCT(:,:,:) = PSVT(:,:,:,NSV_ELECBEG+1)
+ ZQRT(:,:,:) = PSVT(:,:,:,NSV_ELECBEG+2)
+ ZQIT(:,:,:) = PSVT(:,:,:,NSV_ELECBEG+3)
+ ZQST(:,:,:) = PSVT(:,:,:,NSV_ELECBEG+4)
+ ZQGT(:,:,:) = PSVT(:,:,:,NSV_ELECBEG+5)
+ ZQNIT(:,:,:) = PSVT(:,:,:,NSV_ELECEND)
+ ZQPIS(:,:,:) = PSVS(:,:,:,NSV_ELECBEG)
+ ZQCS(:,:,:) = PSVS(:,:,:,NSV_ELECBEG+1)
+ ZQRS(:,:,:) = PSVS(:,:,:,NSV_ELECBEG+2)
+ ZQIS(:,:,:) = PSVS(:,:,:,NSV_ELECBEG+3)
+ ZQSS(:,:,:) = PSVS(:,:,:,NSV_ELECBEG+4)
+ ZQGS(:,:,:) = PSVS(:,:,:,NSV_ELECBEG+5)
+ ZQNIS(:,:,:) = PSVS(:,:,:,NSV_ELECEND)
+ IF (LSEDIM_BEARD) THEN
+ ALLOCATE(ZEFIELDW(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)))
+ ZEFIELDW(:,:,:) = XEFIELDW(:,:,:)
+ ELSE
+ ALLOCATE(ZEFIELDW(0,0,0))
+ END IF
+ ELSE
+ GELEC = .FALSE.
+ ALLOCATE(ZQPIT(0,0,0))
+ ALLOCATE(ZQNIT(0,0,0))
+ ALLOCATE(ZQCT(0,0,0))
+ ALLOCATE(ZQRT(0,0,0))
+ ALLOCATE(ZQIT(0,0,0))
+ ALLOCATE(ZQST(0,0,0))
+ ALLOCATE(ZQGT(0,0,0))
+ ALLOCATE(ZQPIS(0,0,0))
+ ALLOCATE(ZQNIS(0,0,0))
+ ALLOCATE(ZQCS(0,0,0))
+ ALLOCATE(ZQRS(0,0,0))
+ ALLOCATE(ZQIS(0,0,0))
+ ALLOCATE(ZQSS(0,0,0))
+ ALLOCATE(ZQGS(0,0,0))
+ ALLOCATE(ZEFIELDW(0,0,0))
+ END IF
+ ALLOCATE(ZQHT(0,0,0))
+ ALLOCATE(ZQHS(0,0,0))
+ !
+ CALL RAIN_ICE (YLDIMPHYEX,CST, PARAM_ICEN, RAIN_ICE_PARAMN, RAIN_ICE_DESCRN, &
+ ELEC_PARAM, ELEC_DESCR, TBUCONF, 0, .FALSE., &
+ GELEC, LSEDIM_BEARD, &
+ PTSTEP, KRR, 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, PEVAP3D, &
+ PINPRS, PINPRG, PINDEP, PRAINFR, PSIGS, &
+ TBUDGETS,SIZE(TBUDGETS), &
+ ZQPIT, ZQCT, ZQRT, ZQIT, ZQST, ZQGT, ZQNIT, &
+ ZQPIS, ZQCS, ZQRS, ZQIS, ZQSS, ZQGS, ZQNIS, &
+ ZEFIELDW, ZLATHAM_IAGGS, &
+ PSEA,PTOWN, PFPR=ZFPR )
+ !
+ IF (HELEC == 'ELE4') THEN
+ PSVT(:,:,:,NSV_ELECBEG) = ZQPIT(:,:,:)
+ PSVT(:,:,:,NSV_ELECBEG+1) = ZQCT(:,:,:)
+ PSVT(:,:,:,NSV_ELECBEG+2) = ZQRT(:,:,:)
+ PSVT(:,:,:,NSV_ELECBEG+3) = ZQIT(:,:,:)
+ PSVT(:,:,:,NSV_ELECBEG+4) = ZQST(:,:,:)
+ PSVT(:,:,:,NSV_ELECBEG+5) = ZQGT(:,:,:)
+ PSVT(:,:,:,NSV_ELECEND) = ZQNIT(:,:,:)
+ PSVS(:,:,:,NSV_ELECBEG) = ZQPIS(:,:,:)
+ PSVS(:,:,:,NSV_ELECBEG+1) = ZQCS(:,:,:)
+ PSVS(:,:,:,NSV_ELECBEG+2) = ZQRS(:,:,:)
+ PSVS(:,:,:,NSV_ELECBEG+3) = ZQIS(:,:,:)
+ PSVS(:,:,:,NSV_ELECBEG+4) = ZQSS(:,:,:)
+ PSVS(:,:,:,NSV_ELECBEG+5) = ZQGS(:,:,:)
+ PSVS(:,:,:,NSV_ELECEND) = ZQNIS(:,:,:)
+ END IF
+ DEALLOCATE(ZQPIT)
+ DEALLOCATE(ZQNIT)
+ DEALLOCATE(ZQCT)
+ DEALLOCATE(ZQRT)
+ DEALLOCATE(ZQIT)
+ DEALLOCATE(ZQST)
+ DEALLOCATE(ZQGT)
+ DEALLOCATE(ZQHT)
+ DEALLOCATE(ZQPIS)
+ DEALLOCATE(ZQNIS)
+ DEALLOCATE(ZQCS)
+ DEALLOCATE(ZQRS)
+ DEALLOCATE(ZQIS)
+ DEALLOCATE(ZQSS)
+ DEALLOCATE(ZQGS)
+ DEALLOCATE(ZQHS)
+ DEALLOCATE(ZEFIELDW)
+ !
ELSE
- CALL RAIN_ICE_OLD (YLDIMPHYEX, OSEDIC, CSEDIM, HSUBG_AUCV, OWARM, 1, IKU, 1, &
- KSPLITR, PTSTEP, KRR, &
- ZDZZ, PRHODJ, PRHODREF, PEXNREF, PPABST, PCIT, PCLDFR,&
- 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)
+ IF (HELEC == 'ELE3') THEN
+ ! --> old version of the electrification scheme
+ ! Should be removed in a future version of MNH once the new electrification scheme is fully validated
+ ! Compute the explicit microphysical sources and the explicit charging rates
+ CALL RAIN_ICE_ELEC (OSEDIC, HSUBG_AUCV, OWARM, &
+ KSPLITR, PTSTEP, KMI, KRR, &
+ PZZ, PRHODJ, PRHODREF, PEXNREF, PPABST, PCIT, PCLDFR, &
+ 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, &
+ PSVT(:,:,:,NSV_ELECBEG), PSVT(:,:,:,NSV_ELECBEG+1), &
+ PSVT(:,:,:,NSV_ELECBEG+2), PSVT(:,:,:,NSV_ELECBEG+3), &
+ PSVT(:,:,:,NSV_ELECBEG+4), PSVT(:,:,:,NSV_ELECBEG+5), &
+ PSVT(:,:,:,NSV_ELECEND), &
+ PSVS(:,:,:,NSV_ELECBEG), PSVS(:,:,:,NSV_ELECBEG+1), &
+ PSVS(:,:,:,NSV_ELECBEG+2), PSVS(:,:,:,NSV_ELECBEG+3), &
+ PSVS(:,:,:,NSV_ELECBEG+4), PSVS(:,:,:,NSV_ELECBEG+5), &
+ PSVS(:,:,:,NSV_ELECEND), &
+ PSEA, PTOWN )
+ ELSE
+ CALL RAIN_ICE_OLD (YLDIMPHYEX, OSEDIC, CSEDIM, HSUBG_AUCV, OWARM, 1, IKU, 1,&
+ KSPLITR, PTSTEP, KRR, &
+ ZDZZ, PRHODJ, PRHODREF, PEXNREF, PPABST, PCIT, PCLDFR, &
+ 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 )
+ END IF
END IF
!
@@ -858,26 +1054,68 @@ SELECT CASE ( HCLOUD )
!
!
IF (.NOT. LRED .OR. (LRED .AND. LADJ_AFTER) ) THEN
- CALL ICE_ADJUST (YLDIMPHYEX,CST, RAIN_ICE_PARAMN, NEBN, TURBN, &
- PARAM_ICEN, TBUCONF, KRR, &
- 'DEPI', &
- PTSTEP, ZSIGQSAT2D, &
- PRHODJ, PEXNREF, PRHODREF, PSIGS, LMFCONV, PMFCONV,PPABST, ZZZ, &
- ZEXN, PCF_MF, PRC_MF, PRI_MF, &
- ZDUM, ZDUM, ZDUM, ZDUM, ZDUM, &
- PRV=PRS(:,:,:,1)*PTSTEP, PRC=PRS(:,:,:,2)*PTSTEP, &
- PRVS=PRS(:,:,:,1), PRCS=PRS(:,:,:,2), &
- PTH=PTHS*PTSTEP, PTHS=PTHS, &
- OCOMPUTE_SRC=SIZE(PSRCS, 3)/=0, PSRCS=PSRCS, PCLDFR=PCLDFR, &
- PRR=PRS(:,:,:,3)*PTSTEP, &
- PRI=PRS(:,:,:,4)*PTSTEP, PRIS=PRS(:,:,:,4), &
- PRS=PRS(:,:,:,5)*PTSTEP, &
- PRG=PRS(:,:,:,6)*PTSTEP, &
- TBUDGETS=TBUDGETS,KBUDGETS=SIZE(TBUDGETS), &
- PHLC_HRC=PHLC_HRC, PHLC_HCF=PHLC_HCF, &
- PHLI_HRI=PHLI_HRI, PHLI_HCF=PHLI_HCF )
+ IF (HELEC == 'ELE4') THEN
+ ! save the cloud droplets and ice crystals m.r. source before adjustement
+ ZRCS_BEF(:,:,:) = PRS(:,:,:,2)
+ ZRIS_BEF(:,:,:) = PRS(:,:,:,4)
+ END IF
+ !
+ ! Perform the saturation ajdustment
+ IF (HELEC == 'ELE3') THEN
+ ! --> old version of the electrification scheme
+ CALL ICE_ADJUST_ELEC (KRR, KMI, HRAD, HTURBDIM, &
+ HSCONV, HMF_CLOUD, &
+ OSUBG_COND, OSIGMAS, PTSTEP,PSIGQSAT, &
+ PRHODJ, PEXNREF, PSIGS, PPABST, ZZZ, &
+ PMFCONV, PCF_MF, PRC_MF, PRI_MF, &
+ PRT(:,:,:,1), PRT(:,:,:,2), PRS(:,:,:,1), PRS(:,:,:,2), &
+ PTHS, PSRCS, PCLDFR, &
+ PRT(:,:,:,3), PRS(:,:,:,3), PRT(:,:,:,4), PRS(:,:,:,4), &
+ PRT(:,:,:,5), PRS(:,:,:,5), PRT(:,:,:,6), PRS(:,:,:,6), &
+ PSVT(:,:,:,NSV_ELECBEG), PSVS(:,:,:,NSV_ELECBEG), &
+ PSVT(:,:,:,NSV_ELECBEG+1), PSVS(:,:,:,NSV_ELECBEG+1), &
+ PSVT(:,:,:,NSV_ELECBEG+2), PSVS(:,:,:,NSV_ELECBEG+2), &
+ PSVT(:,:,:,NSV_ELECBEG+3), PSVS(:,:,:,NSV_ELECBEG+3), &
+ PSVT(:,:,:,NSV_ELECBEG+4), PSVS(:,:,:,NSV_ELECBEG+4), &
+ PSVT(:,:,:,NSV_ELECBEG+5), PSVS(:,:,:,NSV_ELECBEG+5), &
+ PSVT(:,:,:,NSV_ELECEND), PSVS(:,:,:,NSV_ELECEND) )
+ ELSE
+ CALL ICE_ADJUST (YLDIMPHYEX,CST, RAIN_ICE_PARAMN, NEBN, TURBN, &
+ PARAM_ICEN, TBUCONF, KRR, 'DEPI', &
+ PTSTEP, ZSIGQSAT2D, &
+ PRHODJ, PEXNREF, PRHODREF, PSIGS, LMFCONV, PMFCONV,PPABST, ZZZ, &
+ ZEXN, PCF_MF, PRC_MF, PRI_MF, &
+ ZDUM, ZDUM, ZDUM, ZDUM, ZDUM, &
+ PRV=PRS(:,:,:,1)*PTSTEP, PRC=PRS(:,:,:,2)*PTSTEP, &
+ PRVS=PRS(:,:,:,1), PRCS=PRS(:,:,:,2), &
+ PTH=PTHS*PTSTEP, PTHS=PTHS, &
+ OCOMPUTE_SRC=SIZE(PSRCS, 3)/=0, PSRCS=PSRCS, PCLDFR=PCLDFR, &
+ PRR=PRS(:,:,:,3)*PTSTEP, &
+ PRI=PRS(:,:,:,4)*PTSTEP, PRIS=PRS(:,:,:,4), &
+ PRS=PRS(:,:,:,5)*PTSTEP, &
+ PRG=PRS(:,:,:,6)*PTSTEP, &
+ TBUDGETS=TBUDGETS,KBUDGETS=SIZE(TBUDGETS), &
+ PHLC_HRC=PHLC_HRC, PHLC_HCF=PHLC_HCF, &
+ PHLI_HRI=PHLI_HRI, PHLI_HCF=PHLI_HCF )
+ !
+ IF (HELEC == 'ELE4') THEN
+ ! Compute the condensation and sublimation rates
+ ZCND(:,:,:) = PRS(:,:,:,2) - ZRCS_BEF(:,:,:)
+ ZDEP(:,:,:) = PRS(:,:,:,4) - ZRIS_BEF(:,:,:)
+ !
+ ! Compute the charge exchanged during evaporation of cloud droplets (negative ZCND) and
+ ! during sublimation of ice crystals (negative ZDEP)
+ CALL ELEC_ADJUST (KRR, PRHODJ, HCLOUD, 'DEPI', &
+ PRC=ZRCS_BEF(:,:,:)*PTSTEP, PRI=ZRIS_BEF(:,:,:)*PTSTEP, &
+ PQC=PSVS(:,:,:,NSV_ELECBEG+1)*PTSTEP, &
+ PQI=PSVS(:,:,:,NSV_ELECBEG+3)*PTSTEP, &
+ PQCS=PSVS(:,:,:,NSV_ELECBEG+1), PQIS=PSVS(:,:,:,NSV_ELECBEG+3),&
+ PQPIS=PSVS(:,:,:,NSV_ELECBEG), PQNIS=PSVS(:,:,:,NSV_ELECEND), &
+ PCND=ZCND, PDEP=ZDEP)
+ END IF
+ END IF
END IF
-
+!
deallocate( zexn )
!
CASE ('ICE4')
@@ -896,6 +1134,13 @@ SELECT CASE ( HCLOUD )
ENDDO
ZZZ = MZF( PZZ )
IF(LRED .AND. LADJ_BEFORE) THEN
+ IF (HELEC == 'ELE4') THEN
+ ! save the cloud droplets and ice crystals m.r. source before adjustement
+ ZRCS_BEF(:,:,:) = PRS(:,:,:,2)
+ ZRIS_BEF(:,:,:) = PRS(:,:,:,4)
+ END IF
+ !
+ ! Performe the saturation ajdustment
CALL ICE_ADJUST (YLDIMPHYEX,CST, RAIN_ICE_PARAMN, NEBN, TURBN, &
PARAM_ICEN, TBUCONF, KRR, &
'ADJU', &
@@ -915,23 +1160,143 @@ SELECT CASE ( HCLOUD )
PRH=PRS(:,:,:,7)*PTSTEP, &
PHLC_HRC=PHLC_HRC, PHLC_HCF=PHLC_HCF, &
PHLI_HRI=PHLI_HRI, PHLI_HCF=PHLI_HCF )
+ !
+ IF (HELEC == 'ELE4') THEN
+ ! Compute the condensation and sublimation rates
+ ZCND(:,:,:) = PRS(:,:,:,2) - ZRCS_BEF(:,:,:)
+ ZDEP(:,:,:) = PRS(:,:,:,4) - ZRIS_BEF(:,:,:)
+ !
+ ! Compute the charge exchanged during evaporation of cloud droplets (negative ZCND) and
+ ! during sublimation of ice crystals (negative ZDEP)
+ CALL ELEC_ADJUST (KRR, PRHODJ, HCLOUD, 'ADJU', &
+ PRC=ZRCS_BEF(:,:,:)*PTSTEP, PRI=ZRIS_BEF(:,:,:)*PTSTEP, &
+ PQC=PSVS(:,:,:,NSV_ELECBEG+1)*PTSTEP, &
+ PQI=PSVS(:,:,:,NSV_ELECBEG+3)*PTSTEP, &
+ PQCS=PSVS(:,:,:,NSV_ELECBEG+1), PQIS=PSVS(:,:,:,NSV_ELECBEG+3),&
+ PQPIS=PSVS(:,:,:,NSV_ELECBEG), PQNIS=PSVS(:,:,:,NSV_ELECEND), &
+ PCND=ZCND, PDEP=ZDEP )
+ END IF
ENDIF
IF (LRED) THEN
- CALL RAIN_ICE (YLDIMPHYEX,CST, PARAM_ICEN, RAIN_ICE_PARAMN, &
- RAIN_ICE_DESCRN, TBUCONF, &
- PTSTEP, KRR, 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, PEVAP3D, &
- PINPRS, PINPRG, PINDEP, PRAINFR, PSIGS, &
- TBUDGETS,SIZE(TBUDGETS), &
- PSEA, PTOWN, &
- PRT(:,:,:,7), PRS(:,:,:,7), PINPRH, PFPR=ZFPR )
+ IF (HELEC == 'ELE4') THEN
+ ! to match with PHYEX, electric charge variables are no more optional, but their size
+ ! depends on the activation (or not) of the electrification scheme
+ GELEC = .TRUE.
+ ALLOCATE(ZQPIT(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)))
+ ALLOCATE(ZQNIT(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)))
+ ALLOCATE(ZQCT(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)))
+ ALLOCATE(ZQRT(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)))
+ ALLOCATE(ZQIT(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)))
+ ALLOCATE(ZQST(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)))
+ ALLOCATE(ZQGT(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)))
+ ALLOCATE(ZQHT(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)))
+ ALLOCATE(ZQPIS(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)))
+ ALLOCATE(ZQNIS(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)))
+ ALLOCATE(ZQCS(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)))
+ ALLOCATE(ZQRS(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)))
+ ALLOCATE(ZQIS(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)))
+ ALLOCATE(ZQSS(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)))
+ ALLOCATE(ZQGS(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)))
+ ALLOCATE(ZQHS(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)))
+ ZQPIT(:,:,:) = PSVT(:,:,:,NSV_ELECBEG)
+ ZQCT(:,:,:) = PSVT(:,:,:,NSV_ELECBEG+1)
+ ZQRT(:,:,:) = PSVT(:,:,:,NSV_ELECBEG+2)
+ ZQIT(:,:,:) = PSVT(:,:,:,NSV_ELECBEG+3)
+ ZQST(:,:,:) = PSVT(:,:,:,NSV_ELECBEG+4)
+ ZQGT(:,:,:) = PSVT(:,:,:,NSV_ELECBEG+5)
+ ZQHT(:,:,:) = PSVT(:,:,:,NSV_ELECBEG+6)
+ ZQNIT(:,:,:) = PSVT(:,:,:,NSV_ELECEND)
+ ZQPIS(:,:,:) = PSVS(:,:,:,NSV_ELECBEG)
+ ZQCS(:,:,:) = PSVS(:,:,:,NSV_ELECBEG+1)
+ ZQRS(:,:,:) = PSVS(:,:,:,NSV_ELECBEG+2)
+ ZQIS(:,:,:) = PSVS(:,:,:,NSV_ELECBEG+3)
+ ZQSS(:,:,:) = PSVS(:,:,:,NSV_ELECBEG+4)
+ ZQGS(:,:,:) = PSVS(:,:,:,NSV_ELECBEG+5)
+ ZQHS(:,:,:) = PSVS(:,:,:,NSV_ELECBEG+6)
+ ZQNIS(:,:,:) = PSVS(:,:,:,NSV_ELECEND)
+ IF (LSEDIM_BEARD) THEN
+ ALLOCATE(ZEFIELDW(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)))
+ ZEFIELDW(:,:,:) = XEFIELDW(:,:,:)
+ ELSE
+ ALLOCATE(ZEFIELDW(0,0,0))
+ END IF
+ ELSE
+ GELEC = .FALSE.
+ ALLOCATE(ZQPIT(0,0,0))
+ ALLOCATE(ZQNIT(0,0,0))
+ ALLOCATE(ZQCT(0,0,0))
+ ALLOCATE(ZQRT(0,0,0))
+ ALLOCATE(ZQIT(0,0,0))
+ ALLOCATE(ZQST(0,0,0))
+ ALLOCATE(ZQGT(0,0,0))
+ ALLOCATE(ZQHT(0,0,0))
+ ALLOCATE(ZQPIS(0,0,0))
+ ALLOCATE(ZQNIS(0,0,0))
+ ALLOCATE(ZQCS(0,0,0))
+ ALLOCATE(ZQRS(0,0,0))
+ ALLOCATE(ZQIS(0,0,0))
+ ALLOCATE(ZQSS(0,0,0))
+ ALLOCATE(ZQGS(0,0,0))
+ ALLOCATE(ZQHS(0,0,0))
+ ALLOCATE(ZEFIELDW(0,0,0))
+ END IF
+ !
+ CALL RAIN_ICE (YLDIMPHYEX,CST, PARAM_ICEN, RAIN_ICE_PARAMN, RAIN_ICE_DESCRN, &
+ ELEC_PARAM, ELEC_DESCR, TBUCONF, 0, .FALSE., &
+ GELEC, LSEDIM_BEARD, &
+ PTSTEP, KRR, 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, PEVAP3D, &
+ PINPRS, PINPRG, PINDEP, PRAINFR, PSIGS, &
+ TBUDGETS,SIZE(TBUDGETS), &
+ ZQPIT, ZQCT, ZQRT, ZQIT, ZQST, ZQGT, ZQNIT, &
+ ZQPIS, ZQCS, ZQRS, ZQIS, ZQSS, ZQGS, ZQNIS, &
+ ZEFIELDW, ZLATHAM_IAGGS, &
+ PSEA, PTOWN, &
+ PRT(:,:,:,7), PRS(:,:,:,7), PINPRH, PFPR=ZFPR, &
+ PQHT=ZQHT, PQHS=ZQHS )
+ !
+ IF (HELEC == 'ELE4') THEN
+ PSVT(:,:,:,NSV_ELECBEG) = ZQPIT(:,:,:)
+ PSVT(:,:,:,NSV_ELECBEG+1) = ZQCT(:,:,:)
+ PSVT(:,:,:,NSV_ELECBEG+2) = ZQRT(:,:,:)
+ PSVT(:,:,:,NSV_ELECBEG+3) = ZQIT(:,:,:)
+ PSVT(:,:,:,NSV_ELECBEG+4) = ZQST(:,:,:)
+ PSVT(:,:,:,NSV_ELECBEG+5) = ZQGT(:,:,:)
+ PSVT(:,:,:,NSV_ELECBEG+6) = ZQHT(:,:,:)
+ PSVT(:,:,:,NSV_ELECEND) = ZQNIT(:,:,:)
+ PSVS(:,:,:,NSV_ELECBEG) = ZQPIS(:,:,:)
+ PSVS(:,:,:,NSV_ELECBEG+1) = ZQCS(:,:,:)
+ PSVS(:,:,:,NSV_ELECBEG+2) = ZQRS(:,:,:)
+ PSVS(:,:,:,NSV_ELECBEG+3) = ZQIS(:,:,:)
+ PSVS(:,:,:,NSV_ELECBEG+4) = ZQSS(:,:,:)
+ PSVS(:,:,:,NSV_ELECBEG+5) = ZQGS(:,:,:)
+ PSVS(:,:,:,NSV_ELECBEG+6) = ZQHS(:,:,:)
+ PSVS(:,:,:,NSV_ELECEND) = ZQNIS(:,:,:)
+ END IF
+ DEALLOCATE(ZQPIT)
+ DEALLOCATE(ZQNIT)
+ DEALLOCATE(ZQCT)
+ DEALLOCATE(ZQRT)
+ DEALLOCATE(ZQIT)
+ DEALLOCATE(ZQST)
+ DEALLOCATE(ZQGT)
+ DEALLOCATE(ZQHT)
+ DEALLOCATE(ZQPIS)
+ DEALLOCATE(ZQNIS)
+ DEALLOCATE(ZQCS)
+ DEALLOCATE(ZQRS)
+ DEALLOCATE(ZQIS)
+ DEALLOCATE(ZQSS)
+ DEALLOCATE(ZQGS)
+ DEALLOCATE(ZQHS)
+ DEALLOCATE(ZEFIELDW)
+ !
ELSE
CALL RAIN_ICE_OLD (YLDIMPHYEX, OSEDIC, CSEDIM, HSUBG_AUCV, OWARM, 1, IKU, 1, &
KSPLITR, PTSTEP, KRR, &
@@ -941,36 +1306,57 @@ SELECT CASE ( HCLOUD )
PRT(:,:,:,5), PRT(:,:,:,6), &
PTHS, PRS(:,:,:,1), PRS(:,:,:,2), PRS(:,:,:,3), &
PRS(:,:,:,4), PRS(:,:,:,5), PRS(:,:,:,6), &
- PINPRC,PINPRR, PINPRR3D, PEVAP3D, &
+ PINPRC, PINPRR, PINPRR3D, PEVAP3D, &
PINPRS, PINPRG, PSIGS,PINDEP, PRAINFR, &
PSEA, PTOWN, &
- PRT(:,:,:,7), PRS(:,:,:,7), PINPRH, PFPR=ZFPR)
+ PRT(:,:,:,7), PRS(:,:,:,7), PINPRH, PFPR=ZFPR )
END IF
-
-
+!
!
!* 10.2 Perform the saturation adjustment over cloud ice and cloud water
!
IF (.NOT. LRED .OR. (LRED .AND. LADJ_AFTER) ) THEN
- CALL ICE_ADJUST (YLDIMPHYEX,CST, RAIN_ICE_PARAMN, NEBN, TURBN, &
- PARAM_ICEN, TBUCONF, KRR, &
- 'DEPI', &
- PTSTEP, ZSIGQSAT2D, &
- PRHODJ, PEXNREF, PRHODREF, PSIGS, LMFCONV, PMFCONV,PPABST, ZZZ, &
- ZEXN, PCF_MF, PRC_MF, PRI_MF, &
- ZDUM, ZDUM, ZDUM, ZDUM, ZDUM, &
- PRV=PRS(:,:,:,1)*PTSTEP, PRC=PRS(:,:,:,2)*PTSTEP, &
- PRVS=PRS(:,:,:,1), PRCS=PRS(:,:,:,2), &
- PTH=PTHS*PTSTEP, PTHS=PTHS, &
- OCOMPUTE_SRC=SIZE(PSRCS, 3)/=0, PSRCS=PSRCS, PCLDFR=PCLDFR, &
- PRR=PRS(:,:,:,3)*PTSTEP, &
- PRI=PRS(:,:,:,4)*PTSTEP, PRIS=PRS(:,:,:,4), &
- PRS=PRS(:,:,:,5)*PTSTEP, &
- PRG=PRS(:,:,:,6)*PTSTEP, &
- TBUDGETS=TBUDGETS,KBUDGETS=SIZE(TBUDGETS), &
- PRH=PRS(:,:,:,7)*PTSTEP, &
- PHLC_HRC=PHLC_HRC, PHLC_HCF=PHLC_HCF, &
- PHLI_HRI=PHLI_HRI, PHLI_HCF=PHLI_HCF )
+ IF (HELEC == 'ELE4') THEN
+ ! save the cloud droplets and ice crystals m.r. source before adjustement
+ ZRCS_BEF(:,:,:) = PRS(:,:,:,2)
+ ZRIS_BEF(:,:,:) = PRS(:,:,:,4)
+ END IF
+ !
+ ! Performe the saturation ajdustment
+ CALL ICE_ADJUST (YLDIMPHYEX,CST, RAIN_ICE_PARAMN, NEBN, TURBN, &
+ PARAM_ICEN, TBUCONF, KRR, 'DEPI', &
+ PTSTEP, ZSIGQSAT2D, &
+ PRHODJ, PEXNREF, PRHODREF, PSIGS, LMFCONV, PMFCONV,PPABST, ZZZ, &
+ ZEXN, PCF_MF, PRC_MF, PRI_MF, &
+ ZDUM, ZDUM, ZDUM, ZDUM, ZDUM, &
+ PRV=PRS(:,:,:,1)*PTSTEP, PRC=PRS(:,:,:,2)*PTSTEP, &
+ PRVS=PRS(:,:,:,1), PRCS=PRS(:,:,:,2), &
+ PTH=PTHS*PTSTEP, PTHS=PTHS, &
+ OCOMPUTE_SRC=SIZE(PSRCS, 3)/=0, PSRCS=PSRCS, PCLDFR=PCLDFR, &
+ PRR=PRS(:,:,:,3)*PTSTEP, &
+ PRI=PRS(:,:,:,4)*PTSTEP, PRIS=PRS(:,:,:,4), &
+ PRS=PRS(:,:,:,5)*PTSTEP, &
+ PRG=PRS(:,:,:,6)*PTSTEP, &
+ TBUDGETS=TBUDGETS,KBUDGETS=SIZE(TBUDGETS), &
+ PRH=PRS(:,:,:,7)*PTSTEP, &
+ PHLC_HRC=PHLC_HRC, PHLC_HCF=PHLC_HCF, &
+ PHLI_HRI=PHLI_HRI, PHLI_HCF=PHLI_HCF )
+ !
+ IF (HELEC == 'ELE4') THEN
+ ! Compute the condensation and sublimation rates
+ ZCND(:,:,:) = PRS(:,:,:,2) - ZRCS_BEF(:,:,:)
+ ZDEP(:,:,:) = PRS(:,:,:,4) - ZRIS_BEF(:,:,:)
+ !
+ ! Compute the charge exchanged during evaporation of cloud droplets (negative ZCND) and
+ ! during sublimation of ice crystals (negative ZDEP)
+ CALL ELEC_ADJUST (KRR, PRHODJ, HCLOUD, 'ADJU', &
+ PRC=ZRCS_BEF(:,:,:)*PTSTEP, PRI=ZRIS_BEF(:,:,:)*PTSTEP, &
+ PQC=PSVS(:,:,:,NSV_ELECBEG+1)*PTSTEP, &
+ PQI=PSVS(:,:,:,NSV_ELECBEG+3)*PTSTEP, &
+ PQCS=PSVS(:,:,:,NSV_ELECBEG+1), PQIS=PSVS(:,:,:,NSV_ELECBEG+3),&
+ PQPIS=PSVS(:,:,:,NSV_ELECBEG), PQNIS=PSVS(:,:,:,NSV_ELECEND), &
+ PCND=ZCND, PDEP=ZDEP )
+ END IF
END IF
deallocate( zexn )
@@ -983,14 +1369,21 @@ SELECT CASE ( HCLOUD )
!* 12.1 Compute the explicit microphysical sources
!
CASE ('LIMA')
- !
+ !
+ IF (HELEC == 'ELE4') THEN
+ GELEC = .TRUE.
+ ELSE
+ GELEC = .FALSE.
+ END IF
+ !
DO JK=IKB,IKE
ZDZZ(:,:,JK)=PZZ(:,:,JK+1)-PZZ(:,:,JK)
ENDDO
ZZZ = MZF( PZZ )
- IF (LPTSPLIT) THEN
+ IF (LPTSPLIT) THEN
+ IF (GELEC) THEN
CALL LIMA (YLDIMPHYEX,CST,TBUCONF,TBUDGETS,SIZE(TBUDGETS), &
- PTSTEP, &
+ PTSTEP, GELEC, &
PRHODREF, PEXNREF, ZDZZ, &
PRHODJ, PPABST, &
NMOD_CCN, NMOD_IFN, NMOD_IMM, &
@@ -998,59 +1391,97 @@ SELECT CASE ( HCLOUD )
PSVT(:,:,:,NSV_LIMA_BEG:NSV_LIMA_END), PW_ACT, &
PTHS, PRS, PSVS(:,:,:,NSV_LIMA_BEG:NSV_LIMA_END), &
PINPRC, PINDEP, PINPRR, ZINPRI, PINPRS, PINPRG, PINPRH, &
- PEVAP3D, PCLDFR, PICEFR, PRAINFR, ZFPR )
- ELSE
-
- IF (OWARM) CALL LIMA_WARM(OACTIT, OSEDC, ORAIN, KSPLITR, PTSTEP, KMI, &
- TPFILE, KRR, PZZ, PRHODJ, &
- PRHODREF, PEXNREF, PW_ACT, PPABST, &
- PDTHRAD, &
- PTHT, PRT, PSVT(:,:,:,NSV_LIMA_BEG:NSV_LIMA_END), &
- PTHS, PRS, PSVS(:,:,:,NSV_LIMA_BEG:NSV_LIMA_END), &
- PINPRC, PINPRR, PINDEP, PINPRR3D, PEVAP3D )
-!
- IF (NMOM_I.GE.1) CALL LIMA_COLD(CST, OSEDI, OHHONI, KSPLITG, PTSTEP, KMI, &
- KRR, PZZ, PRHODJ, &
- PRHODREF, PEXNREF, PPABST, PW_ACT, &
- PTHT, PRT, PSVT(:,:,:,NSV_LIMA_BEG:NSV_LIMA_END), &
- PTHS, PRS, PSVS(:,:,:,NSV_LIMA_BEG:NSV_LIMA_END), &
- PINPRS, PINPRG, PINPRH )
-!
- IF (OWARM .AND. NMOM_I.GE.1) CALL LIMA_MIXED(OSEDI, OHHONI, KSPLITG, PTSTEP, KMI, &
- KRR, PZZ, PRHODJ, &
- PRHODREF, PEXNREF, PPABST, PW_ACT, &
- PTHT, PRT, PSVT(:,:,:,NSV_LIMA_BEG:NSV_LIMA_END), &
- PTHS, PRS, PSVS(:,:,:,NSV_LIMA_BEG:NSV_LIMA_END) )
- ENDIF
+ PEVAP3D, PCLDFR, PICEFR, PRAINFR, ZFPR, &
+ ZLATHAM_IAGGS, XEFIELDW, &
+ PSVT(:,:,:,NSV_ELECBEG:NSV_ELECEND), &
+ PSVS(:,:,:,NSV_ELECBEG:NSV_ELECEND) )
+ ELSE
+ CALL LIMA (YLDIMPHYEX,CST,TBUCONF,TBUDGETS,SIZE(TBUDGETS), &
+ PTSTEP, GELEC, &
+ PRHODREF, PEXNREF, ZDZZ, &
+ PRHODJ, PPABST, &
+ NMOD_CCN, NMOD_IFN, NMOD_IMM, &
+ PDTHRAD, PTHT, PRT, &
+ PSVT(:,:,:,NSV_LIMA_BEG:NSV_LIMA_END), PW_ACT, &
+ PTHS, PRS, PSVS(:,:,:,NSV_LIMA_BEG:NSV_LIMA_END), &
+ PINPRC, PINDEP, PINPRR, ZINPRI, PINPRS, PINPRG, PINPRH, &
+ PEVAP3D, PCLDFR, PICEFR, PRAINFR, ZFPR, &
+ ZLATHAM_IAGGS )
+ END IF
+ ELSE
+ IF (OWARM) CALL LIMA_WARM(OACTIT, OSEDC, ORAIN, KSPLITR, PTSTEP, KMI, &
+ TPFILE, KRR, PZZ, PRHODJ, &
+ PRHODREF, PEXNREF, PW_ACT, PPABST, &
+ PDTHRAD, &
+ PTHT, PRT, PSVT(:,:,:,NSV_LIMA_BEG:NSV_LIMA_END), &
+ PTHS, PRS, PSVS(:,:,:,NSV_LIMA_BEG:NSV_LIMA_END), &
+ PINPRC, PINPRR, PINDEP, PINPRR3D, PEVAP3D )
+!
+ IF (NMOM_I.GE.1) CALL LIMA_COLD(CST, OSEDI, OHHONI, KSPLITG, PTSTEP, KMI, &
+ KRR, PZZ, PRHODJ, &
+ PRHODREF, PEXNREF, PPABST, PW_ACT, &
+ PTHT, PRT, PSVT(:,:,:,NSV_LIMA_BEG:NSV_LIMA_END), &
+ PTHS, PRS, PSVS(:,:,:,NSV_LIMA_BEG:NSV_LIMA_END), &
+ PINPRS, PINPRG, PINPRH )
+!
+ IF (OWARM .AND. NMOM_I.GE.1) CALL LIMA_MIXED(OSEDI, OHHONI, KSPLITG, PTSTEP, KMI, &
+ KRR, PZZ, PRHODJ, &
+ PRHODREF, PEXNREF, PPABST, PW_ACT, &
+ PTHT, PRT, PSVT(:,:,:,NSV_LIMA_BEG:NSV_LIMA_END), &
+ PTHS, PRS, PSVS(:,:,:,NSV_LIMA_BEG:NSV_LIMA_END) )
+ ENDIF
!
!* 12.2 Perform the saturation adjustment
!
- IF (LSPRO) THEN
- CALL LIMA_NOTADJUST (KMI, TPFILE, HRAD, &
- PTSTEP, PRHODJ, PPABSTT, PPABST, PRHODREF, PEXNREF, PZZ, &
- PTHT,PRT, PSVT(:,:,:,NSV_LIMA_BEG:NSV_LIMA_END), &
- PTHS,PRS, PSVS(:,:,:,NSV_LIMA_BEG:NSV_LIMA_END), &
- PCLDFR, PICEFR, PRAINFR, PSRCS )
- ELSE IF (LPTSPLIT) THEN
- CALL LIMA_ADJUST_SPLIT(YLDIMPHYEX,CST,TBUCONF,TBUDGETS,SIZE(TBUDGETS), &
- KRR, KMI, CCONDENS, CLAMBDA3, &
- OSUBG_COND, OSIGMAS, PTSTEP, PSIGQSAT, &
- PRHODREF, PRHODJ, PEXNREF, PSIGS, PMFCONV, PPABST, PPABSTT, ZZZ,&
- PDTHRAD, PW_ACT, &
- PRT, PRS, PSVT(:,:,:,NSV_LIMA_BEG:NSV_LIMA_END), &
- PSVS(:,:,:,NSV_LIMA_BEG:NSV_LIMA_END), &
- PTHS, PSRCS, PCLDFR, PICEFR, PRC_MF, PRI_MF, PCF_MF )
- ELSE
- CALL LIMA_ADJUST(KRR, KMI, TPFILE, &
- OSUBG_COND, PTSTEP, &
- PRHODREF, PRHODJ, PEXNREF, PPABST, PPABSTT, &
- PRT, PRS, PSVT(:,:,:,NSV_LIMA_BEG:NSV_LIMA_END), &
- PSVS(:,:,:,NSV_LIMA_BEG:NSV_LIMA_END), &
- PTHS, PSRCS, PCLDFR, PICEFR, PRAINFR )
- ENDIF
+ IF (HELEC == 'ELE4') THEN
+ ! save the cloud droplets and ice crystals m.r. source before adjustement
+ ZRCS_BEF(:,:,:) = PRS(:,:,:,2)
+ ZRIS_BEF(:,:,:) = PRS(:,:,:,4)
+ END IF
+ !
+ IF (LSPRO) THEN
+ CALL LIMA_NOTADJUST (KMI, TPFILE, HRAD, &
+ PTSTEP, PRHODJ, PPABSTT, PPABST, PRHODREF, PEXNREF, PZZ, &
+ PTHT,PRT, PSVT(:,:,:,NSV_LIMA_BEG:NSV_LIMA_END), &
+ PTHS,PRS, PSVS(:,:,:,NSV_LIMA_BEG:NSV_LIMA_END), &
+ PCLDFR, PICEFR, PRAINFR, PSRCS )
+ ELSE IF (LPTSPLIT) THEN
+ CALL LIMA_ADJUST_SPLIT(YLDIMPHYEX, CST, TBUCONF,TBUDGETS,SIZE(TBUDGETS), &
+ KRR, KMI, CCONDENS, CLAMBDA3, &
+ OSUBG_COND, OSIGMAS, PTSTEP, PSIGQSAT, &
+ PRHODREF, PRHODJ, PEXNREF, PSIGS, PMFCONV, PPABST, PPABSTT, ZZZ,&
+ PDTHRAD, PW_ACT, &
+ PRT, PRS, PSVT(:,:,:,NSV_LIMA_BEG:NSV_LIMA_END), &
+ PSVS(:,:,:,NSV_LIMA_BEG:NSV_LIMA_END), &
+ PTHS, PSRCS, PCLDFR, PICEFR, PRC_MF, PRI_MF, PCF_MF )
+ ELSE
+ CALL LIMA_ADJUST(KRR, KMI, TPFILE, &
+ OSUBG_COND, PTSTEP, &
+ PRHODREF, PRHODJ, PEXNREF, PPABST, PPABSTT, &
+ PRT, PRS, PSVT(:,:,:,NSV_LIMA_BEG:NSV_LIMA_END), &
+ PSVS(:,:,:,NSV_LIMA_BEG:NSV_LIMA_END), &
+ PTHS, PSRCS, PCLDFR, PICEFR, PRAINFR )
+ ENDIF
+ !
+ IF (HELEC == 'ELE4') THEN
+ ! Compute the condensation and sublimation rates
+ ZCND(:,:,:) = PRS(:,:,:,2) - ZRCS_BEF(:,:,:)
+ ZDEP(:,:,:) = PRS(:,:,:,4) - ZRIS_BEF(:,:,:)
+ ! Compute the charge exchanged during evaporation of cloud droplets (negative ZCND) and
+ ! during sublimation of ice crystals (negative ZDEP)
+ CALL ELEC_ADJUST (KRR, PRHODJ, HCLOUD, 'CEDS', &
+ PRC=ZRCS_BEF(:,:,:)*PTSTEP, PRI=ZRIS_BEF(:,:,:)*PTSTEP, &
+ PQC=PSVS(:,:,:,NSV_ELECBEG+1)*PTSTEP, &
+ PQI=PSVS(:,:,:,NSV_ELECBEG+3)*PTSTEP, &
+ PQCS=PSVS(:,:,:,NSV_ELECBEG+1), PQIS=PSVS(:,:,:,NSV_ELECBEG+3),&
+ PQPIS=PSVS(:,:,:,NSV_ELECBEG), PQNIS=PSVS(:,:,:,NSV_ELECEND), &
+ PCND=ZCND, PDEP=ZDEP )
+ END IF
!
END SELECT
!
+IF (ALLOCATED(ZLATHAM_IAGGS)) DEALLOCATE(ZLATHAM_IAGGS)
+!
IF(HCLOUD=='ICE3' .OR. HCLOUD=='ICE4' ) THEN
! TODO: code a generic routine to update vertical lower and upper levels to 0, a
! specific value or to IKB or IKE and apply it to every output prognostic variable of physics
@@ -1080,12 +1511,11 @@ IF(HCLOUD=='ICE3' .OR. HCLOUD=='ICE4' ) THEN
ENDWHERE
ENDIF
ENDIF
-
+!
! Remove non-physical negative values (unnecessary in a perfect world) + corresponding budgets
-call Sources_neg_correct( hcloud, 'NECON', krr, ptstep, ppabst, ptht, prt, pths, prs, psvs, prhodj )
-
-!-------------------------------------------------------------------------------
+call Sources_neg_correct( hcloud, helec, 'NECON', krr, ptstep, ppabst, ptht, prt, pths, prs, psvs, prhodj )
!
+!-------------------------------------------------------------------------------
!
!* 13. SWITCH BACK TO THE PROGNOSTIC VARIABLES
! ---------------------------------------
@@ -1101,7 +1531,22 @@ IF (HCLOUD=='C2R2' .OR. HCLOUD=='C3R5' .OR. HCLOUD=='KHKO' .OR. HCLOUD=='LIMA')
PSVS(:,:,:,JSV) = PSVS(:,:,:,JSV) * PRHODJ(:,:,:)
ENDDO
ENDIF
-
+!
+IF (HELEC /= 'NONE') THEN
+ DO JSV = NSV_ELECBEG, NSV_ELECEND
+ PSVS(:,:,:,JSV) = PSVS(:,:,:,JSV) * PRHODJ(:,:,:)
+ END DO
+!
+!++cb-- ce qui suit n'est plus present en version standard en 5-6 : pourquoi ?
+! Note that the LiNOx Conc. (in mol/mol) is PSVS (:,::,NSV_LNOXBEG)
+! but there is no need to *PRHODJ(:,:,:) as it is done implicitly
+! during unit conversion in flash_geom.
+!
+ PSVS(:,:,:,NSV_ELECBEG) = MAX(0., PSVS(:,:,:,NSV_ELECBEG))
+ PSVS(:,:,:,NSV_ELECEND) = MAX(0., PSVS(:,:,:,NSV_ELECEND))
+END IF
+!
+!
!-------------------------------------------------------------------------------
!
END SUBROUTINE RESOLVED_CLOUD
diff --git a/src/MNH/resolved_elecn.f90 b/src/MNH/resolved_elecn.f90
index 38ca1080bd0cf2ef039f71591c867eca8b7f6b41..1874d5e7e4f7019e625615ca7eb56071c2b3460c 100644
--- a/src/MNH/resolved_elecn.f90
+++ b/src/MNH/resolved_elecn.f90
@@ -8,106 +8,68 @@
! ###########################
!
INTERFACE
- SUBROUTINE RESOLVED_ELEC_n (HCLOUD, HSCONV, HMF_CLOUD, &
- KRR, KSPLITR, KMI, KTCOUNT, OEXIT, &
- HLBCX, HLBCY, HRAD, HTURBDIM, &
- OSUBG_COND, OSIGMAS,PSIGQSAT, HSUBG_AUCV, &
- PTSTEP, PZZ, PRHODJ, PRHODREF, PEXNREF, &
- PPABST, PTHT, PTHS, PWT, &
- PRT, PRS, PSVT, PSVS, PCIT, &
- PSIGS, PSRCS, PCLDFR, PMFCONV, PCF_MF, PRC_MF, &
- PRI_MF, OSEDIC, OWARM, &
- PINPRC, PINPRR, PINPRR3D, PEVAP3D, &
- PINPRS, PINPRG, PINPRH, &
- PSEA, PTOWN )
-!
-CHARACTER(LEN=4), INTENT(IN) :: HCLOUD ! kind of cloud
-CHARACTER(LEN=4), INTENT(IN) :: HSCONV ! Shallow convection scheme
-CHARACTER(LEN=4), INTENT(IN) :: HMF_CLOUD! Type of statistical cloud
-INTEGER, INTENT(IN) :: KRR ! Number of moist variables
-INTEGER, INTENT(IN) :: KSPLITR ! Number of small time step
- ! integrations for rain sedimendation
-INTEGER, INTENT(IN) :: KMI ! Model index
-INTEGER, INTENT(IN) :: KTCOUNT ! Temporal loop counter
-LOGICAL, INTENT(IN) :: OEXIT ! switch for the end of the temporal loop
-CHARACTER(LEN=4), DIMENSION(2), INTENT(IN) :: HLBCX,HLBCY ! X and Y-direc. LBC type
-CHARACTER(len=4), INTENT(IN) :: HRAD ! Radiation scheme name
-CHARACTER(len=4), INTENT(IN) :: HTURBDIM ! Dimensionality of the
- ! turbulence scheme
-LOGICAL, INTENT(IN) :: OSUBG_COND ! Switch for Subgrid Cond.
-LOGICAL, INTENT(IN) :: OSIGMAS ! Switch for Sigma_s:
- ! use values computed in CONDENSATION
- ! or that from turbulence scheme
-REAL, INTENT(IN) :: PSIGQSAT ! coeff applied to qsat variance contribution
-CHARACTER(LEN=4), INTENT(IN) :: HSUBG_AUCV
- ! Kind of Subgrid autoconversion method
-REAL, INTENT(IN) :: PTSTEP ! Double Time step
- ! (single if cold start)
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Height (z)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ !Dry density * Jacobian
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF! Reference dry air density
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! abs. pressure at time t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta at time t
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT):: PRT ! Moist variables at time t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSIGS ! Sigma_s at time t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PMFCONV ! convective mass flux
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source
+ SUBROUTINE RESOLVED_ELEC_n (HCLOUD, KRR, KMI, KTCOUNT, OEXIT, &
+ PTSTEP, PZZ, PRHODJ, PRHODREF, PEXNREF, &
+ PPABST, PTHT, PWT, &
+ PRT, PRS, PSVT, PSVS, PCIT, &
+ PINPRR, &
+ PSEA, PTOWN, &
+ PCCS, PCRS, PCSS, PCGS, PCHS, &
+ PSVS_LNOX )
+!
+CHARACTER(LEN=4), INTENT(IN) :: HCLOUD ! kind of cloud
+INTEGER, INTENT(IN) :: KRR ! Number of moist variables
+INTEGER, INTENT(IN) :: KMI ! Model index
+INTEGER, INTENT(IN) :: KTCOUNT ! Temporal loop counter
+LOGICAL, INTENT(IN) :: OEXIT ! switch for the end of the temporal loop
+REAL, INTENT(IN) :: PTSTEP ! Double Time step (single if cold start)
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Height (z)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ !Dry density * Jacobian
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF! Reference dry air density
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! abs. pressure at time t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta at time t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PWT ! vertical velocity at time t
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT ! Moist variables at time t
+!
REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRS ! Moist variable sources
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVT ! Scalar variable at time t
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVT ! Scalar variable at time t
REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVS ! Scalar variable sources
!
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSRCS ! Second-order flux
- ! s'rc'/2Sigma_s2 at time t+1
- ! multiplied by Lambda_3
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCLDFR! Cloud fraction
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCIT ! Pristine ice number
- ! concentration at time t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCIT ! Pristine ice nb conc.
+ ! - at time t (for ICE schemes)
+ ! - source (for LIMA)
!
-LOGICAL, INTENT(IN) :: OSEDIC! Switch to activate the
- ! cloud droplet sedimentation
-LOGICAL, INTENT(IN) :: OWARM ! Control of the rain formation
- ! by slow warm microphysical
- ! processes
+REAL, DIMENSION(:,:), INTENT(IN) :: PINPRR ! Rain instant precip
!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PCF_MF! Convective Mass Flux Cloud fraction
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRC_MF! Convective Mass Flux liquid mixing ratio
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRI_MF! Convective Mass Flux solid mixing ratio
+REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PSEA ! Land Sea mask
+REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PTOWN ! Town fraction
!
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRC ! Cloud instant precip
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRR ! Rain instant precip
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PINPRR3D ! sed flux of precip
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PEVAP3D ! evap profile
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRS ! Snow instant precip
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRG ! Graupel instant precip
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRH ! Hail instant precip
+REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(IN) :: PCCS ! Cld droplets nb conc source
+REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(IN) :: PCRS ! Rain nb conc source
+REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(IN) :: PCSS ! Snow nb conc source
+REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(IN) :: PCGS ! Graupel nb conc source
+REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(IN) :: PCHS ! Hail nb conc source
!
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PSEA ! Land Sea mask
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PTOWN ! Town fraction
+REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(INOUT) :: PSVS_LNOX ! Scalar variable source for LNOX
!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PWT ! vertical velocity at time t-dt
!
END SUBROUTINE RESOLVED_ELEC_n
END INTERFACE
END MODULE MODI_RESOLVED_ELEC_n
!
-! #####################################################################################
- SUBROUTINE RESOLVED_ELEC_n (HCLOUD, HSCONV, HMF_CLOUD, &
- KRR, KSPLITR, KMI, KTCOUNT, OEXIT, &
- HLBCX, HLBCY, HRAD, HTURBDIM, &
- OSUBG_COND, OSIGMAS,PSIGQSAT, HSUBG_AUCV, &
- PTSTEP, PZZ, PRHODJ, PRHODREF, PEXNREF, &
- PPABST, PTHT, PTHS, PWT, &
- PRT, PRS, PSVT, PSVS, PCIT, &
- PSIGS, PSRCS, PCLDFR, PMFCONV, PCF_MF, PRC_MF, &
- PRI_MF, OSEDIC, OWARM, &
- PINPRC, PINPRR, PINPRR3D, PEVAP3D, &
- PINPRS, PINPRG, PINPRH, &
- PSEA, PTOWN )
-! #####################################################################################
+! #####################################################################
+ SUBROUTINE RESOLVED_ELEC_n (HCLOUD, KRR, KMI, KTCOUNT, OEXIT, &
+ PTSTEP, PZZ, PRHODJ, PRHODREF, PEXNREF, &
+ PPABST, PTHT, PWT, &
+ PRT, PRS, PSVT, PSVS, PCIT, &
+ PINPRR, &
+ PSEA, PTOWN, &
+ PCCS, PCRS, PCSS, PCGS, PCHS, &
+ PSVS_LNOX )
+! #####################################################################
!
!! PURPOSE
!! -------
@@ -173,127 +135,78 @@ END MODULE MODI_RESOLVED_ELEC_n
! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
! P. Wautelet 12/02/2021: bugfix: change STATUS for opening files containing flash information (NEW->UNKNOWN)
! P. Wautelet 17/02/2021: budgets: add DRIFT and CORAY terms for electricity
+!! C. Barthe 07/02/2022: remove cloud electrification from resolved_elec
+!! C. Barthe 08/09/2022: enable using CELLS with LIMA
+!!
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-use mode_budget, only: Budget_store_add, Budget_store_init, Budget_store_end
USE MODE_ELEC_ll
USE MODE_IO_FILE, ONLY: IO_File_close, IO_File_open
USE MODE_IO_MANAGE_STRUCT, ONLY: IO_File_add2list, IO_File_find_byname
USE MODE_ll
!
-use modd_budget, only: lbudget_th, lbudget_rv, lbudget_rc, lbudget_rr, lbudget_ri, lbudget_rs, lbudget_rg, lbudget_rh, &
- lbudget_sv, &
- NBUDGET_TH, NBUDGET_RV, NBUDGET_RC, NBUDGET_RR, NBUDGET_RI, NBUDGET_RS, NBUDGET_RG, NBUDGET_RH, &
- NBUDGET_SV1, &
- tbudgets
-USE MODD_METRICS_n, ONLY : XDXX, XDYY, XDZX, XDZY, XDZZ
-USE MODD_FIELD_n, ONLY : XRSVS
-USE MODD_CONF, ONLY : L1D, L2D, CEXP
+USE MODD_CONF, ONLY : CEXP, CSEG
USE MODD_CST
-USE MODD_IO, ONLY: TFILEDATA, TFILE_DUMMY
-USE MODD_PARAMETERS, ONLY : JPVEXT
+USE MODD_IO, ONLY : TFILEDATA, TFILE_DUMMY
+USE MODD_PARAMETERS, ONLY : JPVEXT
+USE MODD_PARAM_LIMA, ONLY : NMOM_C, NMOM_R, NMOM_I, NMOM_S, NMOM_G, NMOM_H
USE MODD_ELEC_DESCR
USE MODD_ELEC_n
-USE MODD_NSV
-USE MODD_CH_MNHC_n, ONLY: LUSECHEM,LCH_CONV_LINOX
-USE MODD_DYN_n, ONLY: NSTOP, XTSTEP
USE MODD_ARGSLIST_ll, ONLY : LIST_ll
-
USE MODD_TIME_n
USE MODD_LMA_SIMULATOR
!
-USE MODD_VAR_ll, ONLY : NMNH_COMM_WORLD
-USE MODI_RAIN_ICE_ELEC
-USE MODI_ICE_ADJUST_ELEC
-USE MODI_TO_ELEC_FIELD_n
+USE MODD_VAR_ll, ONLY : NMNH_COMM_WORLD
USE MODI_FLASH_GEOM_ELEC_n
-USE MODI_SHUMAN
USE MODI_ION_ATTACH_ELEC
-USE MODD_ARGSLIST_ll, ONLY : LIST_ll
-!
-USE MODI_ION_DRIFT
USE MODI_SERIES_CLOUD_ELEC
!
IMPLICIT NONE
!
+!
!* 0.1 Declarations of dummy arguments :
!
-CHARACTER(LEN=4), INTENT(IN) :: HCLOUD ! kind of cloud
- ! paramerization
-CHARACTER(LEN=4), INTENT(IN) :: HSCONV ! Shallow convection scheme
-CHARACTER(LEN=4), INTENT(IN) :: HMF_CLOUD! Type of statistical cloud
-INTEGER, INTENT(IN) :: KRR ! Number of moist variables
-INTEGER, INTENT(IN) :: KSPLITR ! Number of small time step
- ! integrations for rain sedimendation
- ! integrations for ice sedimendation
-INTEGER, INTENT(IN) :: KMI ! Model index
-INTEGER, INTENT(IN) :: KTCOUNT ! Temporal loop counter
-LOGICAL, INTENT(IN) :: OEXIT ! switch for the end of the temporal loop
-CHARACTER(LEN=4), DIMENSION(2), INTENT(IN) :: HLBCX,HLBCY ! X and Y-direc. LBC type
-CHARACTER(len=4), INTENT(IN) :: HRAD ! Radiation scheme name
-CHARACTER(len=4), INTENT(IN) :: HTURBDIM ! Dimensionality of the
- ! turbulence scheme
-LOGICAL, INTENT(IN) :: OSUBG_COND ! Switch for Subgrid Cond.
-LOGICAL, INTENT(IN) :: OSIGMAS ! Switch for Sigma_s:
- ! use values computed in CONDENSATION
- ! or that from turbulence scheme
-REAL, INTENT(IN) :: PSIGQSAT ! coeff applied to qsat variance contribution
-CHARACTER(LEN=4), INTENT(IN) :: HSUBG_AUCV
- ! Kind of Subgrid autoconversion method
-REAL, INTENT(IN) :: PTSTEP ! Double Time step
- ! (single if cold start)
-!
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Height (z)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ !Dry density * Jacobian
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF! Reference dry air density
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
-!
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! abs. pressure at time t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta at time t
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT):: PRT ! Moist variables at time t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSIGS ! Sigma_s at time t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PMFCONV ! convective mass flux
-!
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source
+CHARACTER(LEN=4), INTENT(IN) :: HCLOUD ! kind of cloud paramerization
+INTEGER, INTENT(IN) :: KRR ! Number of moist variables
+INTEGER, INTENT(IN) :: KMI ! Model index
+INTEGER, INTENT(IN) :: KTCOUNT ! Temporal loop counter
+LOGICAL, INTENT(IN) :: OEXIT ! switch for the end of the temporal loop
+REAL, INTENT(IN) :: PTSTEP ! Double Time step (single if cold start)
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Height (z)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Reference dry air density
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! abs. pressure at time t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta at time t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PWT ! vertical velocity at time t
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT ! Moist variables at time t
+!
REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRS ! Moist variable sources
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVT ! Scalar variable at time t
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVT ! Scalar variable at time t
REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVS ! Scalar variable sources
!
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSRCS ! Second-order flux
- ! s'rc'/2Sigma_s2 at time t+1
- ! multiplied by Lambda_3
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCLDFR! Cloud fraction
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCIT ! Pristine ice number
- ! concentration at time t
-LOGICAL, INTENT(IN) :: OSEDIC! Switch to activate the
- ! cloud droplet sedimentation
- ! for ICE3
-LOGICAL, INTENT(IN) :: OWARM ! Control of the rain formation
- ! by slow warm microphysical
- ! processes
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PCF_MF! Convective Mass Flux Cloud fraction
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRC_MF! Convective Mass Flux liquid mixing ratio
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRI_MF! Convective Mass Flux solid mixing ratio
-!
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRC ! Cloud instant precip
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRR ! Rain instant precip
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PINPRR3D ! sed flux of precip
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PEVAP3D ! evap profile
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRS ! Snow instant precip
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRG ! Graupel instant precip
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRH ! Hail instant precip
-!
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PSEA ! Land Sea mask
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PTOWN ! Town fraction
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PWT ! vertical velocity at time t-dt
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCIT ! Pristine ice nb conc.
+ ! - at time t (for ICE schemes)
+ ! - source (for LIMA)
+!
+REAL, DIMENSION(:,:), INTENT(IN) :: PINPRR ! Rain instant precip
+!
+REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PSEA ! Land Sea mask
+REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PTOWN ! Town fraction
+!
+REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(IN) :: PCCS ! Cld droplets nb conc source
+REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(IN) :: PCRS ! Rain nb conc source
+REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(IN) :: PCSS ! Snow nb conc source
+REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(IN) :: PCGS ! Graupel nb conc source
+REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(IN) :: PCHS ! Hail nb conc source
+!
+REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(INOUT) :: PSVS_LNOX ! Scalar variable source for LNOX
+!
!
!* 0.2 Declarations of local variables :
!
@@ -309,46 +222,18 @@ INTEGER :: IPROC ! my proc number
INTEGER :: IERR ! error status
INTEGER :: ILU ! unit number for IO
!
-REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)):: ZT, &
- ZEXN, &
- ZLV, &
- ZLS, &
- ZCPH
-REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)) :: ZCOR
- ! for the correction of negative rv
-REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)) :: ZZZ
- ! model layer height
REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)) :: ZQTOT
! total charge source term
-REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)) :: ZION_NUMBER !nearly Nb
- ! of elementary charge in hydrometeor charge
-REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)) :: ZADD ! ratio (0
- ! or 1) of ZION_NUMBER to add to positive
- ! or negative ion number
-REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)):: ZIONTOT
-!
-REAL :: ZMASSTOT ! total mass for one water category
- ! including the negative values
-REAL :: ZMASSPOS ! total mass for one water category
- ! after removing the negative values
-REAL :: ZRATIO ! ZMASSTOT / ZMASSCOR
!
INTEGER, DIMENSION(3) :: IMINLOC, IMAXLOC
!
-LOGICAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)):: GMASSCOR ! mask for
- ! mass correction
LOGICAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)):: GATTACH ! mask for
!ion recombination and attachment
!
TYPE(LIST_ll), POINTER :: TZFIELDS_ll ! list of fields to exchange
-INTEGER, DIMENSION(3) :: IM_LOC
-REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)) :: ZDRIFT
-INTEGER :: IPROCMIN, IK
-INTEGER :: IXOR, IYOR ! origin of the extended subdomain
CHARACTER (LEN=32) :: YASCFILE
!
-REAL :: ZTEMP_DIST
CHARACTER (LEN=18) :: YNAME
LOGICAL :: GLMA_FILE
LOGICAL, SAVE :: GFIRST_CALL = .TRUE.
@@ -376,507 +261,70 @@ CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
IKB = 1 + JPVEXT
IKE = SIZE(PZZ,3) - JPVEXT
!
-if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'NEGA', pths(:, :, :) )
-if ( lbudget_rv ) call Budget_store_init( tbudgets(NBUDGET_RV), 'NEGA', prs (:, :, :, 1) )
-if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'NEGA', prs (:, :, :, 2) )
-if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'NEGA', prs (:, :, :, 3) )
-if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'NEGA', prs (:, :, :, 4) )
-if ( lbudget_rs ) call Budget_store_init( tbudgets(NBUDGET_RS), 'NEGA', prs (:, :, :, 5) )
-if ( lbudget_rg ) call Budget_store_init( tbudgets(NBUDGET_RG), 'NEGA', prs (:, :, :, 6) )
-if ( lbudget_rh ) call Budget_store_init( tbudgets(NBUDGET_RH), 'NEGA', prs (:, :, :, 7) )
-if ( lbudget_sv ) then
- do jsv = nsv_elecbeg, nsv_elecend
- call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + jsv), 'NEGA', psvs(:, :, :, jsv) )
- end do
-end if
-!
-!------------------------------------------------------------------------------
-!
-!* 2. MICROPHYSICS AND CLOUD ELECTRIFICATION
-! --------------------------------------
-!
-!* 2.1 Transformation into physical tendencies
-!
-! X-Component per m3.s into X-Component per kg.s
-PTHS(:,:,:) = PTHS(:,:,:) / PRHODJ(:,:,:)
-DO JRR = 1, KRR
- PRS(:,:,:,JRR) = PRS(:,:,:,JRR) / PRHODJ(:,:,:)
-END DO
-!
-DO JSV = NSV_ELECBEG, NSV_ELECEND
- PSVS(:,:,:,JSV) = PSVS(:,:,:,JSV) / PRHODJ(:,:,:)
-ENDDO
-!
-! complete the lateral boundaries to avoid possible problems
-!
-PTHS(IIB-1,:,:) = PTHS(IIB,:,:)
-PTHS(IIE+1,:,:) = PTHS(IIE,:,:)
-PTHS(:,IJB-1,:) = PTHS(:,IJB,:)
-PTHS(:,IJE+1,:) = PTHS(:,IJE,:)
-!
-PRS(IIB-1,:,:,1) = PRS(IIB,:,:,1)
-PRS(IIE+1,:,:,1) = PRS(IIE,:,:,1)
-PRS(:,IJB-1,:,1) = PRS(:,IJB,:,1)
-PRS(:,IJE+1,:,1) = PRS(:,IJE,:,1)
-!
-PRS(IIB-1,:,:,2:) = 0.0
-PRS(IIE+1,:,:,2:) = 0.0
-PRS(:,IJB-1,:,2:) = 0.0
-PRS(:,IJE+1,:,2:) = 0.0
-!
-! positive ion source
-PSVS(IIB-1,:,:,NSV_ELECBEG) = PSVS(IIB,:,:,NSV_ELECBEG)
-PSVS(IIE+1,:,:,NSV_ELECBEG) = PSVS(IIE,:,:,NSV_ELECBEG)
-PSVS(:,IJB-1,:,NSV_ELECBEG) = PSVS(:,IJB,:,NSV_ELECBEG)
-PSVS(:,IJE+1,:,NSV_ELECBEG) = PSVS(:,IJE,:,NSV_ELECBEG)
-! source of hydrometeor charge
-PSVS(IIB-1,:,:,NSV_ELECBEG+1:NSV_ELECEND-1) = 0.0
-PSVS(IIE+1,:,:,NSV_ELECBEG+1:NSV_ELECEND-1) = 0.0
-PSVS(:,IJB-1,:,NSV_ELECBEG+1:NSV_ELECEND-1) = 0.0
-PSVS(:,IJE+1,:,NSV_ELECBEG+1:NSV_ELECEND-1) = 0.0
-! negative ion source
-PSVS(IIB-1,:,:,NSV_ELECEND) = PSVS(IIB,:,:,NSV_ELECEND)
-PSVS(IIE+1,:,:,NSV_ELECEND) = PSVS(IIE,:,:,NSV_ELECEND)
-PSVS(:,IJB-1,:,NSV_ELECEND) = PSVS(:,IJB,:,NSV_ELECEND)
-PSVS(:,IJE+1,:,NSV_ELECEND) = PSVS(:,IJE,:,NSV_ELECEND)
-!
-! complete the physical boundaries to avoid some computations
-!
-IF(LWEST_ll() .AND. HLBCX(1) /= 'CYCL') PRT(IIB-1,:,:,2:) = 0.0
-IF(LEAST_ll() .AND. HLBCX(2) /= 'CYCL') PRT(IIE+1,:,:,2:) = 0.0
-IF(LSOUTH_ll() .AND. HLBCY(1) /= 'CYCL') PRT(:,IJB-1,:,2:) = 0.0
-IF(LNORTH_ll() .AND. HLBCY(2) /= 'CYCL') PRT(:,IJE+1,:,2:) = 0.0
-!
-IF(LWEST_ll() .AND. HLBCX(1) /= 'CYCL') &
- PSVT(IIB-1,:,:,NSV_ELECBEG+1:NSV_ELECEND-1) = 0.0
-IF(LEAST_ll() .AND. HLBCX(2) /= 'CYCL') &
- PSVT(IIE+1,:,:,NSV_ELECBEG+1:NSV_ELECEND-1) = 0.0
-IF(LSOUTH_ll() .AND. HLBCY(1) /= 'CYCL') &
- PSVT(:,IJB-1,:,NSV_ELECBEG+1:NSV_ELECEND-1) = 0.0
-IF(LNORTH_ll() .AND. HLBCY(2) /= 'CYCL') &
- PSVT(:,IJE+1,:,NSV_ELECBEG+1:NSV_ELECEND-1) = 0.0
-!
-! complete the vertical boundaries
-!
-PTHS(:,:,IKB-1) = PTHS(:,:,IKB)
-PTHS(:,:,IKE+1) = PTHS(:,:,IKE)
-!
-PRS(:,:,IKB-1,1) = PRS(:,:,IKB,1)
-PRS(:,:,IKE+1,1) = PRS(:,:,IKE,1)
-PRS(:,:,IKB-1,2:) = 0.0
-PRS(:,:,IKE+1,2:) = 0.0
-!
-PRT(:,:,IKB-1,1) = PRT(:,:,IKB,1)
-PRT(:,:,IKE+1,1) = PRT(:,:,IKE,1)
-PRT(:,:,IKB-1,2:) = 0.0
-PRT(:,:,IKE+1,2:) = 0.0
-!
-PSVS(:,:,IKB-1,NSV_ELECBEG) = PSVS(:,:,IKB,NSV_ELECBEG) ! Positive ion
-PSVT(:,:,IKB-1,NSV_ELECBEG) = PSVT(:,:,IKB,NSV_ELECBEG)
-PSVS(:,:,IKB-1,NSV_ELECBEG+1:NSV_ELECEND-1) = 0.0 ! Hydrometeor charge
-PSVS(:,:,IKE+1,NSV_ELECBEG+1:NSV_ELECEND-1) = 0.0
-PSVT(:,:,IKB-1,NSV_ELECBEG+1:NSV_ELECEND-1) = 0.0
-PSVT(:,:,IKE+1,NSV_ELECBEG+1:NSV_ELECEND-1) = 0.0
-PSVS(:,:,IKB-1,NSV_ELECEND) = PSVS(:,:,IKB,NSV_ELECEND) ! Negative ion
-PSVT(:,:,IKB-1,NSV_ELECEND) = PSVT(:,:,IKB,NSV_ELECEND)
-!
-! personal comment: tranfering these variables to the
-! microphysical routines would save
-! computing time
-!
-ZEXN(:,:,:) = (PPABST(:,:,:) / XP00)**(XRD / XCPD)
-ZT(:,:,:) = PTHT(:,:,:) * ZEXN(:,:,:)
-ZLV(:,:,:) = XLVTT + (XCPV - XCL) * (ZT(:,:,:) - XTT)
-ZLS(:,:,:) = XLSTT + (XCPV - XCI) * (ZT(:,:,:) - XTT)
-ZCPH(:,:,:) = XCPD + XCPV * PTSTEP * PRS(:,:,:,1)
-!
-!
-!------------------------------------------------------------------------------
-!
-!* 3. REMOVE NEGATIVE VALUES
-! ----------------------
-!
-!* 3.1 Non local correction for precipitating species (Rood 87)
-!
-DO JRR = 3, KRR
- SELECT CASE (JRR)
- CASE(3,5,6,7) ! rain, snow, graupel and hail
-!
- IF (MIN_ll(PRS(:,:,:,JRR), IINFO_ll) < 0.0) THEN
- GMASSCOR = PRS(:,:,:,JRR) < 0.
-!
-! compute the total water mass computation
- ZMASSTOT = MAX( 0. , SUM3D_ll( PRS(:,:,:,JRR), IINFO_ll ) )
-!
-! remove the negative values
- PRS(:,:,:,JRR) = MAX( 0., PRS(:,:,:,JRR) )
-!
-! compute the new total mass
- ZMASSPOS = MAX(XMNH_TINY,SUM3D_ll( PRS(:,:,:,JRR), IINFO_ll ) )
-!
-! correct again in such a way to conserve the total mass
- ZRATIO = ZMASSTOT / ZMASSPOS
- PRS(:,:,:,JRR) = PRS(:,:,:,JRR) * ZRATIO
-!
-! No electric charge without hydrometeors
- WHERE( GMASSCOR )
- PSVS(:,:,:,NSV_ELECBEG-1+JRR) = 0.
- ENDWHERE
- END IF
- END SELECT
-END DO
-!
-!
-!* 3.2 Adjustement for liquid and solid cloud
-!
-WHERE (PRS(:,:,:,4) < 0.) ! ice particles
- PRS(:,:,:,1) = PRS(:,:,:,1) + PRS(:,:,:,4)
- PTHS(:,:,:) = PTHS(:,:,:) - PRS(:,:,:,4) * ZLS(:,:,:) / &
- ZCPH(:,:,:) / ZEXN(:,:,:)
- PRS(:,:,:,4) = 0.
-!
- ZION_NUMBER(:,:,:) = ABS(PSVS(:,:,:,NSV_ELECBEG+3)) / XECHARGE
- ZADD(:,:,:) = 0.5 + SIGN(0.5, PSVS(:,:,:,NSV_ELECBEG+3))
- PSVS(:,:,:,NSV_ELECBEG) = PSVS(:,:,:,NSV_ELECBEG) + &
- ZADD(:,:,:) * ZION_NUMBER(:,:,:)
- PSVS(:,:,:,NSV_ELECEND) = PSVS(:,:,:,NSV_ELECEND) + &
- (1. - ZADD(:,:,:)) * ZION_NUMBER(:,:,:)
- PSVS(:,:,:,NSV_ELECBEG+3) = 0.0
-END WHERE
-!
-! cloud
-WHERE (PRS(:,:,:,2) < 0.)
- PRS(:,:,:,1) = PRS(:,:,:,1) + PRS(:,:,:,2)
- PTHS(:,:,:) = PTHS(:,:,:) - PRS(:,:,:,2) * ZLV(:,:,:) / &
- ZCPH(:,:,:) / ZEXN(:,:,:)
- PRS(:,:,:,2) = 0.
-!
- ZION_NUMBER(:,:,:) = ABS(PSVS(:,:,:,NSV_ELECBEG+1)) / XECHARGE
- ZADD(:,:,:) = 0.5 + SIGN(0.5, PSVS(:,:,:,NSV_ELECBEG+1))
- PSVS(:,:,:,NSV_ELECBEG) = PSVS(:,:,:,NSV_ELECBEG) + &
- ZADD(:,:,:) * ZION_NUMBER(:,:,:)
- PSVS(:,:,:,NSV_ELECEND) = PSVS(:,:,:,NSV_ELECEND) + &
- (1. - ZADD(:,:,:)) * ZION_NUMBER(:,:,:)
- PSVS(:,:,:,NSV_ELECBEG+1) = 0.0
-END WHERE
-!
-! if rc or ri are positive, we can correct negative rv
-! cloud
-WHERE ((PRS(:,:,:,1) < 0.) .AND. (PRS(:,:,:,2) > 0.) )
- PRS(:,:,:,1) = PRS(:,:,:,1) + PRS(:,:,:,2)
- PTHS(:,:,:) = PTHS(:,:,:) - PRS(:,:,:,2) * ZLV(:,:,:) / &
- ZCPH(:,:,:) / ZEXN(:,:,:)
- PRS(:,:,:,2) = 0.
-!
- ZION_NUMBER(:,:,:) = ABS(PSVS(:,:,:,NSV_ELECBEG+1)) / XECHARGE
- ZADD(:,:,:) = 0.5 + SIGN(0.5, PSVS(:,:,:,NSV_ELECBEG+1))
- PSVS(:,:,:,NSV_ELECBEG) = PSVS(:,:,:,NSV_ELECBEG) + &
- ZADD(:,:,:) * ZION_NUMBER(:,:,:)
- PSVS(:,:,:,NSV_ELECEND) = PSVS(:,:,:,NSV_ELECEND) + &
- (1.-ZADD(:,:,:)) * ZION_NUMBER(:,:,:)
- PSVS(:,:,:,NSV_ELECBEG+1) = 0.0
-END WHERE
-!
-! ice
-IF(KRR > 3) THEN
- WHERE ((PRS(:,:,:,1) < 0.).AND.(PRS(:,:,:,4) > 0.))
- ZCOR(:,:,:) = MIN(-PRS(:,:,:,1),PRS(:,:,:,4))
- PRS(:,:,:,1) = PRS(:,:,:,1) + ZCOR(:,:,:)
- PTHS(:,:,:) = PTHS(:,:,:) - ZCOR(:,:,:) * ZLS(:,:,:) / &
- ZCPH(:,:,:) / ZEXN(:,:,:)
- PRS(:,:,:,4) = PRS(:,:,:,4) -ZCOR(:,:,:)
-!
- ZION_NUMBER(:,:,:) = ABS(PSVS(:,:,:,NSV_ELECBEG+3)) / XECHARGE
- ZADD(:,:,:) = 0.5 + SIGN(0.5, PSVS(:,:,:,NSV_ELECBEG+3))
- PSVS(:,:,:,NSV_ELECBEG) = PSVS(:,:,:,NSV_ELECBEG) + &
- ZADD(:,:,:) * ZION_NUMBER(:,:,:)
- PSVS(:,:,:,NSV_ELECEND) = PSVS(:,:,:,NSV_ELECEND) + &
- (1. - ZADD(:,:,:)) * ZION_NUMBER(:,:,:)
- PSVS(:,:,:,NSV_ELECBEG+3) = 0.0
- END WHERE
-END IF
-!
-!
-!* 3.3 cascade the electric charges in absence of hydrometeor
-!
-DO JRR = KRR, 5, -1
- WHERE(PRS(:,:,:,JRR) < XRTMIN_ELEC(JRR))
- PSVS(:,:,:,NSV_ELECBEG-2+JRR) = PSVS(:,:,:,NSV_ELECBEG-2+JRR) + &
- PSVS(:,:,:,NSV_ELECBEG-1+JRR)
- PSVS(:,:,:,NSV_ELECBEG-1+JRR) = 0.0
- END WHERE
-END DO
-JRR = 3
-WHERE(PRS(:,:,:,JRR) < XRTMIN_ELEC(JRR))
- PSVS(:,:,:,NSV_ELECBEG-2+JRR) = PSVS(:,:,:,NSV_ELECBEG-2+JRR) + &
- PSVS(:,:,:,NSV_ELECBEG-1+JRR)
- PSVS(:,:,:,NSV_ELECBEG-1+JRR) = 0.0
-END WHERE
-DO JRR = 4, 2, -2
- WHERE(PRS(:,:,:,JRR) < XRTMIN_ELEC(JRR))
-!
- ZION_NUMBER(:,:,:) = ABS(PSVS(:,:,:,NSV_ELECBEG-1+JRR)) / XECHARGE
- ZADD(:,:,:) = 0.5 + SIGN(0.5, PSVS(:,:,:,NSV_ELECBEG-1+JRR))
- PSVS(:,:,:,NSV_ELECBEG) = PSVS(:,:,:,NSV_ELECBEG) + &
- ZADD(:,:,:) * ZION_NUMBER(:,:,:)
- PSVS(:,:,:,NSV_ELECEND) = PSVS(:,:,:,NSV_ELECEND) + &
- (1. - ZADD(:,:,:)) * ZION_NUMBER(:,:,:)
- PSVS(:,:,:,NSV_ELECBEG-1+JRR) = 0.0
- END WHERE
-END DO
-!
-!
-!* 3.4 store the budget terms
-!
-if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'NEGA', pths(:, :, :) * prhodj(:, :, :) )
-if ( lbudget_rv ) call Budget_store_end( tbudgets(NBUDGET_RV), 'NEGA', prs (:, :, :, 1) * prhodj(:, :, :) )
-if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'NEGA', prs (:, :, :, 2) * prhodj(:, :, :) )
-if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'NEGA', prs (:, :, :, 3) * prhodj(:, :, :) )
-if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'NEGA', prs (:, :, :, 4) * prhodj(:, :, :) )
-if ( lbudget_rs ) call Budget_store_end( tbudgets(NBUDGET_RS), 'NEGA', prs (:, :, :, 5) * prhodj(:, :, :) )
-if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG), 'NEGA', prs (:, :, :, 6) * prhodj(:, :, :) )
-if ( lbudget_rh ) call Budget_store_end( tbudgets(NBUDGET_RH), 'NEGA', prs (:, :, :, 7) * prhodj(:, :, :) )
-if ( lbudget_sv ) then
- do jsv = nsv_elecbeg, nsv_elecend
- call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + jsv), 'NEGA', psvs(:, :, :, jsv) * prhodj(:, :, :) )
- end do
-end if
-!
-!------------------------------------------------------------------------------
-!
-!* 4. ION SOURCE FROM DRIFT MOTION AND COSMIC RAYS
-! ---------------------------------------------
-!
-!* 4.1 Compute the electric field at mass points
-!
-PSVT(:,:,:,NSV_ELECBEG) = XECHARGE*PSVT(:,:,:,NSV_ELECBEG) ! 1/kg --> C/kg
-PSVT(:,:,:,NSV_ELECEND) =-XECHARGE*PSVT(:,:,:,NSV_ELECEND)
-!
-CALL TO_ELEC_FIELD_n (PRT, PSVT(:,:,:,NSV_ELECBEG:NSV_ELECEND), PRHODJ, &
- KTCOUNT, KRR, &
- XEFIELDU, XEFIELDV, XEFIELDW )
-!
-PSVT(:,:,:,NSV_ELECBEG) = PSVT(:,:,:,NSV_ELECBEG)/XECHARGE ! back to 1/kg
-PSVT(:,:,:,NSV_ELECEND) =-PSVT(:,:,:,NSV_ELECEND)/XECHARGE
-!
-!
-!* 4.2 Compute source term from -/+(Div (N.mu E)) at mass points,
-! N positive or negative ion number per kg of air (= PSVT)
-! This is a contribution of drift motion to Source PSVS for ions
-! in 1/(kg.s)
-!
CALL MYPROC_ELEC_ll (IPROC)
!
-! Hereafter, ZCPH and ZCOR are used temporarily to store the drift sources
-! of the positive and negative ions, respectively
-!
-CALL ION_DRIFT(ZCPH, ZCOR, PSVT, HLBCX, HLBCY)
-
-PSVS(:,:,:,NSV_ELECBEG) = PSVS(:,:,:,NSV_ELECBEG) + ZCPH(:,:,:)
-PSVS(:,:,:,NSV_ELECEND) = PSVS(:,:,:,NSV_ELECEND) + ZCOR(:,:,:)
-
-if ( lbudget_sv ) then
- call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg), 'DRIFT', zcph(:, :, :) * prhodj(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecend), 'DRIFT', zcor(:, :, :) * prhodj(:, :, :) )
-end if
-!
-!* 4.3 Add Cosmic Ray source
-!
-PSVS(:,:,:,NSV_ELECBEG) = PSVS(:,:,:,NSV_ELECBEG) + &
- XIONSOURCEFW(:,:,:) / PRHODREF(:,:,:)
-PSVS(:,:,:,NSV_ELECEND) = PSVS(:,:,:,NSV_ELECEND) + &
- XIONSOURCEFW(:,:,:) / PRHODREF(:,:,:)
-
-if ( lbudget_sv ) then
- call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg), 'CORAY', xionsourcefw(:,:,:)/prhodref(:,:,:) * prhodj(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecend), 'CORAY', xionsourcefw(:,:,:)/prhodref(:,:,:) * prhodj(:, :, :) )
-end if
-!
-!-------------------------------------------------------------------------------
-!
-SELECT CASE (HCLOUD)
-!
- CASE ('ICE3')
-!
-!* 5. MIXED-PHASE MICROPHYSICAL SCHEME (WITH 3 ICE SPECIES)
-! -----------------------------------------------------
-!
-!* 5.1 Compute the explicit microphysical sources and
-!* the explicit charging rates
-!
- CALL RAIN_ICE_ELEC (OSEDIC, HSUBG_AUCV, OWARM, &
- KSPLITR, PTSTEP, KMI, KRR, &
- PZZ, PRHODJ, PRHODREF, PEXNREF, PPABST, PCIT, PCLDFR, &
- 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, &
- PSVT(:,:,:,NSV_ELECBEG), PSVT(:,:,:,NSV_ELECBEG+1), &
- PSVT(:,:,:,NSV_ELECBEG+2), PSVT(:,:,:,NSV_ELECBEG+3), &
- PSVT(:,:,:,NSV_ELECBEG+4), PSVT(:,:,:,NSV_ELECBEG+5), &
- PSVT(:,:,:,NSV_ELECEND), &
- PSVS(:,:,:,NSV_ELECBEG), PSVS(:,:,:,NSV_ELECBEG+1), &
- PSVS(:,:,:,NSV_ELECBEG+2), PSVS(:,:,:,NSV_ELECBEG+3), &
- PSVS(:,:,:,NSV_ELECBEG+4), PSVS(:,:,:,NSV_ELECBEG+5), &
- PSVS(:,:,:,NSV_ELECEND), &
- PSEA, PTOWN )
-
-!
-!* 5.2 Perform the saturation adjustment over cloud ice and cloud water
-!
- ZZZ = MZF( PZZ )
- CALL ICE_ADJUST_ELEC (KRR, KMI, HRAD, HTURBDIM, &
- HSCONV, HMF_CLOUD, &
- OSUBG_COND, OSIGMAS, PTSTEP,PSIGQSAT, &
- PRHODJ, PEXNREF, PSIGS, PPABST, ZZZ, &
- PMFCONV, PCF_MF, PRC_MF, PRI_MF, &
- PRVT=PRT(:,:,:,1), PRCT=PRT(:,:,:,2), &
- PRVS=PRS(:,:,:,1), PRCS=PRS(:,:,:,2), &
- PTHS=PTHS, PSRCS=PSRCS, PCLDFR=PCLDFR, &
- PRRT=PRT(:,:,:,3), PRRS=PRS(:,:,:,3), &
- PRIT=PRT(:,:,:,4), PRIS=PRS(:,:,:,4), &
- PRST=PRT(:,:,:,5), PRSS=PRS(:,:,:,5), &
- PRGT=PRT(:,:,:,6), PRGS=PRS(:,:,:,6), &
- PQPIT=PSVT(:,:,:,NSV_ELECBEG), & !..PI.. Positive
- PQPIS=PSVS(:,:,:,NSV_ELECBEG), & ! Ion Mixing Ratio
- PQCT=PSVT(:,:,:,NSV_ELECBEG+1), &
- PQCS=PSVS(:,:,:,NSV_ELECBEG+1), &
- PQRT=PSVT(:,:,:,NSV_ELECBEG+2), &
- PQRS=PSVS(:,:,:,NSV_ELECBEG+2), &
- PQIT=PSVT(:,:,:,NSV_ELECBEG+3), &
- PQIS=PSVS(:,:,:,NSV_ELECBEG+3), &
- PQST=PSVT(:,:,:,NSV_ELECBEG+4), &
- PQSS=PSVS(:,:,:,NSV_ELECBEG+4), &
- PQGT=PSVT(:,:,:,NSV_ELECBEG+5), &
- PQGS=PSVS(:,:,:,NSV_ELECBEG+5), &
- PQNIT=PSVT(:,:,:,NSV_ELECEND), & !..NI.. Negative
- PQNIS=PSVS(:,:,:,NSV_ELECEND)) ! Ion Mixing Ratio
-!
-!
-!-------------------------------------------------------------------------------
-!
-!* 6. MIXED-PHASE MICROPHYSICAL SCHEME (WITH 4 ICE SPECIES)
-! -----------------------------------------------------
-!
-!* 6.1 Compute the explicit microphysical sources and
-!* the explicit charging rates
-!
- CASE ('ICE4')
-!
- CALL RAIN_ICE_ELEC (OSEDIC, HSUBG_AUCV, OWARM, &
- KSPLITR, PTSTEP, KMI, KRR, &
- PZZ, PRHODJ, PRHODREF, PEXNREF, PPABST, PCIT, PCLDFR, &
- 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, &
- PSVT(:,:,:,NSV_ELECBEG), PSVT(:,:,:,NSV_ELECBEG+1), &
- PSVT(:,:,:,NSV_ELECBEG+2), PSVT(:,:,:,NSV_ELECBEG+3), &
- PSVT(:,:,:,NSV_ELECBEG+4), PSVT(:,:,:,NSV_ELECBEG+5), &
- PSVT(:,:,:,NSV_ELECEND), &
- PSVS(:,:,:,NSV_ELECBEG), PSVS(:,:,:,NSV_ELECBEG+1), &
- PSVS(:,:,:,NSV_ELECBEG+2), PSVS(:,:,:,NSV_ELECBEG+3), &
- PSVS(:,:,:,NSV_ELECBEG+4), PSVS(:,:,:,NSV_ELECBEG+5), &
- PSVS(:,:,:,NSV_ELECEND), &
- PSEA, PTOWN, &
- PRT(:,:,:,7), PRS(:,:,:,7), PINPRH, &
- PSVT(:,:,:,NSV_ELECBEG+6), PSVS(:,:,:,NSV_ELECBEG+6) )
-! Index NSV_ELECBEG: Positive ion , NSV_ELECEND: Negative ion
-!
-!
-!* 6.2 Perform the saturation adjustment over cloud ice and cloud water
-!
- ZZZ = MZF( PZZ )
- CALL ICE_ADJUST_ELEC (KRR, KMI, HRAD, &
- HTURBDIM, HSCONV, HMF_CLOUD, &
- OSUBG_COND, OSIGMAS, PTSTEP,PSIGQSAT, &
- PRHODJ, PEXNREF, PSIGS, PPABST, ZZZ, &
- PMFCONV, PCF_MF, PRC_MF, PRI_MF, &
- PRVT=PRT(:,:,:,1), PRCT=PRT(:,:,:,2), &
- PRVS=PRS(:,:,:,1), PRCS=PRS(:,:,:,2), &
- PTHS=PTHS, PSRCS=PSRCS, PCLDFR=PCLDFR, &
- PRRT=PRT(:,:,:,3), PRRS=PRS(:,:,:,3), &
- PRIT=PRT(:,:,:,4), PRIS=PRS(:,:,:,4), &
- PRST=PRT(:,:,:,5), PRSS=PRS(:,:,:,5), &
- PRGT=PRT(:,:,:,6), PRGS=PRS(:,:,:,6), &
- PQPIT=PSVT(:,:,:,NSV_ELECBEG), & !..PI.. Positive
- PQPIS=PSVS(:,:,:,NSV_ELECBEG), & ! Ion Mixing Ratio
- PQCT=PSVT(:,:,:,NSV_ELECBEG+1), &
- PQCS=PSVS(:,:,:,NSV_ELECBEG+1), &
- PQRT=PSVT(:,:,:,NSV_ELECBEG+2), &
- PQRS=PSVS(:,:,:,NSV_ELECBEG+2), &
- PQIT=PSVT(:,:,:,NSV_ELECBEG+3), &
- PQIS=PSVS(:,:,:,NSV_ELECBEG+3), &
- PQST=PSVT(:,:,:,NSV_ELECBEG+4), &
- PQSS=PSVS(:,:,:,NSV_ELECBEG+4), &
- PQGT=PSVT(:,:,:,NSV_ELECBEG+5), &
- PQGS=PSVS(:,:,:,NSV_ELECBEG+5), &
- PQNIT=PSVT(:,:,:,NSV_ELECEND), & !..NI.. Negative
- PQNIS=PSVS(:,:,:,NSV_ELECEND), & ! Ion Mixing Ratio
- PRHT=PRT(:,:,:,7), PRHS=PRS(:,:,:,7), &
- PQHT=PSVT(:,:,:,NSV_ELECBEG+6), &
- PQHS=PSVS(:,:,:,NSV_ELECBEG+6) )
-!
-END SELECT
-!
-IF(KTCOUNT .EQ. 1 .AND. IPROC .EQ. 0) PRINT *,'KSPLITR=', KSPLITR
-!
-!-------------------------------------------------------------------------------
-!
-!* 7. SWITCH BACK TO THE PROGNOSTIC VARIABLES
-! ---------------------------------------
-!
-! Convert source into component per m3 of air and sec., i.e. volumetric source
-!
-PTHS(:,:,:) = PTHS(:,:,:) * PRHODJ(:,:,:)
-!
-DO JRR = 1,KRR
- PRS(:,:,:,JRR) = PRS(:,:,:,JRR) * PRHODJ(:,:,:)
-END DO
-!
-DO JSV = NSV_ELECBEG, NSV_ELECEND
- PSVS(:,:,:,JSV) = PSVS(:,:,:,JSV) * PRHODJ(:,:,:)
-ENDDO
-!
-! Note that the LiNOx Conc. (in mol/mol) is PSVS (:,::,NSV_LNOXBEG)
-! but there is no need to *PRHODJ(:,:,:) as it is done implicitly
-! during unit conversion in flash_geom.
-!
-PSVS(:,:,:,NSV_ELECBEG) = MAX(0., PSVS(:,:,:,NSV_ELECBEG))
-PSVS(:,:,:,NSV_ELECEND) = MAX(0., PSVS(:,:,:,NSV_ELECEND))
+!------------------------------------------------------------------------------
!
-!-------------------------------------------------------------------------------
!
-!* 8. ION RECOMBINATION AND ATTACHMENT
+!* 2. ION RECOMBINATION AND ATTACHMENT
! --------------------------------
!
GATTACH(:,:,:) = .FALSE.
GATTACH(IIB:IIE, IJB:IJE, IKB:IKE) = .TRUE.
!
-IF (PRESENT(PSEA)) THEN
- CALL ION_ATTACH_ELEC(KTCOUNT, KRR, PTSTEP, PRHODREF, &
- PRHODJ, PSVS(:,:,:,NSV_ELECBEG:NSV_ELECEND), &
- PRS, PTHT, PCIT, PPABST, XEFIELDU, &
- XEFIELDV, XEFIELDW, GATTACH, PTOWN, PSEA )
-ELSE
- CALL ION_ATTACH_ELEC(KTCOUNT, KRR, PTSTEP, PRHODREF, &
- PRHODJ, PSVS(:,:,:,NSV_ELECBEG:NSV_ELECEND), &
- PRS, PTHT, PCIT, PPABST, XEFIELDU, &
- XEFIELDV, XEFIELDW, GATTACH )
-ENDIF
+IF (HCLOUD(1:3) == 'ICE') THEN
+ IF (PRESENT(PSEA)) THEN
+ CALL ION_ATTACH_ELEC(KTCOUNT, KRR, HCLOUD, PTSTEP, PRHODREF, &
+ PRHODJ, PSVS(:,:,:,1:KRR+1), &
+ PRS, PTHT, PCIT, PPABST, XEFIELDU, &
+ XEFIELDV, XEFIELDW, GATTACH, &
+ PTOWN=PTOWN, PSEA=PSEA)
+ ELSE
+ CALL ION_ATTACH_ELEC(KTCOUNT, KRR, HCLOUD, PTSTEP, PRHODREF, &
+ PRHODJ, PSVS(:,:,:,1:KRR+1), &
+ PRS, PTHT, PCIT, PPABST, XEFIELDU, &
+ XEFIELDV, XEFIELDW, GATTACH)
+ ENDIF
+ELSE IF (HCLOUD == 'LIMA') THEN
+ IF (KRR == 7) THEN
+ IF (NMOM_S == 1 .AND. NMOM_G == 1 .AND. NMOM_H == 1) THEN
+ CALL ION_ATTACH_ELEC(KTCOUNT, KRR, HCLOUD, PTSTEP, PRHODREF, &
+ PRHODJ, PSVS(:,:,:,1:KRR+1), &
+ PRS, PTHT, PCIT, PPABST, XEFIELDU, &
+ XEFIELDV, XEFIELDW, GATTACH, &
+ PCCS=PCCS, PCRS=PCRS)
+ ELSE IF (NMOM_S == 2 .AND. NMOM_G == 2 .AND. NMOM_H == 2) THEN
+ CALL ION_ATTACH_ELEC(KTCOUNT, KRR, HCLOUD, PTSTEP, PRHODREF, &
+ PRHODJ, PSVS(:,:,:,1:KRR+1), &
+ PRS, PTHT, PCIT, PPABST, XEFIELDU, &
+ XEFIELDV, XEFIELDW, GATTACH, &
+ PCCS=PCCS, PCRS=PCRS, PCSS=PCSS, PCGS=PCGS, PCHS=PCHS)
+ END IF
+ ELSE IF (KRR == 6) THEN
+ IF (NMOM_S == 1 .AND. NMOM_G == 1) THEN
+ CALL ION_ATTACH_ELEC(KTCOUNT, KRR, HCLOUD, PTSTEP, PRHODREF, &
+ PRHODJ, PSVS(:,:,:,1:KRR+1), &
+ PRS, PTHT, PCIT, PPABST, XEFIELDU, &
+ XEFIELDV, XEFIELDW, GATTACH, &
+ PCCS=PCCS, PCRS=PCRS)
+ ELSE IF (NMOM_S == 2 .AND. NMOM_G == 2) THEN
+ CALL ION_ATTACH_ELEC(KTCOUNT, KRR, HCLOUD, PTSTEP, PRHODREF, &
+ PRHODJ, PSVS(:,:,:,1:KRR+1), &
+ PRS, PTHT, PCIT, PPABST, XEFIELDU, &
+ XEFIELDV, XEFIELDW, GATTACH, &
+ PCCS=PCCS, PCRS=PCRS, PCSS=PCSS, PCGS=PCGS, PCHS=PCHS)
+ END IF
+ END IF
+END IF
!
!-------------------------------------------------------------------------------
!
-!* 9. OPEN THE OUTPUT ASCII FILES
+!* 3. OPEN THE OUTPUT ASCII FILES
! ---------------------------
!
-IF (KTCOUNT==1 .AND. IPROC==0) THEN
+IF (KTCOUNT == 1 .AND. IPROC == 0) THEN
IF (LFLASH_GEOM) THEN
- YASCFILE = CEXP//"_fgeom_diag.asc"
+ YASCFILE = CEXP//"_"//CSEG//"_fgeom_diag.asc"
TZFILE_FGEOM_DIAG => NULL()
CALL IO_File_add2list(TZFILE_FGEOM_DIAG,YASCFILE,'TXT','WRITE')
CALL IO_File_open(TZFILE_FGEOM_DIAG,HPOSITION='APPEND',HSTATUS='UNKNOWN')
@@ -1021,23 +469,116 @@ END IF
! the lightning scheme is now called at each time step
! but only if there's electric charge in the domain
!
-ZQTOT(:,:,:) = XECHARGE * (PSVT(:,:,:,NSV_ELECBEG) - PSVT(:,:,:,NSV_ELECEND))
-DO JSV = NSV_ELECBEG+1, NSV_ELECEND-1
+ZQTOT(:,:,:) = XECHARGE * (PSVT(:,:,:,1) - PSVT(:,:,:,KRR+1))
+DO JSV = 2, KRR
ZQTOT(:,:,:) = ZQTOT(:,:,:) + PSVT(:,:,:,JSV)
END DO
!
+!++cb-- reprendre les appels avec bcp de conditions : utiliser des tableaux (0,0,0)
IF ((.NOT. LOCG) .AND. LELEC_FIELD .AND. MAX_ll(ABS(ZQTOT),IINFO_ll)>0.) THEN
IF (LFLASH_GEOM) THEN
- CALL FLASH_GEOM_ELEC_n (KTCOUNT, KMI, KRR, PTSTEP, OEXIT, &
- PRHODJ, PRHODREF, PRT, PCIT, PSVS(:,:,:,NSV_ELECBEG:NSV_ELECEND), &
- PRS, PTHT, PPABST, XEFIELDU, XEFIELDV, XEFIELDW, &
- PZZ, PSVS(:,:,:,NSV_LNOXBEG), &
- TZFILE_FGEOM_DIAG, TZFILE_FGEOM_COORD, TZFILE_LMA, &
- PTOWN, PSEA)
+ IF (HCLOUD(1:3) == 'ICE') THEN
+ IF (PRESENT(PTOWN) .AND. PRESENT(PSEA)) THEN
+ IF (PRESENT(PSVS_LNOX)) THEN
+ CALL FLASH_GEOM_ELEC_n (KTCOUNT, KMI, KRR, HCLOUD, PTSTEP, OEXIT, &
+ PRHODJ, PRHODREF, PRT, PCIT, &
+ PSVS(:,:,:,1:KRR+1), &
+ PRS, PTHT, PPABST, XEFIELDU, XEFIELDV, XEFIELDW, &
+ PZZ, &
+ TZFILE_FGEOM_DIAG, TZFILE_FGEOM_COORD, TZFILE_LMA, &
+ PTOWN=PTOWN, PSEA=PSEA, PSVS_LNOX=PSVS_LNOX)
+ ELSE
+ CALL FLASH_GEOM_ELEC_n (KTCOUNT, KMI, KRR, HCLOUD, PTSTEP, OEXIT, &
+ PRHODJ, PRHODREF, PRT, PCIT, &
+ PSVS(:,:,:,1:KRR+1), &
+ PRS, PTHT, PPABST, XEFIELDU, XEFIELDV, XEFIELDW, &
+ PZZ, &
+ TZFILE_FGEOM_DIAG, TZFILE_FGEOM_COORD, TZFILE_LMA, &
+ PTOWN=PTOWN, PSEA=PSEA)
+ END IF
+ ELSE
+ IF (PRESENT(PSVS_LNOX)) THEN
+ CALL FLASH_GEOM_ELEC_n (KTCOUNT, KMI, KRR, HCLOUD, PTSTEP, OEXIT, &
+ PRHODJ, PRHODREF, PRT, PCIT, &
+ PSVS(:,:,:,1:KRR+1), &
+ PRS, PTHT, PPABST, XEFIELDU, XEFIELDV, XEFIELDW, &
+ PZZ, &
+ TZFILE_FGEOM_DIAG, TZFILE_FGEOM_COORD, TZFILE_LMA, &
+ PSVS_LNOX=PSVS_LNOX)
+ ELSE
+ CALL FLASH_GEOM_ELEC_n (KTCOUNT, KMI, KRR, HCLOUD, PTSTEP, OEXIT, &
+ PRHODJ, PRHODREF, PRT, PCIT, &
+ PSVS(:,:,:,1:KRR+1), &
+ PRS, PTHT, PPABST, XEFIELDU, XEFIELDV, XEFIELDW, &
+ PZZ, &
+ TZFILE_FGEOM_DIAG, TZFILE_FGEOM_COORD, TZFILE_LMA)
+ END IF
+ END IF
+ ELSE
+ IF (HCLOUD == 'LIMA' .AND. ((KRR == 6 .AND. NMOM_S == 1 .AND. NMOM_G == 1) .OR. &
+ (KRR == 7 .AND. NMOM_S == 1 .AND. NMOM_G == 1 .AND. NMOM_H == 1))) THEN
+ IF (PRESENT(PSVS_LNOX)) THEN
+ CALL FLASH_GEOM_ELEC_n (KTCOUNT, KMI, KRR, HCLOUD, PTSTEP, OEXIT, &
+ PRHODJ, PRHODREF, PRT, PCIT, &
+ PSVS(:,:,:,1:KRR+1), &
+ PRS, PTHT, PPABST, XEFIELDU, XEFIELDV, XEFIELDW, &
+ PZZ, &
+ TZFILE_FGEOM_DIAG, TZFILE_FGEOM_COORD, TZFILE_LMA, &
+ PCCS=PCCS, PCRS=PCRS, &
+ PSVS_LNOX=PSVS_LNOX)
+ ELSE
+ CALL FLASH_GEOM_ELEC_n (KTCOUNT, KMI, KRR, HCLOUD, PTSTEP, OEXIT, &
+ PRHODJ, PRHODREF, PRT, PCIT, &
+ PSVS(:,:,:,1:KRR+1), &
+ PRS, PTHT, PPABST, XEFIELDU, XEFIELDV, XEFIELDW, &
+ PZZ, &
+ TZFILE_FGEOM_DIAG, TZFILE_FGEOM_COORD, TZFILE_LMA, &
+ PCCS=PCCS, PCRS=PCRS)
+ END IF
+ ELSE IF (HCLOUD == 'LIMA' .AND. KRR == 6 .AND. NMOM_S == 2 .AND. NMOM_G == 2) THEN
+ IF (PRESENT(PSVS_LNOX)) THEN
+ CALL FLASH_GEOM_ELEC_n (KTCOUNT, KMI, KRR, HCLOUD, PTSTEP, OEXIT, &
+ PRHODJ, PRHODREF, PRT, PCIT, &
+ PSVS(:,:,:,1:KRR+1), &
+ PRS, PTHT, PPABST, XEFIELDU, XEFIELDV, XEFIELDW, &
+ PZZ, &
+ TZFILE_FGEOM_DIAG, TZFILE_FGEOM_COORD, TZFILE_LMA, &
+ PCCS=PCCS, PCRS=PCRS, PCSS=PCSS, PCGS=PCGS, &
+ PSVS_LNOX=PSVS_LNOX)
+ ELSE
+ CALL FLASH_GEOM_ELEC_n (KTCOUNT, KMI, KRR, HCLOUD, PTSTEP, OEXIT, &
+ PRHODJ, PRHODREF, PRT, PCIT, &
+ PSVS(:,:,:,1:KRR+1), &
+ PRS, PTHT, PPABST, XEFIELDU, XEFIELDV, XEFIELDW, &
+ PZZ, &
+ TZFILE_FGEOM_DIAG, TZFILE_FGEOM_COORD, TZFILE_LMA, &
+ PCCS=PCCS, PCRS=PCRS, PCSS=PCSS, PCGS=PCGS)
+ END IF
+ ELSE IF (HCLOUD == 'LIMA' .AND. KRR == 7 .AND. NMOM_S == 2 .AND. NMOM_G == 2 .AND. NMOM_H == 2) THEN
+ IF (PRESENT(PSVS_LNOX)) THEN
+ CALL FLASH_GEOM_ELEC_n (KTCOUNT, KMI, KRR, HCLOUD, PTSTEP, OEXIT, &
+ PRHODJ, PRHODREF, PRT, PCIT, &
+ PSVS(:,:,:,1:KRR+1), &
+ PRS, PTHT, PPABST, XEFIELDU, XEFIELDV, XEFIELDW, &
+ PZZ, &
+ TZFILE_FGEOM_DIAG, TZFILE_FGEOM_COORD, TZFILE_LMA, &
+ PCCS=PCCS, PCRS=PCRS, PCSS=PCSS, PCGS=PCGS, PCHS=PCHS, &
+ PSVS_LNOX=PSVS_LNOX)
+ ELSE
+ CALL FLASH_GEOM_ELEC_n (KTCOUNT, KMI, KRR, HCLOUD, PTSTEP, OEXIT, &
+ PRHODJ, PRHODREF, PRT, PCIT, &
+ PSVS(:,:,:,1:KRR+1), &
+ PRS, PTHT, PPABST, XEFIELDU, XEFIELDV, XEFIELDW, &
+ PZZ, &
+ TZFILE_FGEOM_DIAG, TZFILE_FGEOM_COORD, TZFILE_LMA, &
+ PCCS=PCCS, PCRS=PCRS, PCSS=PCSS, PCGS=PCGS, PCHS=PCHS)
+ END IF
+ END IF
+ END IF
END IF
!
- PSVS(:,:,:,NSV_ELECBEG) = MAX(0., PSVS(:,:,:,NSV_ELECBEG))
- PSVS(:,:,:,NSV_ELECEND) = MAX(0., PSVS(:,:,:,NSV_ELECEND))
+ PSVS(:,:,:,1) = MAX(0., PSVS(:,:,:,1))
+ PSVS(:,:,:,KRR+1) = MAX(0., PSVS(:,:,:,KRR+1))
!
END IF
!
diff --git a/src/MNH/series_cloud_elec.f90 b/src/MNH/series_cloud_elec.f90
index c740922db924e0a69472a670046a154571f3977e..1eb1e4e48311570513adb6a6535a1290d6b07913 100644
--- a/src/MNH/series_cloud_elec.f90
+++ b/src/MNH/series_cloud_elec.f90
@@ -36,7 +36,7 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! ab. pressure at time t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PCIT ! Pristine ice number
! concentration at time t
TYPE(TFILEDATA), INTENT(IN) :: TPFILE_SERIES_CLOUD_ELEC
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRR ! Rain instant precip
+REAL, DIMENSION(:,:), INTENT(IN) :: PINPRR ! Rain instant precip
!
END SUBROUTINE SERIES_CLOUD_ELEC
END INTERFACE
@@ -83,6 +83,7 @@ END MODULE MODI_SERIES_CLOUD_ELEC
!! Philippe Wautelet: 22/01/2019: use standard FLUSH statement instead of non standard intrinsics
! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90
+! C. Barthe 20/03/2023: PRINPRR passed as input argument only
!
!-------------------------------------------------------------------------------
!
@@ -131,7 +132,7 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! ab. pressure at time t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PCIT ! Pristine ice number
! concentration at time t
TYPE(TFILEDATA), INTENT(IN) :: TPFILE_SERIES_CLOUD_ELEC
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRR ! Rain instant precip
+REAL, DIMENSION(:,:), INTENT(IN) :: PINPRR ! Rain instant precip
!
!
!* 0.2 Declarations of local variables :
diff --git a/src/MNH/sources_neg_correct.f90 b/src/MNH/sources_neg_correct.f90
index 0302839408bb4045ae0b78adc29bdc812452c071..366fc1daafcb7e10049ec536a6977ccbe15c88e1 100644
--- a/src/MNH/sources_neg_correct.f90
+++ b/src/MNH/sources_neg_correct.f90
@@ -8,6 +8,7 @@
! P. Wautelet 30/06/2020: remove non-local corrections in resolved_cloud for NEGA => new local corrections here
! J. Escobar 21/07/2020: bug <-> array of size(:,:,:,0) => return if krr=0
! P. Wautelet 10/02/2021: budgets: add missing sources for NSV_C2R2BEG+3 budget
+! C. Barthe 03/02/2022: add corrections for electric charges
!-----------------------------------------------------------------
module mode_sources_neg_correct
@@ -19,7 +20,7 @@ public :: Sources_neg_correct,Sources_neg_correct_phy
contains
-subroutine Sources_neg_correct_phy(D, KSV, hcloud, hbudname, KRR, ptstep, ppabst, ptht, prt, prths, prrs, prsvs, prhodj)
+subroutine Sources_neg_correct_phy(D, KSV, hcloud, helec, hbudname, KRR, ptstep, ppabst, ptht, prt, prths, prrs, prsvs, prhodj)
!
USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
!
@@ -28,22 +29,23 @@ IMPLICIT NONE
TYPE(DIMPHYEX_t), INTENT(IN) :: D
INTEGER, INTENT(IN) :: KSV
character(len=*), intent(in) :: hcloud ! Kind of cloud parameterization
+character(len=*), intent(in) :: helec ! Kind of cloud electricity parameterization
character(len=*), intent(in) :: hbudname ! Budget name
integer, intent(in) :: KRR ! Number of moist variables
real, intent(in) :: ptstep ! Timestep
real, dimension(D%NIT,D%NJT,D%NKT), intent(in) :: ppabst ! Absolute pressure at time t
real, dimension(D%NIT,D%NJT,D%NKT), intent(in) :: ptht ! Theta at time t
-real, dimension(D%NIT,D%NJT,D%NKT, KRR), intent(in) :: prt ! Moist variables at time t
+real, dimension(D%NIT,D%NJT,D%NKT, KRR), intent(in) :: prt ! Moist variables at time t
real, dimension(D%NIT,D%NJT,D%NKT), intent(inout) :: prths ! Source terms
-real, dimension(D%NIT,D%NJT,D%NKT, KRR), intent(inout) :: prrs ! Source terms
-real, dimension(D%NIT,D%NJT,D%NKT, KSV), intent(inout) :: prsvs ! Source terms
+real, dimension(D%NIT,D%NJT,D%NKT, KRR), intent(inout) :: prrs ! Source terms
+real, dimension(D%NIT,D%NJT,D%NKT, KSV), intent(inout) :: prsvs ! Source terms
real, dimension(D%NIT,D%NJT,D%NKT), intent(in), optional :: prhodj ! Dry density * jacobian
!
-CALL SOURCES_NEG_CORRECT(HCLOUD, 'NETUR',KRR,PTSTEP,PPABST,PTHT,PRT,PRTHS,PRRS,PRSVS)
+CALL SOURCES_NEG_CORRECT(HCLOUD, HELEC, 'NETUR',KRR,PTSTEP,PPABST,PTHT,PRT,PRTHS,PRRS,PRSVS)
!
end subroutine Sources_neg_correct_phy
!
-subroutine Sources_neg_correct( hcloud, hbudname, krr, ptstep, ppabst, ptht, prt, prths, prrs, prsvs, prhodj )
+subroutine Sources_neg_correct( hcloud, helec, hbudname, krr, ptstep, ppabst, ptht, prt, prths, prrs, prsvs, prhodj )
use modd_budget, only: lbudget_th, lbudget_rv, lbudget_rc, lbudget_rr, lbudget_ri, &
lbudget_rs, lbudget_rg, lbudget_rh, lbudget_sv, &
@@ -52,9 +54,11 @@ use modd_budget, only: lbudget_th, lbudget_rv, lbudget_rc, lbudget_rr, lbudg
tbudgets
use modd_cst, only: xci, xcl, xcpd, xcpv, xlstt, xlvtt, xp00, xrd, xtt
use modd_nsv, only: nsv_c2r2beg, nsv_c2r2end, nsv_lima_beg, nsv_lima_end, nsv_lima_nc, nsv_lima_nr,&
- nsv_lima_ni, nsv_lima_ns, nsv_lima_ng, nsv_lima_nh
+ nsv_lima_ni, nsv_lima_ns, nsv_lima_ng, nsv_lima_nh, &
+ nsv_elecbeg, nsv_elecend
use modd_param_lima, only: lspro_lima => lspro, &
xctmin_lima => xctmin, xrtmin_lima => xrtmin
+use modd_elec_descr, only: xrtmin_elec, xecharge
use mode_budget, only: Budget_store_init, Budget_store_end
use mode_msg
@@ -62,6 +66,7 @@ use mode_msg
implicit none
character(len=*), intent(in) :: hcloud ! Kind of cloud parameterization
+character(len=*), intent(in) :: helec ! Kind of cloud electricity parameterization
character(len=*), intent(in) :: hbudname ! Budget name
integer, intent(in) :: krr ! Number of moist variables
real, intent(in) :: ptstep ! Timestep
@@ -80,6 +85,7 @@ integer :: jsv
integer :: isv_lima_end
real, dimension(:, :, :), allocatable :: zt, zexn, zlv, zls, zcph, zcor
logical, dimension(:, :, :), allocatable :: zmask
+real, dimension(:, :, :), allocatable :: zadd, zion_number !++cb--
if ( krr == 0 ) return
@@ -124,6 +130,11 @@ if ( hbudname /= 'NECON' .and. hbudname /= 'NEGA' ) then
call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + ji), Trim( hbudname ), prsvs(:, :, :, ji) )
end do
end if
+ if ( lbudget_sv .and. helec(1:3) == 'ELE' ) then
+ do ji = nsv_elecbeg, nsv_elecend
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + ji), Trim( hbudname ), prsvs(:, :, :, ji) )
+ end do
+ end if
else !NECON + NEGA
if ( .not. present( prhodj ) ) &
call Print_msg( NVERB_FATAL, 'GEN', 'Sources_neg_correct', 'optional argument prhodj not present' )
@@ -150,6 +161,11 @@ else !NECON + NEGA
call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + ji), Trim( hbudname ), prsvs(:, :, :, ji) * prhodj(:, :, :) )
end do
end if
+ if ( lbudget_sv .and. helec(1:3) == 'ELE' ) then
+ do ji = nsv_elecbeg, nsv_elecend
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + ji), Trim( hbudname ), prsvs(:, :, :, ji) * prhodj(:, :, :) )
+ end do
+ end if
end if
allocate( zt ( Size( prths, 1 ), Size( prths, 2 ), Size( prths, 3 ) ) )
@@ -166,6 +182,13 @@ if ( hcloud == 'ICE3' .or. hcloud == 'ICE4' .or. hcloud == 'LIMA' ) then
end if
zcph(:, :, :) = xcpd + xcpv * prt(:, :, :, 1)
+!++cb++
+if ( helec(1:3) == 'ELE' ) then
+ allocate( zadd( Size( prths, 1 ), Size( prths, 2 ), Size( prths, 3 ) ) )
+ allocate( zion_number( Size( prths, 1 ), Size( prths, 2 ), Size( prths, 3 ) ) )
+end if
+!--cb--
+
deallocate( zt )
CLOUD: select case ( hcloud )
@@ -195,12 +218,29 @@ CLOUD: select case ( hcloud )
jrmax = Size( prrs, 4 )
end if
do jr = 4, jrmax
- where ( prrs(:, :, :, jr) < 0.)
- prrs(:, :, :, 1) = prrs(:, :, :, 1) + prrs(:, :, :, jr)
- prths(:, :, :) = prths(:, :, :) - prrs(:, :, :, jr) * zls(:, :, :) / &
- ( zcph(:, :, :) * zexn(:, :, :) )
- prrs(:, :, :, jr) = 0.
- end where
+ if ( helec(1:3) == 'ELE' ) then
+ where ( prrs(:, :, :, jr) < 0.)
+ prrs(:, :, :, 1) = prrs(:, :, :, 1) + prrs(:, :, :, jr)
+ prths(:, :, :) = prths(:, :, :) - prrs(:, :, :, jr) * zls(:, :, :) / &
+ ( zcph(:, :, :) * zexn(:, :, :) )
+ prrs(:, :, :, jr) = 0.
+ !
+ zion_number(:,:,:) = abs(prsvs(:,:,:,nsv_elecbeg+jr-1)) / xecharge
+ zadd(:,:,:) = 0.5 + sign(0.5, prsvs(:,:,:,nsv_elecbeg+jr-1))
+ prsvs(:,:,:,nsv_elecbeg) = prsvs(:,:,:,nsv_elecbeg) + &
+ zadd(:,:,:) * zion_number(:,:,:)
+ prsvs(:,:,:,nsv_elecend) = prsvs(:,:,:,nsv_elecend) + &
+ (1. - zadd(:,:,:)) * zion_number(:,:,:)
+ prsvs(:,:,:,nsv_elecbeg+jr-1) = 0.0
+ end where
+ else
+ where ( prrs(:, :, :, jr) < 0.)
+ prrs(:, :, :, 1) = prrs(:, :, :, 1) + prrs(:, :, :, jr)
+ prths(:, :, :) = prths(:, :, :) - prrs(:, :, :, jr) * zls(:, :, :) / &
+ ( zcph(:, :, :) * zexn(:, :, :) )
+ prrs(:, :, :, jr) = 0.
+ end where
+ end if
end do
!
! cloud
@@ -210,34 +250,119 @@ CLOUD: select case ( hcloud )
jrmax = 3
end if
do jr = 2, jrmax
- where ( prrs(:, :, :, jr) < 0.)
- prrs(:, :, :, 1) = prrs(:, :, :, 1) + prrs(:, :, :, jr)
- prths(:, :, :) = prths(:, :, :) - prrs(:, :, :, jr) * zlv(:, :, :) / &
- ( zcph(:, :, :) * zexn(:, :, :) )
- prrs(:, :, :, jr) = 0.
- end where
+ if ( helec(1:3) == 'ELE' ) then
+ where ( prrs(:, :, :, jr) < 0.)
+ prrs(:, :, :, 1) = prrs(:, :, :, 1) + prrs(:, :, :, jr)
+ prths(:, :, :) = prths(:, :, :) - prrs(:, :, :, jr) * zlv(:, :, :) / &
+ ( zcph(:, :, :) * zexn(:, :, :) )
+ prrs(:, :, :, jr) = 0.
+ !
+ zion_number(:,:,:) = abs(prsvs(:,:,:,nsv_elecbeg+jr-1)) / xecharge
+ zadd(:,:,:) = 0.5 + sign(0.5, prsvs(:,:,:,nsv_elecbeg+jr-1))
+ prsvs(:,:,:,nsv_elecbeg) = prsvs(:,:,:,nsv_elecbeg) + &
+ zadd(:,:,:) * zion_number(:,:,:)
+ prsvs(:,:,:,nsv_elecend) = prsvs(:,:,:,nsv_elecend) + &
+ (1. - zadd(:,:,:)) * zion_number(:,:,:)
+ prsvs(:,:,:,nsv_elecbeg+jr-1) = 0.0
+ end where
+ else
+ where ( prrs(:, :, :, jr) < 0.)
+ prrs(:, :, :, 1) = prrs(:, :, :, 1) + prrs(:, :, :, jr)
+ prths(:, :, :) = prths(:, :, :) - prrs(:, :, :, jr) * zlv(:, :, :) / &
+ ( zcph(:, :, :) * zexn(:, :, :) )
+ prrs(:, :, :, jr) = 0.
+ end where
+ end if
end do
!
! if rc or ri are positive, we can correct negative rv
+ if ( helec(1:3) == 'ELE' ) then
! cloud
- where ( prrs(:, :, :, 1) < 0. .and. prrs(:, :, :, 2) > 0. )
- prrs(:, :, :, 1) = prrs(:, :, :, 1) + prrs(:, :, :, 2)
- prths(:, :, :) = prths(:, :, :) - prrs(:, :, :, 2) * zlv(:, :, :) / &
- ( zcph(:, :, :) * zexn(:, :, :) )
- prrs(:, :, :, 2) = 0.
- end where
+ where ( prrs(:, :, :, 1) < 0. .and. prrs(:, :, :, 2) > 0. )
+ prrs(:, :, :, 1) = prrs(:, :, :, 1) + prrs(:, :, :, 2)
+ prths(:, :, :) = prths(:, :, :) - prrs(:, :, :, 2) * zlv(:, :, :) / &
+ ( zcph(:, :, :) * zexn(:, :, :) )
+ prrs(:, :, :, 2) = 0.
+ !
+ zion_number(:,:,:) = abs(prsvs(:,:,:,nsv_elecbeg+1)) / xecharge
+ zadd(:,:,:) = 0.5 + sign(0.5, prsvs(:,:,:,nsv_elecbeg+1))
+ prsvs(:,:,:,nsv_elecbeg) = prsvs(:,:,:,nsv_elecbeg) + &
+ zadd(:,:,:) * zion_number(:,:,:)
+ prsvs(:,:,:,nsv_elecend) = prsvs(:,:,:,nsv_elecend) + &
+ (1. - zadd(:,:,:)) * zion_number(:,:,:)
+ prsvs(:,:,:,nsv_elecbeg+1) = 0.0
+ end where
! ice
- if ( krr > 3 ) then
- allocate( zcor( Size( prths, 1 ), Size( prths, 2 ), Size( prths, 3 ) ) )
- where ( prrs(:, :, :, 1) < 0. .and. prrs(:, :, :, 4) > 0. )
- zcor(:, :, :) = Min( -prrs(:, :, :, 1), prrs(:, :, :, 4) )
- prrs(:, :, :, 1) = prrs(:, :, :, 1) + zcor(:, :, :)
- prths(:, :, :) = prths(:, :, :) - zcor(:, :, :) * zls(:, :, :) / &
+ if ( krr > 3 ) then
+ allocate( zcor( Size( prths, 1 ), Size( prths, 2 ), Size( prths, 3 ) ) )
+ where ( prrs(:, :, :, 1) < 0. .and. prrs(:, :, :, 4) > 0. )
+ zcor(:, :, :) = Min( -prrs(:, :, :, 1), prrs(:, :, :, 4) )
+ prrs(:, :, :, 1) = prrs(:, :, :, 1) + zcor(:, :, :)
+ prths(:, :, :) = prths(:, :, :) - zcor(:, :, :) * zls(:, :, :) / &
+ ( zcph(:, :, :) * zexn(:, :, :) )
+ prrs(:, :, :, 4) = prrs(:, :, :, 4) - zcor(:, :, :)
+ !
+ zion_number(:,:,:) = abs(prsvs(:,:,:,nsv_elecbeg+3)) / xecharge
+ zadd(:,:,:) = 0.5 + sign(0.5, prsvs(:,:,:,nsv_elecbeg+3))
+ prsvs(:,:,:,nsv_elecbeg) = prsvs(:,:,:,nsv_elecbeg) + &
+ zadd(:,:,:) * zion_number(:,:,:)
+ prsvs(:,:,:,nsv_elecend) = prsvs(:,:,:,nsv_elecend) + &
+ (1. - zadd(:,:,:)) * zion_number(:,:,:)
+ prsvs(:,:,:,nsv_elecbeg+3) = 0.0
+ end where
+ deallocate(zcor)
+ end if
+ else
+! cloud
+ where ( prrs(:, :, :, 1) < 0. .and. prrs(:, :, :, 2) > 0. )
+ prrs(:, :, :, 1) = prrs(:, :, :, 1) + prrs(:, :, :, 2)
+ prths(:, :, :) = prths(:, :, :) - prrs(:, :, :, 2) * zlv(:, :, :) / &
( zcph(:, :, :) * zexn(:, :, :) )
- prrs(:, :, :, 4) = prrs(:, :, :, 4) - zcor(:, :, :)
+ prrs(:, :, :, 2) = 0.
end where
+! ice
+ if ( krr > 3 ) then
+ allocate( zcor( Size( prths, 1 ), Size( prths, 2 ), Size( prths, 3 ) ) )
+ where ( prrs(:, :, :, 1) < 0. .and. prrs(:, :, :, 4) > 0. )
+ zcor(:, :, :) = Min( -prrs(:, :, :, 1), prrs(:, :, :, 4) )
+ prrs(:, :, :, 1) = prrs(:, :, :, 1) + zcor(:, :, :)
+ prths(:, :, :) = prths(:, :, :) - zcor(:, :, :) * zls(:, :, :) / &
+ ( zcph(:, :, :) * zexn(:, :, :) )
+ prrs(:, :, :, 4) = prrs(:, :, :, 4) - zcor(:, :, :)
+ end where
+ deallocate(zcor)
+ end if
end if
!
+!++cb++ 08/06/23 deplace a la fin pour traiter aussi le cas de lima
+! cascade the electric charge in the absence of hydrometeor
+! if ( helec(1:3) == 'ELE' ) then
+! do jr = krr, 5, -1
+! where(prrs(:,:,:,jr) < xrtmin_elec(jr))
+! prsvs(:,:,:,nsv_elecbeg-2+jr) = prsvs(:,:,:,nsv_elecbeg-2+jr) + &
+! prsvs(:,:,:,nsv_elecbeg-1+jr)
+! prsvs(:,:,:,nsv_elecbeg-1+jr) = 0.0
+! end where
+! end do
+! jr = 3
+! where(prrs(:,:,:,jr) < xrtmin_elec(jr))
+! prsvs(:,:,:,nsv_elecbeg-2+jr) = prsvs(:,:,:,nsv_elecbeg-2+jr) + &
+! prsvs(:,:,:,nsv_elecbeg-1+jr)
+! prsvs(:,:,:,nsv_elecbeg-1+jr) = 0.0
+! end where
+! do jr = 4, 2, -2
+! where(prrs(:,:,:,jr) < xrtmin_elec(jr))
+! zion_number(:,:,:) = abs(prsvs(:,:,:,nsv_elecbeg-1+jr)) / xecharge
+! zadd(:,:,:) = 0.5 + sign(0.5, prsvs(:,:,:,nsv_elecbeg-1+jr))
+! prsvs(:,:,:,nsv_elecbeg) = prsvs(:,:,:,nsv_elecbeg) + &
+! zadd(:,:,:) * zion_number(:,:,:)
+! prsvs(:,:,:,nsv_elecend) = prsvs(:,:,:,nsv_elecend) + &
+! (1. - zadd(:,:,:)) * zion_number(:,:,:)
+! prsvs(:,:,:,nsv_elecbeg-1+jr) = 0.0
+! end where
+! end do
+! end if
+!--cb--
!
case( 'C2R2', 'KHKO' )
where ( prrs(:, :, :, 2) < 0. .or. prsvs(:, :, :, nsv_c2r2beg + 1) < 0. )
@@ -262,110 +387,246 @@ CLOUD: select case ( hcloud )
!
!
case( 'LIMA' )
- allocate( zmask ( Size( prths, 1 ), Size( prths, 2 ), Size( prths, 3 ) ) )
+ allocate( zmask ( Size( prths, 1 ), Size( prths, 2 ), Size( prths, 3 ) ) )
+!
! Correction where rc<0 or Nc<0
- if ( krr.GE.2 ) then
- zmask(:,:,:)=(prrs(:, :, :, 2) < xrtmin_lima(2) / ptstep)
- if (nsv_lima_nc.gt.0) zmask(:,:,:)=(zmask(:,:,:) .or. prsvs(:, :, :, nsv_lima_nc) < xctmin_lima(2) / ptstep )
+ if ( krr.GE.2 ) then
+ zmask(:,:,:)=(prrs(:, :, :, 2) < xrtmin_lima(2) / ptstep)
+ if (nsv_lima_nc.gt.0) zmask(:,:,:)=(zmask(:,:,:) .or. prsvs(:, :, :, nsv_lima_nc) < xctmin_lima(2) / ptstep )
+ if ( helec == 'ELE4' ) then
where ( zmask(:,:,:) )
- prrs(:, :, :, 1) = prrs(:, :, :, 1) + prrs(:, :, :, 2)
- prths(:, :, :) = prths(:, :, :) - prrs(:, :, :, 2) * zlv(:, :, :) / &
- ( zcph(:, :, :) * zexn(:, :, :) )
- prrs(:, :, :, 2) = 0.
+ prrs(:, :, :, 1) = prrs(:, :, :, 1) + prrs(:, :, :, 2)
+ prths(:, :, :) = prths(:, :, :) - prrs(:, :, :, 2) * zlv(:, :, :) / &
+ ( zcph(:, :, :) * zexn(:, :, :) )
+ prrs(:, :, :, 2) = 0.
+ !
+ zion_number(:,:,:) = abs(prsvs(:,:,:,nsv_elecbeg+1)) / xecharge
+ zadd(:,:,:) = 0.5 + sign(0.5, prsvs(:,:,:,nsv_elecbeg+1))
+ prsvs(:,:,:,nsv_elecbeg) = prsvs(:,:,:,nsv_elecbeg) + &
+ zadd(:,:,:) * zion_number(:,:,:)
+ prsvs(:,:,:,nsv_elecend) = prsvs(:,:,:,nsv_elecend) + &
+ (1. - zadd(:,:,:)) * zion_number(:,:,:)
+ prsvs(:,:,:,nsv_elecbeg+1) = 0.0
end where
where ( prrs(:, :, :, 1) < 0. .and. prrs(:, :, :, 2) > 0. )
- prrs(:, :, :, 1) = prrs(:, :, :, 1) + prrs(:, :, :, 2)
- prths(:, :, :) = prths(:, :, :) - prrs(:, :, :, 2) * zlv(:, :, :) / &
- ( zcph(:, :, :) * zexn(:, :, :) )
- prrs(:, :, :, 2) = 0.
+ prrs(:, :, :, 1) = prrs(:, :, :, 1) + prrs(:, :, :, 2)
+ prths(:, :, :) = prths(:, :, :) - prrs(:, :, :, 2) * zlv(:, :, :) / &
+ ( zcph(:, :, :) * zexn(:, :, :) )
+ prrs(:, :, :, 2) = 0.
+ !
+ zion_number(:,:,:) = abs(prsvs(:,:,:,nsv_elecbeg+1)) / xecharge
+ zadd(:,:,:) = 0.5 + sign(0.5, prsvs(:,:,:,nsv_elecbeg+1))
+ prsvs(:,:,:,nsv_elecbeg) = prsvs(:,:,:,nsv_elecbeg) + &
+ zadd(:,:,:) * zion_number(:,:,:)
+ prsvs(:,:,:,nsv_elecend) = prsvs(:,:,:,nsv_elecend) + &
+ (1. - zadd(:,:,:)) * zion_number(:,:,:)
+ prsvs(:,:,:,nsv_elecbeg+1) = 0.0
+ end where
+ else
+ where ( zmask(:,:,:) )
+ prrs(:, :, :, 1) = prrs(:, :, :, 1) + prrs(:, :, :, 2)
+ prths(:, :, :) = prths(:, :, :) - prrs(:, :, :, 2) * zlv(:, :, :) / &
+ ( zcph(:, :, :) * zexn(:, :, :) )
+ prrs(:, :, :, 2) = 0.
end where
- if (nsv_lima_nc.gt.0) then
- where (prrs(:, :, :, 2) == 0.) prsvs(:, :, :, nsv_lima_nc) = 0.
- end if
- end if
+ where ( prrs(:, :, :, 1) < 0. .and. prrs(:, :, :, 2) > 0. )
+ prrs(:, :, :, 1) = prrs(:, :, :, 1) + prrs(:, :, :, 2)
+ prths(:, :, :) = prths(:, :, :) - prrs(:, :, :, 2) * zlv(:, :, :) / &
+ ( zcph(:, :, :) * zexn(:, :, :) )
+ prrs(:, :, :, 2) = 0.
+ end where
+ end if
+ if (nsv_lima_nc.gt.0) then
+ where (prrs(:, :, :, 2) == 0.) prsvs(:, :, :, nsv_lima_nc) = 0.
+ end if
+ end if
+!
! Correction where rr<0 or Nr<0
- if ( krr.GE.3 .and. hbudname.ne.'NETUR' ) then
- zmask(:,:,:)=(prrs(:, :, :, 3) < xrtmin_lima(3) / ptstep)
- if (nsv_lima_nr.gt.0) zmask(:,:,:)=(zmask(:,:,:) .or. prsvs(:, :, :, nsv_lima_nr) < xctmin_lima(3) / ptstep )
+ if ( krr.GE.3 .and. hbudname.ne.'NETUR' ) then
+ zmask(:,:,:)=(prrs(:, :, :, 3) < xrtmin_lima(3) / ptstep)
+ if (nsv_lima_nr.gt.0) zmask(:,:,:)=(zmask(:,:,:) .or. prsvs(:, :, :, nsv_lima_nr) < xctmin_lima(3) / ptstep )
+ where ( zmask(:,:,:) )
+ prrs(:, :, :, 1) = prrs(:, :, :, 1) + prrs(:, :, :, 3)
+ prths(:, :, :) = prths(:, :, :) - prrs(:, :, :, 3) * zlv(:, :, :) / &
+ ( zcph(:, :, :) * zexn(:, :, :) )
+ prrs(:, :, :, 3) = 0.
+ end where
+ if ( helec == 'ELE4' ) then
where ( zmask(:,:,:) )
- prrs(:, :, :, 1) = prrs(:, :, :, 1) + prrs(:, :, :, 3)
- prths(:, :, :) = prths(:, :, :) - prrs(:, :, :, 3) * zlv(:, :, :) / &
- ( zcph(:, :, :) * zexn(:, :, :) )
- prrs(:, :, :, 3) = 0.
+ zion_number(:,:,:) = abs(prsvs(:,:,:,nsv_elecbeg+2)) / xecharge
+ zadd(:,:,:) = 0.5 + sign(0.5, prsvs(:,:,:,nsv_elecbeg+2))
+ prsvs(:,:,:,nsv_elecbeg) = prsvs(:,:,:,nsv_elecbeg) + &
+ zadd(:,:,:) * zion_number(:,:,:)
+ prsvs(:,:,:,nsv_elecend) = prsvs(:,:,:,nsv_elecend) + &
+ (1. - zadd(:,:,:)) * zion_number(:,:,:)
+ prsvs(:,:,:,nsv_elecbeg+2) = 0.0
end where
- if (nsv_lima_nr.gt.0) then
- where (prrs(:, :, :, 3) == 0.) prsvs(:, :, :, nsv_lima_nr) = 0.
- end if
- end if
+ end if
+ if (nsv_lima_nr.gt.0) then
+ where (prrs(:, :, :, 3) == 0.) prsvs(:, :, :, nsv_lima_nr) = 0.
+ end if
+ end if
+!
! Correction where ri<0 or Ni<0
- if ( krr.GE.4 ) then
- zmask(:,:,:)=(prrs(:, :, :, 4) < xrtmin_lima(4) / ptstep)
- if (nsv_lima_ni.gt.0) zmask(:,:,:)=(zmask(:,:,:) .or. prsvs(:, :, :, nsv_lima_ni) < xctmin_lima(4) / ptstep)
+ if ( krr.GE.4 ) then
+ zmask(:,:,:)=(prrs(:, :, :, 4) < xrtmin_lima(4) / ptstep)
+ if (nsv_lima_ni.gt.0) zmask(:,:,:)=(zmask(:,:,:) .or. prsvs(:, :, :, nsv_lima_ni) < xctmin_lima(4) / ptstep)
+ where ( zmask(:,:,:) )
+ prrs(:, :, :, 1) = prrs(:, :, :, 1) + prrs(:, :, :, 4)
+ prths(:, :, :) = prths(:, :, :) - prrs(:, :, :, 4) * zls(:, :, :) / &
+ ( zcph(:, :, :) * zexn(:, :, :) )
+ prrs(:, :, :, 4) = 0.
+ end where
+ if ( helec == 'ELE4' ) then
where ( zmask(:,:,:) )
- prrs(:, :, :, 1) = prrs(:, :, :, 1) + prrs(:, :, :, 4)
- prths(:, :, :) = prths(:, :, :) - prrs(:, :, :, 4) * zls(:, :, :) / &
- ( zcph(:, :, :) * zexn(:, :, :) )
- prrs(:, :, :, 4) = 0.
+ zion_number(:,:,:) = abs(prsvs(:,:,:,nsv_elecbeg+3)) / xecharge
+ zadd(:,:,:) = 0.5 + sign(0.5, prsvs(:,:,:,nsv_elecbeg+3))
+ prsvs(:,:,:,nsv_elecbeg) = prsvs(:,:,:,nsv_elecbeg) + &
+ zadd(:,:,:) * zion_number(:,:,:)
+ prsvs(:,:,:,nsv_elecend) = prsvs(:,:,:,nsv_elecend) + &
+ (1. - zadd(:,:,:)) * zion_number(:,:,:)
+ prsvs(:,:,:,nsv_elecbeg+3) = 0.0
end where
- allocate( zcor( Size( prths, 1 ), Size( prths, 2 ), Size( prths, 3 ) ) )
where ( prrs(:, :, :, 1) < 0. .and. prrs(:, :, :, 4) > 0. )
- zcor(:, :, :) = Min( -prrs(:, :, :, 1), prrs(:, :, :, 4) )
- prrs(:, :, :, 1) = prrs(:, :, :, 1) + zcor(:, :, :)
- prths(:, :, :) = prths(:, :, :) - zcor(:, :, :) * zls(:, :, :) / &
- ( zcph(:, :, :) * zexn(:, :, :) )
- prrs(:, :, :, 4) = prrs(:, :, :, 4) - zcor(:, :, :)
+ zion_number(:,:,:) = abs(prsvs(:,:,:,nsv_elecbeg+3)) / xecharge
+ zadd(:,:,:) = 0.5 + sign(0.5, prsvs(:,:,:,nsv_elecbeg+3))
+ prsvs(:,:,:,nsv_elecbeg) = prsvs(:,:,:,nsv_elecbeg) + &
+ zadd(:,:,:) * zion_number(:,:,:)
+ prsvs(:,:,:,nsv_elecend) = prsvs(:,:,:,nsv_elecend) + &
+ (1. - zadd(:,:,:)) * zion_number(:,:,:)
+ prsvs(:,:,:,nsv_elecbeg+3) = 0.0
end where
- deallocate( zcor )
- if (nsv_lima_ni.gt.0) then
- where (prrs(:, :, :, 4) == 0.) prsvs(:, :, :, nsv_lima_ni) = 0.
- end if
- end if
+ end if
+ allocate( zcor( Size( prths, 1 ), Size( prths, 2 ), Size( prths, 3 ) ) )
+ where ( prrs(:, :, :, 1) < 0. .and. prrs(:, :, :, 4) > 0. )
+ zcor(:, :, :) = Min( -prrs(:, :, :, 1), prrs(:, :, :, 4) )
+ prrs(:, :, :, 1) = prrs(:, :, :, 1) + zcor(:, :, :)
+ prths(:, :, :) = prths(:, :, :) - zcor(:, :, :) * zls(:, :, :) / &
+ ( zcph(:, :, :) * zexn(:, :, :) )
+ prrs(:, :, :, 4) = prrs(:, :, :, 4) - zcor(:, :, :)
+ end where
+ deallocate( zcor )
+ if (nsv_lima_ni.gt.0) then
+ where (prrs(:, :, :, 4) == 0.) prsvs(:, :, :, nsv_lima_ni) = 0.
+ end if
+ end if
+!
! Snow
- if ( krr.GE.5 .and. hbudname.ne.'NETUR' ) then
- zmask(:,:,:)=(prrs(:, :, :, 5) < xrtmin_lima(5) / ptstep)
- if (nsv_lima_ns.gt.0) zmask(:,:,:)=(zmask(:,:,:) .or. prsvs(:, :, :, nsv_lima_ns) < xctmin_lima(5) / ptstep )
+ if ( krr.GE.5 .and. hbudname.ne.'NETUR' ) then
+ zmask(:,:,:)=(prrs(:, :, :, 5) < xrtmin_lima(5) / ptstep)
+ if (nsv_lima_ns.gt.0) zmask(:,:,:)=(zmask(:,:,:) .or. prsvs(:, :, :, nsv_lima_ns) < xctmin_lima(5) / ptstep )
+ where ( zmask(:,:,:) )
+ prrs(:, :, :, 1) = prrs(:, :, :, 1) + prrs(:, :, :, 5)
+ prths(:, :, :) = prths(:, :, :) - prrs(:, :, :, 5) * zls(:, :, :) / &
+ ( zcph(:, :, :) * zexn(:, :, :) )
+ prrs(:, :, :, 5) = 0.
+ end where
+ if ( helec == 'ELE4' ) then
where ( zmask(:,:,:) )
- prrs(:, :, :, 1) = prrs(:, :, :, 1) + prrs(:, :, :, 5)
- prths(:, :, :) = prths(:, :, :) - prrs(:, :, :, 5) * zls(:, :, :) / &
- ( zcph(:, :, :) * zexn(:, :, :) )
- prrs(:, :, :, 5) = 0.
+ zion_number(:,:,:) = abs(prsvs(:,:,:,nsv_elecbeg+4)) / xecharge
+ zadd(:,:,:) = 0.5 + sign(0.5, prsvs(:,:,:,nsv_elecbeg+4))
+ prsvs(:,:,:,nsv_elecbeg) = prsvs(:,:,:,nsv_elecbeg) + &
+ zadd(:,:,:) * zion_number(:,:,:)
+ prsvs(:,:,:,nsv_elecend) = prsvs(:,:,:,nsv_elecend) + &
+ (1. - zadd(:,:,:)) * zion_number(:,:,:)
+ prsvs(:,:,:,nsv_elecbeg+4) = 0.0
end where
- if (nsv_lima_ns.gt.0) then
- where (prrs(:, :, :, 5) == 0.) prsvs(:, :, :, nsv_lima_ns) = 0.
- end if
- end if
+ end if
+ if (nsv_lima_ns.gt.0) then
+ where (prrs(:, :, :, 5) == 0.) prsvs(:, :, :, nsv_lima_ns) = 0.
+ end if
+ end if
+!
! Graupel
- if ( krr.GE.6 .and. hbudname.ne.'NETUR' ) then
- zmask(:,:,:)=(prrs(:, :, :, 6) < xrtmin_lima(6) / ptstep)
- if (nsv_lima_ng.gt.0) zmask(:,:,:)=(zmask(:,:,:) .or. prsvs(:, :, :, nsv_lima_ng) < xctmin_lima(6) / ptstep )
+ if ( krr.GE.6 .and. hbudname.ne.'NETUR' ) then
+ zmask(:,:,:)=(prrs(:, :, :, 6) < xrtmin_lima(6) / ptstep)
+ if (nsv_lima_ng.gt.0) zmask(:,:,:)=(zmask(:,:,:) .or. prsvs(:, :, :, nsv_lima_ng) < xctmin_lima(6) / ptstep )
+ where ( zmask(:,:,:) )
+ prrs(:, :, :, 1) = prrs(:, :, :, 1) + prrs(:, :, :, 6)
+ prths(:, :, :) = prths(:, :, :) - prrs(:, :, :, 6) * zls(:, :, :) / &
+ ( zcph(:, :, :) * zexn(:, :, :) )
+ prrs(:, :, :, 6) = 0.
+ end where
+ if ( helec == 'ELE4' ) then
where ( zmask(:,:,:) )
- prrs(:, :, :, 1) = prrs(:, :, :, 1) + prrs(:, :, :, 6)
- prths(:, :, :) = prths(:, :, :) - prrs(:, :, :, 6) * zls(:, :, :) / &
- ( zcph(:, :, :) * zexn(:, :, :) )
- prrs(:, :, :, 6) = 0.
+ zion_number(:,:,:) = abs(prsvs(:,:,:,nsv_elecbeg+5)) / xecharge
+ zadd(:,:,:) = 0.5 + sign(0.5, prsvs(:,:,:,nsv_elecbeg+5))
+ prsvs(:,:,:,nsv_elecbeg) = prsvs(:,:,:,nsv_elecbeg) + &
+ zadd(:,:,:) * zion_number(:,:,:)
+ prsvs(:,:,:,nsv_elecend) = prsvs(:,:,:,nsv_elecend) + &
+ (1. - zadd(:,:,:)) * zion_number(:,:,:)
+ prsvs(:,:,:,nsv_elecbeg+5) = 0.0
end where
- if (nsv_lima_ng.gt.0) then
- where (prrs(:, :, :, 6) == 0.) prsvs(:, :, :, nsv_lima_ng) = 0.
- end if
- end if
+ end if
+ if (nsv_lima_ng.gt.0) then
+ where (prrs(:, :, :, 6) == 0.) prsvs(:, :, :, nsv_lima_ng) = 0.
+ end if
+ end if
+!
! Hail
- if ( krr.GE.7 .and. hbudname.ne.'NETUR' ) then
- zmask(:,:,:)=(prrs(:, :, :, 7) < xrtmin_lima(7) / ptstep)
- if (nsv_lima_nh.gt.0) zmask(:,:,:)=(zmask(:,:,:) .or. prsvs(:, :, :, nsv_lima_nh) < xctmin_lima(7) / ptstep )
+ if ( krr.GE.7 .and. hbudname.ne.'NETUR' ) then
+ zmask(:,:,:)=(prrs(:, :, :, 7) < xrtmin_lima(7) / ptstep)
+ if (nsv_lima_nh.gt.0) zmask(:,:,:)=(zmask(:,:,:) .or. prsvs(:, :, :, nsv_lima_nh) < xctmin_lima(7) / ptstep )
+ where ( zmask(:,:,:) )
+ prrs(:, :, :, 1) = prrs(:, :, :, 1) + prrs(:, :, :, 7)
+ prths(:, :, :) = prths(:, :, :) - prrs(:, :, :, 7) * zls(:, :, :) / &
+ ( zcph(:, :, :) * zexn(:, :, :) )
+ prrs(:, :, :, 7) = 0.
+ end where
+ if ( helec == 'ELE4' ) then
where ( zmask(:,:,:) )
- prrs(:, :, :, 1) = prrs(:, :, :, 1) + prrs(:, :, :, 7)
- prths(:, :, :) = prths(:, :, :) - prrs(:, :, :, 7) * zls(:, :, :) / &
- ( zcph(:, :, :) * zexn(:, :, :) )
- prrs(:, :, :, 7) = 0.
+ zion_number(:,:,:) = abs(prsvs(:,:,:,nsv_elecbeg+6)) / xecharge
+ zadd(:,:,:) = 0.5 + sign(0.5, prsvs(:,:,:,nsv_elecbeg+6))
+ prsvs(:,:,:,nsv_elecbeg) = prsvs(:,:,:,nsv_elecbeg) + &
+ zadd(:,:,:) * zion_number(:,:,:)
+ prsvs(:,:,:,nsv_elecend) = prsvs(:,:,:,nsv_elecend) + &
+ (1. - zadd(:,:,:)) * zion_number(:,:,:)
+ prsvs(:,:,:,nsv_elecbeg+6) = 0.0
end where
- if (nsv_lima_nh.gt.0) then
- where (prrs(:, :, :, 7) == 0.) prsvs(:, :, :, nsv_lima_nh) = 0.
- end if
- end if
+ end if
+ if (nsv_lima_nh.gt.0) then
+ where (prrs(:, :, :, 7) == 0.) prsvs(:, :, :, nsv_lima_nh) = 0.
+ end if
+ end if
!
- prsvs(:, :, :, nsv_lima_beg : isv_lima_end) = Max( 0.0, prsvs(:, :, :, nsv_lima_beg : isv_lima_end) )
- deallocate(zmask)
+ prsvs(:, :, :, nsv_lima_beg : isv_lima_end) = Max( 0.0, prsvs(:, :, :, nsv_lima_beg : isv_lima_end) )
+ deallocate(zmask)
end select CLOUD
+!
+! cascade the electric charge in the absence of hydrometeor
+if ( helec(1:3) == 'ELE' ) then
+ do jr = krr, 5, -1
+ where(prrs(:,:,:,jr) < xrtmin_elec(jr))
+ prsvs(:,:,:,nsv_elecbeg-2+jr) = prsvs(:,:,:,nsv_elecbeg-2+jr) + &
+ prsvs(:,:,:,nsv_elecbeg-1+jr)
+ prsvs(:,:,:,nsv_elecbeg-1+jr) = 0.0
+ end where
+ end do
+ jr = 3
+ where(prrs(:,:,:,jr) < xrtmin_elec(jr))
+ prsvs(:,:,:,nsv_elecbeg-2+jr) = prsvs(:,:,:,nsv_elecbeg-2+jr) + &
+ prsvs(:,:,:,nsv_elecbeg-1+jr)
+ prsvs(:,:,:,nsv_elecbeg-1+jr) = 0.0
+ end where
+ do jr = 4, 2, -2
+ where(prrs(:,:,:,jr) < xrtmin_elec(jr))
+ zion_number(:,:,:) = abs(prsvs(:,:,:,nsv_elecbeg-1+jr)) / xecharge
+ zadd(:,:,:) = 0.5 + sign(0.5, prsvs(:,:,:,nsv_elecbeg-1+jr))
+ prsvs(:,:,:,nsv_elecbeg) = prsvs(:,:,:,nsv_elecbeg) + &
+ zadd(:,:,:) * zion_number(:,:,:)
+ prsvs(:,:,:,nsv_elecend) = prsvs(:,:,:,nsv_elecend) + &
+ (1. - zadd(:,:,:)) * zion_number(:,:,:)
+ prsvs(:,:,:,nsv_elecbeg-1+jr) = 0.0
+ end where
+ end do
+end if
+!
+if (allocated(zion_number)) deallocate( zion_number )
+if (allocated(zadd)) deallocate( zadd )
+if (allocated(zls)) deallocate( zls )
+deallocate( zexn )
+deallocate( zlv )
+deallocate( zcph )
if ( hbudname /= 'NECON' .and. hbudname /= 'NEGA' ) then
@@ -397,6 +658,11 @@ if ( hbudname /= 'NECON' .and. hbudname /= 'NEGA' ) then
call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + ji), Trim( hbudname ), prsvs(:, :, :, ji) )
end do
end if
+ if ( lbudget_sv .and. helec(1:3) == 'ELE' ) then
+ do ji = nsv_elecbeg, nsv_elecend
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + ji), Trim( hbudname ), prsvs(:, :, :, ji) )
+ end do
+ end if
else !NECON + NEGA
if ( hcloud == 'KESS' .or. hcloud == 'ICE3' .or. hcloud == 'ICE4' .or. &
hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA' ) then
@@ -420,6 +686,11 @@ else !NECON + NEGA
call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + ji), Trim( hbudname ), prsvs(:, :, :, ji) * prhodj(:, :, :) )
end do
end if
+ if ( lbudget_sv .and. helec(1:3) == 'ELE' ) then
+ do ji = nsv_elecbeg, nsv_elecend
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + ji), Trim( hbudname ), prsvs(:, :, :, ji) * prhodj(:, :, :) )
+ end do
+ end if
end if
end subroutine Sources_neg_correct
diff --git a/src/PHYEX/micro/ini_param_elec.f90 b/src/PHYEX/micro/ini_param_elec.f90
index 03bc5fc30c2dc413ea721f83cdda88a4c543ae0e..b144572c51801be9f045437ebf8323b2a33b8994 100644
--- a/src/PHYEX/micro/ini_param_elec.f90
+++ b/src/PHYEX/micro/ini_param_elec.f90
@@ -10,18 +10,18 @@
IMPLICIT NONE
INTERFACE
!
- SUBROUTINE INI_PARAM_ELEC (TPINIFILE, HGETSVM, PRHO00, &
- KRR, KND, PFDINFTY, IIU, IJU, IKU )
+ SUBROUTINE INI_PARAM_ELEC (TPINIFILE, HGETSVT, HCLOUD, HELEC, &
+ PRHO00, KRR, IIU, IJU, IKU )
!
USE MODD_IO, ONLY : TFILEDATA
IMPLICIT NONE
!
-TYPE(TFILEDATA), INTENT(IN) :: TPINIFILE ! Initial file
-CHARACTER (LEN=*), DIMENSION(:),INTENT(IN) :: HGETSVM
-INTEGER, INTENT(IN) :: KND ! Number of intervals to integrate kernels
+TYPE(TFILEDATA), INTENT(IN) :: TPINIFILE ! Initial file
+CHARACTER (LEN=*), DIMENSION(:),INTENT(IN) :: HGETSVT
+CHARACTER (LEN=4), INTENT(IN) :: HCLOUD ! microphysics scheme
+CHARACTER (LEN=4), INTENT(IN) :: HELEC ! electrical scheme
INTEGER, INTENT(IN) :: KRR ! Number of moist variables
REAL, INTENT(IN) :: PRHO00 ! Pressure at ground level
-REAL, INTENT(IN) :: PFDINFTY ! Factor used to define the "infinite" diameter
INTEGER, INTENT(IN) :: IIU ! Upper dimension in x direction (local)
INTEGER, INTENT(IN) :: IJU ! Upper dimension in y direction (local)
INTEGER, INTENT(IN) :: IKU ! Upper dimension in z direction
@@ -30,10 +30,10 @@ END SUBROUTINE INI_PARAM_ELEC
END INTERFACE
END MODULE MODI_INI_PARAM_ELEC
!
-! ##############################################################
- SUBROUTINE INI_PARAM_ELEC (TPINIFILE, HGETSVM, PRHO00, &
- KRR, KND, PFDINFTY, IIU, IJU, IKU )
-! ##############################################################
+! ###############################################################
+ SUBROUTINE INI_PARAM_ELEC (TPINIFILE, HGETSVT, HCLOUD, HELEC, &
+ PRHO00, KRR, IIU, IJU, IKU)
+! ###############################################################
!
!!**** *INI_PARAM_ELEC* - initialize the constants necessary
!! for the electrical scheme.
@@ -88,6 +88,12 @@ END MODULE MODI_INI_PARAM_ELEC
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
! J. Wurtz 03/2022: new snow characteristics
+!! C. Barthe 04/02/2022 Add XGAMINC_RIM3 (no more initialized in ini_rain_ice_elec)
+!! C. Barthe 07/06/2022 Add parameters for charge sedimentation in LIMA
+!! C. Barthe 30/11/2022 Remove the section about charge neutralization ;
+!! already done in ini_flash_geom_elec
+!! C. Barthe 28/03/2023 Add parameters for sedimentation of cloud droplets charge
+!! C. Barthe 13/07/2023 Modify parameters that contain C_x and x_x for Ns, Ng and Nh
!
!-------------------------------------------------------------------------------
!
@@ -102,12 +108,48 @@ USE MODD_IO, ONLY: TFILEDATA
USE MODD_NSV, ONLY: NSV_ELECEND
USE MODD_PARAMETERS
USE MODD_PARAM_ICE_n
-USE MODD_RAIN_ICE_DESCR_n
-USE MODD_RAIN_ICE_PARAM_n
+USE MODD_PARAM_LIMA, ONLY : XALPHAC_L=>XALPHAC, XNUC_L=>XNUC, XALPHAR_L=>XALPHAR, XNUR_L=>XNUR, &
+ XALPHAI_L=>XALPHAI, XNUI_L=>XNUI, XALPHAS_L=>XALPHAS, XNUS_L=>XNUS, &
+ XALPHAG_L=>XALPHAG, XNUG_L=>XNUG, &
+ XCEXVT_L=>XCEXVT
+USE MODD_PARAM_LIMA_COLD, ONLY : XAI_L=>XAI, XBI_L=>XBI, XC_I_L=>XC_I, XDI_L=>XDI, &
+ XAS_L=>XAS, XBS_L=>XBS, XCS_L=>XCS, XDS_L=>XDS, XCCS_L=>XCCS, XCXS_L=>XCXS
+USE MODD_PARAM_LIMA_MIXED,ONLY : XAG_L=>XAG, XBG_L=>XBG, XCG_L=>XCG, XDG_L=>XDG, XCCG_L=>XCCG, XCXG_L=>XCXG, &
+ XAH_L=>XAH, XBH_L=>XBH, XCH_L=>XCH, XDH_L=>XDH, XCCH_L=>XCCH, XCXH_L=>XCXH, &
+ XALPHAH_L=>XALPHAH, XNUH_L=>XNUH, &
+ XGAMINC_BOUND_MIN_L=>XGAMINC_BOUND_MIN, XGAMINC_BOUND_MAX_L=>XGAMINC_BOUND_MAX, &
+ NGAMINC_L=>NGAMINC, NACCLBDAR_L=>NACCLBDAR, NACCLBDAS_L=>NACCLBDAS, &
+ XACCLBDAR_MIN_L=>XACCLBDAR_MIN, XACCLBDAR_MAX_L=>XACCLBDAR_MAX, &
+ XACCLBDAS_MIN_L=>XACCLBDAS_MIN, XACCLBDAS_MAX_L=>XACCLBDAS_MAX, &
+ NDRYLBDAR_L=>NDRYLBDAR, NDRYLBDAS_L=>NDRYLBDAS, NDRYLBDAG_L=>NDRYLBDAG, &
+ XDRYLBDAR_MIN_L=>XDRYLBDAR_MIN, XDRYLBDAR_MAX_L=>XDRYLBDAR_MAX, &
+ XDRYLBDAS_MIN_L=>XDRYLBDAS_MIN, XDRYLBDAS_MAX_L=>XDRYLBDAS_MAX, &
+ XDRYLBDAG_MIN_L=>XDRYLBDAG_MIN, XDRYLBDAG_MAX_L=>XDRYLBDAG_MAX
+USE MODD_PARAM_LIMA_WARM, ONLY : XAR_L=>XAR, XBR_L=>XBR, XCR_L=>XCR, XDR_L=>XDR, &
+ XCC_L=>XCC, XDC_L=>XDC, XCCR_L=>XCCR
+USE MODD_RAIN_ICE_DESCR_n,ONLY : XALPHAC_I=>XALPHAC, XNUC_I=>XNUC, XALPHAR_I=>XALPHAR, XNUR_I=>XNUR, &
+ XALPHAI_I=>XALPHAI, XNUI_I=>XNUI, XALPHAS_I=>XALPHAS, XNUS_I=>XNUS, &
+ XALPHAG_I=>XALPHAG, XNUG_I=>XNUG, XALPHAH_I=>XALPHAH, XNUH_I=>XNUH, &
+ XCC_I=>XCC, XDC_I=>XDC, &
+ XAR_I=>XAR, XBR_I=>XBR, XCR_I=>XCR, XDR_I=>XDR, XCCR_I=>XCCR, &
+ XAI_I=>XAI, XBI_I=>XBI, XC_I_I=>XC_I, XDI_I=>XDI, &
+ XAS_I=>XAS, XBS_I=>XBS, XCS_I=>XCS, XDS_I=>XDS, XCCS_I=>XCCS, XCXS_I=>XCXS, &
+ XAG_I=>XAG, XBG_I=>XBG, XCG_I=>XCG, XDG_I=>XDG, XCCG_I=>XCCG, XCXG_I=>XCXG, &
+ XAH_I=>XAH, XBH_I=>XBH, XCH_I=>XCH, XDH_I=>XDH, XCCH_I=>XCCH, XCXH_I=>XCXH, &
+ XCEXVT_I=>XCEXVT
+USE MODD_RAIN_ICE_PARAM_n,ONLY : XGAMINC_BOUND_MIN_I=>XGAMINC_BOUND_MIN, XGAMINC_BOUND_MAX_I=>XGAMINC_BOUND_MAX, &
+ NGAMINC_I=>NGAMINC, NACCLBDAR_I=>NACCLBDAR, NACCLBDAS_I=>NACCLBDAS, &
+ XACCLBDAR_MIN_I=>XACCLBDAR_MIN, XACCLBDAR_MAX_I=>XACCLBDAR_MAX, &
+ XACCLBDAS_MIN_I=>XACCLBDAS_MIN, XACCLBDAS_MAX_I=>XACCLBDAS_MAX, &
+ NDRYLBDAR_I=>NDRYLBDAR, NDRYLBDAS_I=>NDRYLBDAS, NDRYLBDAG_I=>NDRYLBDAG, &
+ XDRYLBDAR_MIN_I=>XDRYLBDAR_MIN, XDRYLBDAR_MAX_I=>XDRYLBDAR_MAX, &
+ XDRYLBDAS_MIN_I=>XDRYLBDAS_MIN, XDRYLBDAS_MAX_I=>XDRYLBDAS_MAX, &
+ XDRYLBDAG_MIN_I=>XDRYLBDAG_MIN, XDRYLBDAG_MAX_I=>XDRYLBDAG_MAX
USE MODD_VAR_ll
!
USE MODE_IO_FIELD_READ, only: IO_Field_read
!
+USE MODI_GAMMA_INC
USE MODI_MOMG
USE MODE_RRCOLSS, ONLY: RRCOLSS
USE MODE_RSCOLRG, ONLY: RSCOLRG
@@ -118,37 +160,211 @@ IMPLICIT NONE
!
!* 0.1 Declaration of dummy arguments
!
-TYPE(TFILEDATA), INTENT(IN) :: TPINIFILE ! Initial file
-CHARACTER (LEN=*), DIMENSION(:),INTENT(IN) :: HGETSVM
-INTEGER, INTENT(IN) :: KND ! Number of intervals to integrate kernels
+TYPE(TFILEDATA), INTENT(IN) :: TPINIFILE ! Initial file
+CHARACTER (LEN=*), DIMENSION(:),INTENT(IN) :: HGETSVT
+CHARACTER (LEN=4), INTENT(IN) :: HCLOUD ! microphysics scheme
+CHARACTER (LEN=4), INTENT(IN) :: HELEC ! electrical scheme
INTEGER, INTENT(IN) :: KRR ! Number of moist variables
REAL, INTENT(IN) :: PRHO00 ! Pressure at ground level
-REAL, INTENT(IN) :: PFDINFTY ! Factor used to define the "infinite" diameter
INTEGER, INTENT(IN) :: IIU ! Upper dimension in x direction (local)
INTEGER, INTENT(IN) :: IJU ! Upper dimension in y direction (local)
INTEGER, INTENT(IN) :: IKU ! Upper dimension in z direction
!
!* 0.2 Declaration of local variables
!
+INTEGER :: IND ! Number of intervals to integrate kernels
+INTEGER :: J1, JLWC, JTEMP
+INTEGER :: IGAMINC, IACCLBDAR, IACCLBDAS, IDRYLBDAR, IDRYLBDAS, IDRYLBDAG
+!
+REAL :: ZRATE ! Geometrical growth of Lbda in the tabulated
+ ! functions and kernels
+REAL :: ZBOUND ! XDCSLIM*Lbda_s: upper bound for the partial
+ ! integration of the riming rate of the aggregates
+!
REAL :: ZESR ! Mean efficiency of rain-aggregate collection
REAL :: ZEGS !
REAL :: ZEGR
+REAL :: ZFDINFTY ! Factor used to define the "infinite" diameter
+! variables used to cope with the module variables common to icex and lima
+REAL :: ZCEXVT, &
+ ZCC, ZDC, ZALPHAC, ZNUC, &
+ ZAR, ZBR, ZCR, ZDR, ZCCR, ZALPHAR, ZNUR, &
+ ZAI, ZBI, ZCI, ZDI, ZALPHAI, ZNUI, &
+ ZAS, ZBS, ZCS, ZDS, ZCCS, ZCXS, ZALPHAS, ZNUS, &
+ ZAG, ZBG, ZCG, ZDG, ZCCG, ZCXG, ZALPHAG, ZNUG, &
+ ZAH, ZBH, ZCH, ZDH, ZCCH, ZCXH, ZALPHAH, ZNUH, &
+ ZGAMINC_BOUND_MIN, ZGAMINC_BOUND_MAX, &
+ ZACCLBDAR_MIN, ZACCLBDAR_MAX, ZACCLBDAS_MIN, ZACCLBDAS_MAX, &
+ ZDRYLBDAR_MIN, ZDRYLBDAR_MAX, ZDRYLBDAS_MIN, ZDRYLBDAS_MAX, &
+ ZDRYLBDAG_MIN, ZDRYLBDAG_MAX
+!
REAL, DIMENSION(:,:), ALLOCATABLE :: ZMANSELL1, ZMANSELL2 ! Used to initialize
! XMANSELL array
!
-INTEGER :: JLWC, JTEMP
-REAL, DIMENSION(:), ALLOCATABLE :: ZT, ZLWCC, ZEW
+REAL, DIMENSION(:), ALLOCATABLE :: ZT, ZLWCC, ZEW
!
!-------------------------------------------------------------------------------
-! constants for electricity
+!
+!* 1. PRELIMINARIES
+! -------------
+!
+!* 1.1 Constants for electricity
!
XEPSILON = 8.85E-12 ! Dielectric permittivity of the air
XECHARGE = 1.6E-19 ! Elementary charge (C)
!
-!* 1. SHAPE PARAMETERS
+!
+!* 1.2 Address module variables common to ICEx and LIMA
+!
+IF (HCLOUD(1:3) == 'ICE') THEN
+ ZCEXVT = XCEXVT_I
+ !
+ ZCC = XCC_I
+ ZDC = XDC_I
+ ZALPHAC = XALPHAC_I
+ ZNUC = XNUC_I
+ !
+ ZAR = XAR_I
+ ZBR = XBR_I
+ ZCR = XCR_I
+ ZDR = XDR_I
+ ZCCR = XCCR_I
+ ZALPHAR = XALPHAR_I
+ ZNUR = XNUR_I
+ !
+ ZAI = XAI_I
+ ZBI = XBI_I
+ ZCI = XC_I_I
+ ZDI = XDI_I
+ ZALPHAI = XALPHAI_I
+ ZNUI = XNUI_I
+ !
+ ZAS = XAS_I
+ ZBS = XBS_I
+ ZCS = XCS_I
+ ZDS = XDS_I
+ ZCCS = XCCS_I
+ ZCXS = XCXS_I
+ ZALPHAS = XALPHAS_I
+ ZNUS = XNUS_I
+ !
+ ZAG = XAG_I
+ ZBG = XBG_I
+ ZCG = XCG_I
+ ZDG = XDG_I
+ ZCCG = XCCG_I
+ ZCXG = XCXG_I
+ ZALPHAG = XALPHAG_I
+ ZNUG = XNUG_I
+ !
+ ZAH = XAH_I
+ ZBH = XBH_I
+ ZCH = XCH_I
+ ZDH = XDH_I
+ ZCCH = XCCH_I
+ ZCXH = XCXH_I
+ ZALPHAH = XALPHAH_I
+ ZNUH = XNUH_I
+ !
+ IGAMINC = NGAMINC_I
+ ZGAMINC_BOUND_MIN = XGAMINC_BOUND_MIN_I
+ ZGAMINC_BOUND_MAX = XGAMINC_BOUND_MAX_I
+ !
+ IACCLBDAR = NACCLBDAR_I
+ IACCLBDAS = NACCLBDAS_I
+ ZACCLBDAR_MIN = XACCLBDAR_MIN_I
+ ZACCLBDAR_MAX = XACCLBDAR_MAX_I
+ ZACCLBDAS_MIN = XACCLBDAS_MIN_I
+ ZACCLBDAS_MAX = XACCLBDAS_MAX_I
+ !
+ IDRYLBDAR = NDRYLBDAR_I
+ IDRYLBDAS = NDRYLBDAS_I
+ IDRYLBDAG = NDRYLBDAG_I
+ ZDRYLBDAR_MIN = XDRYLBDAR_MIN_I
+ ZDRYLBDAR_MAX = XDRYLBDAR_MAX_I
+ ZDRYLBDAS_MIN = XDRYLBDAS_MIN_I
+ ZDRYLBDAS_MAX = XDRYLBDAS_MAX_I
+ ZDRYLBDAG_MIN = XDRYLBDAG_MIN_I
+ ZDRYLBDAG_MAX = XDRYLBDAG_MAX_I
+ !
+ELSE IF (HCLOUD == 'LIMA') THEN
+ ZCEXVT = XCEXVT_L
+ !
+ ZCC = XCC_L
+ ZDC = XDC_L
+ ZALPHAC = XALPHAC_L
+ ZNUC = XNUC_L
+ !
+ ZAR = XAR_L
+ ZBR = XBR_L
+ ZCR = XCR_L
+ ZDR = XDR_L
+ ZCCR = XCCR_L
+ ZALPHAR = XALPHAR_L
+ ZNUR = XNUR_L
+ !
+ ZAI = XAI_L
+ ZBI = XBI_L
+ ZCI = XC_I_L
+ ZDI = XDI_L
+ ZALPHAI = XALPHAI_L
+ ZNUI = XNUI_L
+ !
+ ZAS = XAS_L
+ ZBS = XBS_L
+ ZCS = XCS_L
+ ZDS = XDS_L
+ ZCCS = XCCS_L
+ ZCXS = XCXS_L
+ ZALPHAS = XALPHAS_L
+ ZNUS = XNUS_L
+ !
+ ZAG = XAG_L
+ ZBG = XBG_L
+ ZCG = XCG_L
+ ZDG = XDG_L
+ ZCCG = XCCG_L
+ ZCXG = XCXG_L
+ ZALPHAG = XALPHAG_L
+ ZNUG = XNUG_L
+ !
+ ZAH = XAH_L
+ ZBH = XBH_L
+ ZCH = XCH_L
+ ZDH = XDH_L
+ ZCCH = XCCH_L
+ ZCXH = XCXH_L
+ ZALPHAH = XALPHAH_L
+ ZNUH = XNUH_L
+ !
+ IGAMINC = NGAMINC_L
+ ZGAMINC_BOUND_MIN = XGAMINC_BOUND_MIN_L
+ ZGAMINC_BOUND_MAX = XGAMINC_BOUND_MAX_L
+ !
+ IACCLBDAR = NACCLBDAR_L
+ IACCLBDAS = NACCLBDAS_L
+ ZACCLBDAR_MIN = XACCLBDAR_MIN_L
+ ZACCLBDAR_MAX = XACCLBDAR_MAX_L
+ ZACCLBDAS_MIN = XACCLBDAS_MIN_L
+ ZACCLBDAS_MAX = XACCLBDAS_MAX_L
+ !
+ IDRYLBDAR = NDRYLBDAR_L
+ IDRYLBDAS = NDRYLBDAS_L
+ IDRYLBDAG = NDRYLBDAG_L
+ ZDRYLBDAR_MIN = XDRYLBDAR_MIN_L
+ ZDRYLBDAR_MAX = XDRYLBDAR_MAX_L
+ ZDRYLBDAS_MIN = XDRYLBDAS_MIN_L
+ ZDRYLBDAS_MAX = XDRYLBDAS_MAX_L
+ ZDRYLBDAG_MIN = XDRYLBDAG_MIN_L
+ ZDRYLBDAG_MAX = XDRYLBDAG_MAX_L
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+!* 2. SHAPE PARAMETERS
! ----------------
!
-XCXR = -1.0 ! Raindrop characteristic : XCXR (not declared in ini_rain_ice.f90)
+XCXR = -1.0 ! Raindrop characteristic : XCXR (not initialized in ini_rain_ice.f90)
!
! Individual charge q(d) = e_x * d ** f_x with f_x = XFx
!
@@ -205,7 +421,7 @@ XJCURR_FW = -2.7E-12
!
!-------------------------------------------------------------------------------
!
-!* 2. COEFFICIENTS FOR CHARGE TRANSFERS
+!* 3. COEFFICIENTS FOR CHARGE TRANSFERS
! ---------------------------------
!
! proportionality coefficient between mass transfer and charge transfer rates
@@ -214,11 +430,11 @@ XJCURR_FW = -2.7E-12
!
XCOEF_RQ_V = 1
XCOEF_RQ_C = XFC / 3.0 ! XBC=3
-XCOEF_RQ_R = XFR / XBR
-XCOEF_RQ_I = XFI / XBI
-XCOEF_RQ_S = XFS / XBS
-XCOEF_RQ_G = XFG / XBG
-XCOEF_RQ_H = XFH / XBH
+XCOEF_RQ_R = XFR / ZBR
+XCOEF_RQ_I = XFI / ZBI
+XCOEF_RQ_S = XFS / ZBS
+XCOEF_RQ_G = XFG / ZBG
+XCOEF_RQ_H = XFH / ZBH
!
!
!-------------------------------------------------------------------------------
@@ -240,6 +456,7 @@ XQHON = XQHON / (XLBDACQ**XFC)
!
!* 4. SEDIMENTATION
! -------------
+!
IF (ALLOCATED(XQTMIN)) DEALLOCATE(XQTMIN)
IF (ALLOCATED(XRTMIN_ELEC)) DEALLOCATE(XRTMIN_ELEC)
!
@@ -272,46 +489,78 @@ XLBDAS_MAXE = 2.E3 ! Less than 10000 particles in cube meter of cloud.
XLBDAG_MAXE = 2.E3 !
XLBDAH_MAXE = 2.E3 !
!
-! Rain
-!
-XCEXVT = 0.4
-XEXQSEDR = (XCXR - XFR - XDR) / (XCXR - XBR)
-XFQSEDR = XCR * (XCCR**(1 - XEXQSEDR)) * MOMG(XALPHAR,XNUR,XDR+XFR) * &
- ((XAR * MOMG(XALPHAR,XNUR,XBR))**(-XEXQSEDR)) * (PRHO00)**XCEXVT
-!
-! Ice
-!
-XEXQSEDI = (XDI + XFI) / XBI
-XFQSEDI = XC_I * MOMG(XALPHAI,XNUI,XDI+XFI) * (PRHO00**XCEXVT) * &
- (XAI * MOMG(XALPHAI,XNUI,XBI))**(-XEXQSEDI)
-!
-! Snow
-!
-XEXQSEDS = (XCXS - XFS - XDS) / (XCXS - XBS)
-XFQSEDS = XCS * (XCCS**(1 - XEXQSEDS)) * MOMG(XALPHAS,XNUS,XDS+XFS) * &
- ((XAS * MOMG(XALPHAS,XNUS,XBS))**(-XEXQSEDS)) * (PRHO00)**XCEXVT
-!
-! Graupeln
-!
-XEXQSEDG = (XCXG - XFG - XDG) / (XCXG - XBG)
-XFQSEDG = XCG * (XCCG**(1 - XEXQSEDG)) * MOMG(XALPHAG,XNUG,XDG+XFG) * &
- ((XAG * MOMG(XALPHAG,XNUG,XBG))**(-XEXQSEDG)) * (PRHO00)**XCEXVT
-!
-! Hail
-!
-XEXQSEDH = (XCXH - XFH - XDH) / (XCXH - XBH)
-XFQSEDH = XCH * (XCCH**(1 - XEXQSEDH)) * MOMG(XALPHAH,XNUH,XDH+XFH) * &
- ((XAH * MOMG(XALPHAH,XNUH,XBH))**(-XEXQSEDH)) * (PRHO00)**XCEXVT
-!
+IF (HCLOUD(1:3) == 'ICE') THEN
+ !
+ ! Cloud droplets
+ !
+ ZCEXVT = 0.4
+ XEXQSEDC = XFC + ZDC
+ XFQSEDC = ZCC * MOMG(ZALPHAC,ZNUC,ZDC+XFC) * (PRHO00)**ZCEXVT
+ !
+ ! Rain
+ !
+ XEXQSEDR = (XCXR - XFR - ZDR) / (XCXR - ZBR)
+ XFQSEDR = ZCR * (ZCCR**(1 - XEXQSEDR)) * MOMG(ZALPHAR,ZNUR,ZDR+XFR) * &
+ ((ZAR * MOMG(ZALPHAR,ZNUR,ZBR))**(-XEXQSEDR)) * (PRHO00)**ZCEXVT
+ !
+ ! Ice
+!!++cb++ 23/02/23 pour la microphysique, calcul fait pour des colonnes
+! => on fait pareil ici pour garder la coherence
+!XEXQSEDI = (ZDI + XFI) / ZBI
+!XFQSEDI = ZCI * MOMG(ZALPHAI,ZNUI,ZDI+XFI) * (PRHO00**ZCEXVT) * &
+! (ZAI * MOMG(ZALPHAI,ZNUI,ZBI))**(-XEXQSEDI)
+ XEXQSEDI = (1.585 + XFI) / 1.7
+ XFQSEDI = 2.1E5 * MOMG(ZALPHAI,ZNUI,1.585+XFI) * (PRHO00**ZCEXVT) * &
+ (2.14E-3 * MOMG(ZALPHAI,ZNUI,1.7))**(-XEXQSEDI)
+!--cb--
+ XFCI = (4. * XPI * 900.)**(-1)
+ !
+ ! Snow
+ !
+ XEXQSEDS = (ZCXS - XFS - ZDS) / (ZCXS - ZBS)
+ XFQSEDS = ZCS * (ZCCS**(1 - XEXQSEDS)) * MOMG(ZALPHAS,ZNUS,ZDS+XFS) * &
+ ((ZAS * MOMG(ZALPHAS,ZNUS,ZBS))**(-XEXQSEDS)) * (PRHO00)**ZCEXVT
+ !
+ ! Graupeln
+ !
+ XEXQSEDG = (ZCXG - XFG - ZDG) / (ZCXG - ZBG)
+ XFQSEDG = ZCG * (ZCCG**(1 - XEXQSEDG)) * MOMG(ZALPHAG,ZNUG,ZDG+XFG) * &
+ ((ZAG * MOMG(ZALPHAG,ZNUG,ZBG))**(-XEXQSEDG)) * (PRHO00)**ZCEXVT
+ !
+ ! Hail
+ !
+ XEXQSEDH = (ZCXH - XFH - ZDH) / (ZCXH - ZBH)
+ XFQSEDH = ZCH * (ZCCH**(1 - XEXQSEDH)) * MOMG(ZALPHAH,ZNUH,ZDH+XFH) * &
+ ((ZAH * MOMG(ZALPHAH,ZNUH,ZBH))**(-XEXQSEDH)) * (PRHO00)**ZCEXVT
+!
+ELSE IF (HCLOUD == 'LIMA') THEN
+ ALLOCATE(XFQSED(KRR))
+ XFQSED(:) = 0.
+ XFQSED(2) = ZCC * MOMG(ZALPHAC,ZNUC,ZDC+XFC)
+ XFQSED(3) = ZCR * MOMG(ZALPHAR,ZNUR,ZDR+XFR)
+ XFQSED(4) = ZCI * MOMG(ZALPHAI,ZNUI,ZDI+XFI)
+ XFQSED(5) = ZCS * MOMG(ZALPHAS,ZNUS,ZDS+XFS)
+ XFQSED(6) = ZCG * MOMG(ZALPHAG,ZNUG,ZDG+XFG)
+ IF (KRR == 7) XFQSED(7) = ZCH * MOMG(ZALPHAH,ZNUH,ZDH+XFH)
+ !
+ ALLOCATE(XDQ(KRR))
+ XDQ(:) = 0.
+ XDQ(2) = ZDC + XFC
+ XDQ(3) = ZDR + XFR
+ XDQ(4) = ZDI + XFI
+ XDQ(5) = ZDS + XFS
+ XDQ(6) = ZDG + XFG
+ IF (KRR == 7) XDQ(7) = ZDH + XFH
+END IF
!
!-------------------------------------------------------------------------------
!
!* 5. EVAPORATION OF RAINDROPS
! ------------------------
!
-XQREVAV1 = (2. / XPI) * MOMG(XALPHAR,XNUR,XFR) / MOMG(XALPHAR,XNUR,2.)
-XQREVAV2 = (XPI / XAR) * (MOMG(XALPHAR,XNUR,2.) / MOMG(XALPHAR,XNUR,XBR)) * &
- (XCXR - 2.) / (XCXR - XBR)
+!XQREVAV1 = (2. / XPI) * MOMG(ZALPHAR,ZNUR,XFR) / MOMG(ZALPHAR,ZNUR,2.)
+!XQREVAV2 = (XPI / ZAR) * (MOMG(ZALPHAR,ZNUR,2.) / MOMG(ZALPHAR,ZNUR,ZBR)) * &
+! (XCXR - 2.) / (XCXR - ZBR)
!
!
!-------------------------------------------------------------------------------
@@ -319,11 +568,22 @@ XQREVAV2 = (XPI / XAR) * (MOMG(XALPHAR,XNUR,2.) / MOMG(XALPHAR,XNUR,XBR)) * &
!* 6. RIMING OF CLOUD DROPLETS ON SNOW
! --------------------------------
!
-XEXQSRIMCG = XCXS - XFS
-XQSRIMCG = XCCS * MOMG(XALPHAS,XNUS,XFS)
+IF (HELEC == 'ELE4') THEN
+ XEXQSRIMCG = -XFS
+ XQSRIMCG = MOMG(ZALPHAS,ZNUS,XFS)
+ELSE
+ XEXQSRIMCG = ZCXS - XFS
+ XQSRIMCG = ZCCS * MOMG(ZALPHAS,ZNUS,XFS)
+END IF
!
! The array containing the tabulated function M(fs,D_cs^lim)/M(fs)
-! is implemented in ini_rain_ice.f90
+! is no more implemented in ini_rain_ice.f90
+ZRATE = EXP(LOG(ZGAMINC_BOUND_MAX/ZGAMINC_BOUND_MIN)/REAL(IGAMINC-1))
+IF( .NOT.ALLOCATED(XGAMINC_RIM3) ) ALLOCATE( XGAMINC_RIM3(IGAMINC) )
+DO J1 = 1, IGAMINC
+ ZBOUND = ZGAMINC_BOUND_MIN * ZRATE**(J1-1)
+ XGAMINC_RIM3(J1) = GAMMA_INC(ZNUS+XFS/ZALPHAS,ZBOUND)
+END DO
!
!
!-------------------------------------------------------------------------------
@@ -331,9 +591,15 @@ XQSRIMCG = XCCS * MOMG(XALPHAS,XNUS,XFS)
!* 7. CONTACT FREEZING BETWEEN RAINDROPS AND PRISTINE ICE
! ---------------------------------------------------
!
-XEXQRCFRIG = XCXR - XDR - XFR - 2.0
-XQRCFRIG = (XPI / 4.0) * XCR * XCCR * MOMG(XALPHAR,XNUR,XDR+XFR+2.) * &
- PRHO00**XCEXVT
+IF (HELEC == 'ELE4') THEN
+ XEXQRCFRIG = - ZDR - XFR - 2.0
+ XQRCFRIG = (XPI / 4.0) * ZCR * MOMG(ZALPHAR,ZNUR,ZDR+XFR+2.) * &
+ PRHO00**ZCEXVT
+ELSE
+ XEXQRCFRIG = XCXR - ZDR - XFR - 2.0
+ XQRCFRIG = (XPI / 4.0) * ZCR * ZCCR * MOMG(ZALPHAR,ZNUR,ZDR+XFR+2.) * &
+ PRHO00**ZCEXVT
+END IF
!
!
!-------------------------------------------------------------------------------
@@ -350,7 +616,7 @@ ALLOCATE( XIND_RATE(IIU, IJU, IKU) )
ALLOCATE( XEW(IIU, IJU, IKU) )
XEW(:,:,:) = 0.
!
-SELECT CASE(HGETSVM(NSV_ELECEND))
+SELECT CASE(HGETSVT(NSV_ELECEND))
CASE ('READ')
CALL IO_Field_read(TPINIFILE,'NI_IAGGS',XNI_IAGGS)
CALL IO_Field_read(TPINIFILE,'NI_IDRYG',XNI_IDRYG)
@@ -399,39 +665,39 @@ IF (CNI_CHARGING == 'SAUN1' .OR. CNI_CHARGING == 'SAUN2' .OR. &
XSKN = 24.
XSKN_TAK = 2.0 ! for Takahashi
!
- XFQIAGGSP = XIKP * XCS**(1. + XINP) * &
- MOMG(XALPHAS, XNUS, 2.+XDS*(1.+XINP)) * &
- MOMG(XALPHAI, XNUI, XIMP)
- XFQIAGGSN = XIKN * XCS**(1. + XINN) * &
- MOMG(XALPHAS, XNUS, 2.+XDS*(1.+XINN)) * &
- MOMG(XALPHAI, XNUI, XIMN)
+ XFQIAGGSP = XIKP * ZCS**(1. + XINP) * &
+ MOMG(ZALPHAS, ZNUS, 2.+ZDS*(1.+XINP)) * &
+ MOMG(ZALPHAI, ZNUI, XIMP)
+ XFQIAGGSN = XIKN * ZCS**(1. + XINN) * &
+ MOMG(ZALPHAS, ZNUS, 2.+ZDS*(1.+XINN)) * &
+ MOMG(ZALPHAI, ZNUI, XIMN)
!
- XFQIDRYGBSP = XIKP * XCG**(1. + XINP) * &
- MOMG(XALPHAG, XNUG, 2.+XDG*(1.+XINP)) * &
- MOMG(XALPHAI, XNUI, XIMP)
- XFQIDRYGBSN = XIKN * XCG**(1. + XINN) * &
- MOMG(XALPHAG, XNUG, 2.+XDG*(1.+XINN)) * &
- MOMG(XALPHAI, XNUI, XIMN)
+ XFQIDRYGBSP = XIKP * ZCG**(1. + XINP) * &
+ MOMG(ZALPHAG, ZNUG, 2.+ZDG*(1.+XINP)) * &
+ MOMG(ZALPHAI, ZNUI, XIMP)
+ XFQIDRYGBSN = XIKN * ZCG**(1. + XINN) * &
+ MOMG(ZALPHAG, ZNUG, 2.+ZDG*(1.+XINN)) * &
+ MOMG(ZALPHAI, ZNUI, XIMN)
!
XFQIAGGSP_TAK = XFQIAGGSP * XIKP_TAK / XIKP
XFQIAGGSN_TAK = XFQIAGGSN * XIKN_TAK / XIKN
XFQIDRYGBSP_TAK = XFQIDRYGBSP * XIKP_TAK / XIKP
XFQIDRYGBSN_TAK = XFQIDRYGBSN * XIKN_TAK / XIKN
!
- XAIGAMMABI = XAI * MOMG(XALPHAI, XNUI, XBI)
+ XAIGAMMABI = ZAI * MOMG(ZALPHAI, ZNUI, ZBI)
!
- XLBQSDRYGB1SP = MOMG(XALPHAG,XNUG,2.) * MOMG(XALPHAS, XNUS, XSMP)
- XLBQSDRYGB1SN = MOMG(XALPHAG,XNUG,2.) * MOMG(XALPHAS, XNUS, XSMN)
- XLBQSDRYGB2SP = 2. * MOMG(XALPHAG,XNUG,1.) * MOMG(XALPHAS, XNUS, 1.+XSMP)
- XLBQSDRYGB2SN = 2. * MOMG(XALPHAG,XNUG,1.) * MOMG(XALPHAS, XNUS, 1.+XSMN)
- XLBQSDRYGB3SP = MOMG(XALPHAS, XNUS, 2.+XSMP)
- XLBQSDRYGB3SN = MOMG(XALPHAS, XNUS, 2.+XSMN)
+ XLBQSDRYGB1SP = MOMG(ZALPHAG,ZNUG,2.) * MOMG(ZALPHAS, ZNUS, XSMP)
+ XLBQSDRYGB1SN = MOMG(ZALPHAG,ZNUG,2.) * MOMG(ZALPHAS, ZNUS, XSMN)
+ XLBQSDRYGB2SP = 2. * MOMG(ZALPHAG,ZNUG,1.) * MOMG(ZALPHAS, ZNUS, 1.+XSMP)
+ XLBQSDRYGB2SN = 2. * MOMG(ZALPHAG,ZNUG,1.) * MOMG(ZALPHAS, ZNUS, 1.+XSMN)
+ XLBQSDRYGB3SP = MOMG(ZALPHAS, ZNUS, 2.+XSMP)
+ XLBQSDRYGB3SN = MOMG(ZALPHAS, ZNUS, 2.+XSMN)
ENDIF
!
IF (CNI_CHARGING == 'SAP98' .OR. CNI_CHARGING == 'TERAR' .OR. &
CNI_CHARGING == 'BSMP1' .OR. CNI_CHARGING == 'BSMP2') THEN
- XVSCOEF = XCS * MOMG(XALPHAS, XNUS, XBS+XDS) / MOMG(XALPHAS, XNUS, XBS)
- XVGCOEF = XCG * MOMG(XALPHAG, XNUG, XBG+XDG) / MOMG(XALPHAG, XNUG, XBG)
+ XVSCOEF = ZCS * MOMG(ZALPHAS, ZNUS, ZBS+ZDS) / MOMG(ZALPHAS, ZNUS, ZBS)
+ XVGCOEF = ZCG * MOMG(ZALPHAG, ZNUG, ZBG+ZDG) / MOMG(ZALPHAG, ZNUG, ZBG)
END IF
!
!
@@ -568,7 +834,7 @@ IF (CNI_CHARGING == 'SAUN1' .OR. CNI_CHARGING == 'SAUN2' .OR. &
ALLOCATE(ZT(NIND_TEMP+1)) ! Kelvin
ALLOCATE(ZLWCC(NIND_TEMP+1))
DO JTEMP = 1, NIND_TEMP+1
- ZT(JTEMP)=1.0-REAL(JTEMP)+XTT
+ ZT(JTEMP) = 1.0 - REAL(JTEMP) + XTT
END DO
ZLWCC(:) = MIN( MAX( -0.49 + 6.64E-2*(XTT-ZT(:)),0.22 ),1.1 ) ! (g m^-3)
ALLOCATE(ZEW(NIND_LWC+1))
@@ -578,13 +844,13 @@ IF (CNI_CHARGING == 'SAUN1' .OR. CNI_CHARGING == 'SAUN2' .OR. &
! 0.10 to 0.90 every 0.10 (9 values)
! 1.00 to 10.0 every 1.00 (10 values)
DO JLWC = 1, 9
- ZEW(JLWC)=0.01*REAL(JLWC)
+ ZEW(JLWC) = 0.01 * REAL(JLWC)
END DO
DO JLWC = 10, 18
- ZEW(JLWC)=0.1 + 0.1*REAL(JLWC-10)
+ ZEW(JLWC) = 0.1 + 0.1 * REAL(JLWC-10)
END DO
DO JLWC = 19, NIND_LWC+1
- ZEW(JLWC)=1.0 + REAL(JLWC-19)
+ ZEW(JLWC) = 1.0 + REAL(JLWC-19)
END DO
!
!
@@ -806,24 +1072,38 @@ XFQIAGGSBH = 2.E-14 ! (C.) Constant for ice-snow charging process
!
!* 9.2 Gardiner et al. (1985) parameterization
!
-XFQIAGGSBG = (XPI / 4.0) * XCCS * XCS**4. * PRHO00**(4. * XCEXVT) * &
- MOMG(XALPHAS,XNUS,2.+4.*XDS) * 7.3 * &
- MOMG(XALPHAI,XNUI,4.)
+IF (HELEC == 'ELE4') THEN
+ XFQIAGGSBG = (XPI / 4.0) * ZCS**4. * PRHO00**(4. * ZCEXVT) * &
+ MOMG(ZALPHAS,ZNUS,2.+4.*ZDS) * 7.3 * &
+ MOMG(ZALPHAI,ZNUI,4.)
+ELSE
+ XFQIAGGSBG = (XPI / 4.0) * ZCCS * ZCS**4. * PRHO00**(4. * ZCEXVT) * &
+ MOMG(ZALPHAS,ZNUS,2.+4.*ZDS) * 7.3 * &
+ MOMG(ZALPHAI,ZNUI,4.)
+END IF
!
!
!* 9.3 Saunders et al.(1991) parameterization
!
-XFQIAGGSBS = (XPI / 4.0) * XCCS
+IF (HELEC == 'ELE4') THEN
+ XFQIAGGSBS = XPI / 4.0
+ELSE
+ XFQIAGGSBS = (XPI / 4.0) * ZCCS
+END IF
!
!
!* 9.4 Takahashi (1978) parameterization
!
IF (CNI_CHARGING == 'TAKAH') THEN
- XFQIAGGSBT1 = (XPI / 4.0) * XCCS * XCS
- XFQIAGGSBT2 = 10 * MOMG(XALPHAS,XNUS,2.+XDS)
- XFQIAGGSBT3 = 5. * XCS * MOMG(XALPHAI,XNUI,2.) * &
- MOMG(XALPHAS,XNUS,2.+2*XDS) / ((1.E-4)**2 * 8. * &
- (XAI * MOMG(XALPHAI,XNUI,XBI))**(2 / XBI))
+ IF (HELEC == 'ELE4') THEN
+ XFQIAGGSBT1 = (XPI / 4.0) * ZCS
+ ELSE
+ XFQIAGGSBT1 = (XPI / 4.0) * ZCCS * ZCS
+ END IF
+ XFQIAGGSBT2 = 10. * MOMG(ZALPHAS,ZNUS,2.+ZDS)
+ XFQIAGGSBT3 = 5. * ZCS * MOMG(ZALPHAI,ZNUI,2.) * &
+ MOMG(ZALPHAS,ZNUS,2.+2.*ZDS) / ((1.E-4)**2 * 8. * &
+ (ZAI * MOMG(ZALPHAI,ZNUI,ZBI))**(2. / ZBI))
END IF
!
!
@@ -832,36 +1112,43 @@ END IF
!* 10. ACCRETION OF RAINDROPS ON SNOW
! ------------------------------
!
-IF( .NOT.ALLOCATED(XKER_Q_RACCSS)) ALLOCATE( XKER_Q_RACCSS(NACCLBDAS,NACCLBDAR) )
-IF( .NOT.ALLOCATED(XKER_Q_RACCS)) ALLOCATE( XKER_Q_RACCS (NACCLBDAS,NACCLBDAR) )
-IF( .NOT.ALLOCATED(XKER_Q_SACCRG)) ALLOCATE( XKER_Q_SACCRG(NACCLBDAR,NACCLBDAS) )
+IF( .NOT.ALLOCATED(XKER_Q_RACCSS)) ALLOCATE( XKER_Q_RACCSS(IACCLBDAS,IACCLBDAR) )
+IF( .NOT.ALLOCATED(XKER_Q_RACCS)) ALLOCATE( XKER_Q_RACCS (IACCLBDAS,IACCLBDAR) )
+IF( .NOT.ALLOCATED(XKER_Q_SACCRG)) ALLOCATE( XKER_Q_SACCRG(IACCLBDAR,IACCLBDAS) )
!
-XFQRACCS = (XPI / 4.0) * XCCS * XCCR * (PRHO00**XCEXVT)
+IF (HELEC == 'ELE4') THEN
+ XFQRACCS = (XPI / 4.0) * PRHO00**ZCEXVT
+ELSE
+ XFQRACCS = (XPI / 4.0) * ZCCS * ZCCR * (PRHO00**ZCEXVT)
+END IF
!
-XLBQRACCS1 = MOMG(XALPHAR,XNUR,2.+XFR)
-XLBQRACCS2 = 2. * MOMG(XALPHAR,XNUR,1.+XFR) * MOMG(XALPHAS,XNUS,1.)
-XLBQRACCS3 = MOMG(XALPHAR,XNUR,XFR) * MOMG(XALPHAS,XNUS,2.)
+XLBQRACCS1 = MOMG(ZALPHAR,ZNUR,2.+XFR)
+XLBQRACCS2 = 2. * MOMG(ZALPHAR,ZNUR,1.+XFR) * MOMG(ZALPHAS,ZNUS,1.)
+XLBQRACCS3 = MOMG(ZALPHAR,ZNUR,XFR) * MOMG(ZALPHAS,ZNUS,2.)
!
-XLBQSACCRG1 = MOMG(XALPHAS,XNUS,2.+XFS)
-XLBQSACCRG2 = 2. * MOMG(XALPHAS,XNUS,1.+XFS) * MOMG(XALPHAR,XNUR,1.)
-XLBQSACCRG3 = MOMG(XALPHAS,XNUS,XFS) * MOMG(XALPHAR,XNUR,2.)
+XLBQSACCRG1 = MOMG(ZALPHAS,ZNUS,2.+XFS)
+XLBQSACCRG2 = 2. * MOMG(ZALPHAS,ZNUS,1.+XFS) * MOMG(ZALPHAR,ZNUR,1.)
+XLBQSACCRG3 = MOMG(ZALPHAS,ZNUS,XFS) * MOMG(ZALPHAR,ZNUR,2.)
!
-ZESR = 1.0
+! These values are pasted from ini_rain_ice (7.2.2)
+IND = 50 ! Interval number, collection efficiency and infinite diameter
+ZESR = 1.0 ! factor used to integrate the dimensional distributions when
+ZFDINFTY = 20.0 ! computing the kernels XKER_RACCSS, XKER_RACCS and XKER_SACCRG
!
-CALL RRCOLSS (KND, XALPHAS, XNUS, XALPHAR, XNUR, &
- ZESR, XFR, XCS, XDS, 0., XCR, XDR, &
- XACCLBDAS_MAX, XACCLBDAR_MAX, XACCLBDAS_MIN, XACCLBDAR_MIN, &
- PFDINFTY, XKER_Q_RACCSS, XAG, XBS, XAS )
+CALL RRCOLSS (IND, ZALPHAS, ZNUS, ZALPHAR, ZNUR, &
+ ZESR, XFR, ZCS, ZDS, 0., ZCR, ZDR, &
+ ZACCLBDAS_MAX, ZACCLBDAR_MAX, ZACCLBDAS_MIN, ZACCLBDAR_MIN, &
+ ZFDINFTY, XKER_Q_RACCSS, ZAG, ZBS, ZAS )
!
-CALL RZCOLX (KND, XALPHAS, XNUS, XALPHAR, XNUR, &
- ZESR, XFR, XCS, XDS, 0., XCR, XDR, 0., &
- XACCLBDAS_MAX, XACCLBDAR_MAX, XACCLBDAS_MIN, XACCLBDAR_MIN, &
- PFDINFTY, XKER_Q_RACCS )
+CALL RZCOLX (IND, ZALPHAS, ZNUS, ZALPHAR, ZNUR, &
+ ZESR, XFR, ZCS, ZDS, 0., ZCR, ZDR, 0., &
+ ZACCLBDAS_MAX, ZACCLBDAR_MAX, ZACCLBDAS_MIN, ZACCLBDAR_MIN, &
+ ZFDINFTY, XKER_Q_RACCS )
!
-CALL RSCOLRG (KND, XALPHAS, XNUS, XALPHAR, XNUR, &
- ZESR, XFS, XCS, XDS, 0., XCR, XDR, &
- XACCLBDAS_MAX, XACCLBDAR_MAX, XACCLBDAS_MIN, XACCLBDAR_MIN, &
- PFDINFTY, XKER_Q_SACCRG, XAG, XBS, XAS )
+CALL RSCOLRG (IND, ZALPHAS, ZNUS, ZALPHAR, ZNUR, &
+ ZESR, XFS, ZCS, ZDS, 0., ZCR, ZDR, &
+ ZACCLBDAS_MAX, ZACCLBDAR_MAX, ZACCLBDAS_MIN, ZACCLBDAR_MIN, &
+ ZFDINFTY, XKER_Q_SACCRG, ZAG, ZBS, ZAS )
!
!-------------------------------------------------------------------------------
!
@@ -870,20 +1157,24 @@ CALL RSCOLRG (KND, XALPHAS, XNUS, XALPHAR, XNUR, &
!
!* 11.1 charge transfer associated to mass transfer
!
-IF( .NOT.ALLOCATED(XKER_Q_SDRYG)) ALLOCATE( XKER_Q_SDRYG(NDRYLBDAG,NDRYLBDAS) )
+IF( .NOT.ALLOCATED(XKER_Q_SDRYG)) ALLOCATE( XKER_Q_SDRYG(IDRYLBDAG,IDRYLBDAS) )
!
-XFQSDRYG = (XPI / 4.0) * XCCS * XCCG * (PRHO00**XCEXVT)
+IF (HELEC == 'ELE4') THEN
+ XFQSDRYG = (XPI / 4.0) * (PRHO00**ZCEXVT)
+ELSE
+ XFQSDRYG = (XPI / 4.0) * ZCCS * ZCCG * (PRHO00**ZCEXVT)
+END IF
!
-XLBQSDRYG1 = MOMG(XALPHAS,XNUS,2.+XFS)
-XLBQSDRYG2 = 2. * MOMG(XALPHAS,XNUS,1.+XFS) * MOMG(XALPHAG,XNUG,1.)
-XLBQSDRYG3 = MOMG(XALPHAS,XNUS,XFS) * MOMG(XALPHAG,XNUG,2.)
+XLBQSDRYG1 = MOMG(ZALPHAS,ZNUS,2.+XFS)
+XLBQSDRYG2 = 2. * MOMG(ZALPHAS,ZNUS,1.+XFS) * MOMG(ZALPHAG,ZNUG,1.)
+XLBQSDRYG3 = MOMG(ZALPHAS,ZNUS,XFS) * MOMG(ZALPHAG,ZNUG,2.)
!
ZEGS = 1. ! also initialized in ini_rain_ice_elec
!
-CALL RZCOLX (KND, XALPHAG, XNUG, XALPHAS, XNUS, &
- ZEGS, XFS, XCG, XDG, 0., XCS, XDS, 0., &
- XDRYLBDAG_MAX, XDRYLBDAS_MAX, XDRYLBDAG_MIN, XDRYLBDAS_MIN, &
- PFDINFTY, XKER_Q_SDRYG )
+CALL RZCOLX (IND, ZALPHAG, ZNUG, ZALPHAS, ZNUS, &
+ ZEGS, XFS, ZCG, ZDG, 0., ZCS, ZDS, 0., &
+ ZDRYLBDAG_MAX, ZDRYLBDAS_MAX, ZDRYLBDAG_MIN, ZDRYLBDAS_MIN, &
+ ZFDINFTY, XKER_Q_SDRYG )
!
!
!* 11.2 NI process: Heldson et Farley (1987) parameterization
@@ -892,39 +1183,46 @@ IF (CNI_CHARGING == 'HELFA') THEN
XHIDRYG = 2.E-15 ! Charge exchanged per collision between ice and graupel
XHSDRYG = 2.E-14
!
- XFQSDRYGBH = (XPI / 4.0) * XCCG * XCCS * (PRHO00**(XCEXVT)) * XHSDRYG
+ IF (HELEC == 'ELE4') THEN
+ XFQSDRYGBH = (XPI / 4.0) * PRHO00**(ZCEXVT) * XHSDRYG
+ ELSE
+ XFQSDRYGBH = (XPI / 4.0) * ZCCG * ZCCS * (PRHO00**(ZCEXVT)) * XHSDRYG
+ END IF
!
- XLBQSDRYGB4H = MOMG(XALPHAS,XNUS,2.)
- XLBQSDRYGB5H = 2. * MOMG(XALPHAS,XNUS,1.) * MOMG(XALPHAG,XNUG,1.)
- XLBQSDRYGB6H = MOMG(XALPHAG,XNUG,2.)
-!
- IF( .NOT.ALLOCATED(XKER_Q_SDRYGB)) ALLOCATE( XKER_Q_SDRYGB(NDRYLBDAG,NDRYLBDAS) )
- CALL RZCOLX (KND, XALPHAG, XNUG, XALPHAS, XNUS, &
- ZEGS, 0., XCG, XDG, 0., XCS, XDS, 0., &
- XDRYLBDAG_MAX, XDRYLBDAS_MAX, XDRYLBDAG_MIN, XDRYLBDAS_MIN, &
- PFDINFTY, XKER_Q_SDRYGB )
+ XLBQSDRYGB4H = MOMG(ZALPHAS,ZNUS,2.)
+ XLBQSDRYGB5H = 2. * MOMG(ZALPHAS,ZNUS,1.) * MOMG(ZALPHAG,ZNUG,1.)
+ XLBQSDRYGB6H = MOMG(ZALPHAG,ZNUG,2.)
+!
+ IF( .NOT.ALLOCATED(XKER_Q_SDRYGB)) ALLOCATE( XKER_Q_SDRYGB(IDRYLBDAG,IDRYLBDAS) )
+ CALL RZCOLX (IND, ZALPHAG, ZNUG, ZALPHAS, ZNUS, &
+ ZEGS, 0., ZCG, ZDG, 0., ZCS, ZDS, 0., &
+ ZDRYLBDAG_MAX, ZDRYLBDAS_MAX, ZDRYLBDAG_MIN, ZDRYLBDAS_MIN, &
+ ZFDINFTY, XKER_Q_SDRYGB )
! Delta vqb1_sg
ENDIF
!
!
!* 11.3 NI process: Gardiner et al. (1985) parameterization
!
-IF (CNI_CHARGING == 'GARDI') THEN
- XFQIDRYGBG = (XPI / 4.0) * XCCG * (PRHO00**(4. * XCEXVT)) * XCG**4. * &
- 7.3
- XLBQIDRYGBG = MOMG(XALPHAI,XNUI,4.) * MOMG(XALPHAG,XNUG,2.+4.*XDG)
-!
- XFQSDRYGBG = (XPI / 4.0) * XCCS * XCCG * (PRHO00**(4. * XCEXVT)) * &
- 7.3
- XLBQSDRYGB4G = MOMG(XALPHAS,XNUS,4.) * MOMG(XALPHAG,XNUG,2.)
- XLBQSDRYGB5G = 2. * MOMG(XALPHAS,XNUS,5.) * MOMG(XALPHAG,XNUG,1.)
- XLBQSDRYGB6G = MOMG(XALPHAS,XNUS,6.)
-!
- IF( .NOT.ALLOCATED(XKER_Q_SDRYGB)) ALLOCATE( XKER_Q_SDRYGB(NDRYLBDAG,NDRYLBDAS) )
- CALL VQZCOLX (KND, XALPHAG, XNUG, XALPHAS, XNUS, &
- ZEGS, 4., XCG, XDG, XCS, XDS, 4., &
- XDRYLBDAG_MAX, XDRYLBDAS_MAX, XDRYLBDAG_MIN, XDRYLBDAS_MIN, &
- PFDINFTY, XKER_Q_SDRYGB )
+IF (CNI_CHARGING == 'GARDI') THEN
+ IF (HELEC == 'ELE4') THEN
+ XFQIDRYGBG = (XPI / 4.0) * PRHO00**(4.*ZCEXVT) * ZCG**4. * 7.3
+ XFQSDRYGBG = (XPI / 4.0) * PRHO00**(4.*ZCEXVT) * 7.3
+ ELSE
+ XFQIDRYGBG = (XPI / 4.0) * ZCCG * (PRHO00**(4.*ZCEXVT)) * ZCG**4. * 7.3
+ XFQSDRYGBG = (XPI / 4.0) * ZCCS * ZCCG * (PRHO00**(4.*ZCEXVT)) * 7.3
+ END IF
+ XLBQIDRYGBG = MOMG(ZALPHAI,ZNUI,4.) * MOMG(ZALPHAG,ZNUG,2.+4.*ZDG)
+!
+ XLBQSDRYGB4G = MOMG(ZALPHAS,ZNUS,4.) * MOMG(ZALPHAG,ZNUG,2.)
+ XLBQSDRYGB5G = 2. * MOMG(ZALPHAS,ZNUS,5.) * MOMG(ZALPHAG,ZNUG,1.)
+ XLBQSDRYGB6G = MOMG(ZALPHAS,ZNUS,6.)
+!
+ IF( .NOT.ALLOCATED(XKER_Q_SDRYGB)) ALLOCATE( XKER_Q_SDRYGB(IDRYLBDAG,IDRYLBDAS) )
+ CALL VQZCOLX (IND, ZALPHAG, ZNUG, ZALPHAS, ZNUS, &
+ ZEGS, 4., ZCG, ZDG, ZCS, ZDS, 4., &
+ ZDRYLBDAG_MAX, ZDRYLBDAS_MAX, ZDRYLBDAG_MIN, ZDRYLBDAS_MIN, &
+ ZFDINFTY, XKER_Q_SDRYGB )
END IF
!
!
@@ -935,25 +1233,30 @@ IF (CNI_CHARGING == 'SAUN1' .OR. CNI_CHARGING == 'SAUN2' .OR. &
CNI_CHARGING == 'SAP98' .OR. &
CNI_CHARGING == 'BSMP1' .OR. CNI_CHARGING == 'BSMP2' .OR. &
CNI_CHARGING == 'TEEWC' .OR. CNI_CHARGING == 'TERAR') THEN
- XFQIDRYGBS = (XPI / 4.0) * XCCG
- XFQSDRYGBS = (XPI / 4.0) * XCCS * XCCG
- XLBQSDRYGB1S = MOMG(XALPHAG,XNUG,2.)
- XLBQSDRYGB2S = 2. * MOMG(XALPHAG,XNUG,1.)
-!
- IF( .NOT.ALLOCATED(XKER_Q_SDRYGB1)) ALLOCATE( XKER_Q_SDRYGB1(NDRYLBDAG,NDRYLBDAS) )
- IF( .NOT.ALLOCATED(XKER_Q_SDRYGB2)) ALLOCATE( XKER_Q_SDRYGB2(NDRYLBDAG,NDRYLBDAS) )
+ IF (HELEC == 'ELE4') THEN
+ XFQIDRYGBS = XPI / 4.0
+ XFQSDRYGBS = XPI / 4.0
+ ELSE
+ XFQIDRYGBS = (XPI / 4.0) * ZCCG
+ XFQSDRYGBS = (XPI / 4.0) * ZCCS * ZCCG
+ END IF
+ XLBQSDRYGB1S = MOMG(ZALPHAG,ZNUG,2.)
+ XLBQSDRYGB2S = 2. * MOMG(ZALPHAG,ZNUG,1.)
+!
+ IF( .NOT.ALLOCATED(XKER_Q_SDRYGB1)) ALLOCATE( XKER_Q_SDRYGB1(IDRYLBDAG,IDRYLBDAS) )
+ IF( .NOT.ALLOCATED(XKER_Q_SDRYGB2)) ALLOCATE( XKER_Q_SDRYGB2(IDRYLBDAG,IDRYLBDAS) )
!
! Positive charging region
- CALL VQZCOLX (KND, XALPHAG, XNUG, XALPHAS, XNUS, &
- ZEGS, XSMP, XCG, XDG, XCS, XDS, (1.+XSNP), &
- XDRYLBDAG_MAX, XDRYLBDAS_MAX, XDRYLBDAG_MIN, XDRYLBDAS_MIN, &
- PFDINFTY, XKER_Q_SDRYGB1 )
+ CALL VQZCOLX (IND, ZALPHAG, ZNUG, ZALPHAS, ZNUS, &
+ ZEGS, XSMP, ZCG, ZDG, ZCS, ZDS, (1.+XSNP), &
+ ZDRYLBDAG_MAX, ZDRYLBDAS_MAX, ZDRYLBDAG_MIN, ZDRYLBDAS_MIN, &
+ ZFDINFTY, XKER_Q_SDRYGB1 )
!
! Negative charging region
- CALL VQZCOLX (KND, XALPHAG, XNUG, XALPHAS, XNUS, &
- ZEGS, XSMN, XCG, XDG, XCS, XDS, (1.+XSNN), &
- XDRYLBDAG_MAX, XDRYLBDAS_MAX, XDRYLBDAG_MIN, XDRYLBDAS_MIN, &
- PFDINFTY, XKER_Q_SDRYGB2 )
+ CALL VQZCOLX (IND, ZALPHAG, ZNUG, ZALPHAS, ZNUS, &
+ ZEGS, XSMN, ZCG, ZDG, ZCS, ZDS, (1.+XSNN), &
+ ZDRYLBDAG_MAX, ZDRYLBDAS_MAX, ZDRYLBDAG_MIN, ZDRYLBDAS_MIN, &
+ ZFDINFTY, XKER_Q_SDRYGB2 )
ENDIF
!
!
@@ -962,30 +1265,38 @@ ENDIF
IF (CNI_CHARGING == 'TAKAH') THEN
!
! IDRYG_boun
- XFQIDRYGBT1 = (XPI / 4.0) * XCCG * XCG
- XFQIDRYGBT2 = 10.0 * MOMG(XALPHAG,XNUG,2.+XDG)
- XFQIDRYGBT3 = 5.0 * XCG * MOMG(XALPHAI,XNUI,2.) * &
- MOMG(XALPHAG,XNUG,2.+2.*XDG) / ((2.E-4)**2 * 8. * &
- (XAI * MOMG(XALPHAI,XNUI,XBI))**(2 / XBI))
+ IF (HELEC == 'ELE4') THEN
+ XFQIDRYGBT1 = (XPI / 4.0) * ZCG
+ ELSE
+ XFQIDRYGBT1 = (XPI / 4.0) * ZCCG * ZCG
+ END IF
+ XFQIDRYGBT2 = 10.0 * MOMG(ZALPHAG,ZNUG,2.+ZDG)
+ XFQIDRYGBT3 = 5.0 * ZCG * MOMG(ZALPHAI,ZNUI,2.) * &
+ MOMG(ZALPHAG,ZNUG,2.+2.*ZDG) / ((2.E-4)**2 * 8. * &
+ (ZAI * MOMG(ZALPHAI,ZNUI,ZBI))**(2./ZBI))
!
! SDRYG_boun
- XFQSDRYGBT1 = (XPI / 4.0) * XCCG * XCCS
- XFQSDRYGBT2 = XCG * MOMG(XALPHAG,XNUG,XDG) * MOMG(XALPHAS,XNUS,2.)
- XFQSDRYGBT3 = XCS * MOMG(XALPHAS,XNUS,2.+XDS)
- XFQSDRYGBT4 = XCG * MOMG(XALPHAG,XNUG,2.+XDG)
- XFQSDRYGBT5 = XCS * MOMG(XALPHAG,XNUG,2.) * MOMG(XALPHAS,XNUS,XDS)
- XFQSDRYGBT6 = 2. * XCG * MOMG(XALPHAG,XNUG,1.+XDG) * MOMG(XALPHAS,XNUS,1.)
- XFQSDRYGBT7 = 2. * XCS * MOMG(XALPHAG,XNUG,1.) * MOMG(XALPHAS,XNUS,1.+XDS)
+ IF (HELEC == 'ELE4') THEN
+ XFQSDRYGBT1 = XPI / 4.0
+ ELSE
+ XFQSDRYGBT1 = (XPI / 4.0) * ZCCG * ZCCS
+ END IF
+ XFQSDRYGBT2 = ZCG * MOMG(ZALPHAG,ZNUG,ZDG) * MOMG(ZALPHAS,ZNUS,2.)
+ XFQSDRYGBT3 = ZCS * MOMG(ZALPHAS,ZNUS,2.+ZDS)
+ XFQSDRYGBT4 = ZCG * MOMG(ZALPHAG,ZNUG,2.+ZDG)
+ XFQSDRYGBT5 = ZCS * MOMG(ZALPHAG,ZNUG,2.) * MOMG(ZALPHAS,ZNUS,ZDS)
+ XFQSDRYGBT6 = 2. * ZCG * MOMG(ZALPHAG,ZNUG,1.+ZDG) * MOMG(ZALPHAS,ZNUS,1.)
+ XFQSDRYGBT7 = 2. * ZCS * MOMG(ZALPHAG,ZNUG,1.) * MOMG(ZALPHAS,ZNUS,1.+ZDS)
XFQSDRYGBT8 = 5. / ((1.E-4)**2 * 8.)
- XFQSDRYGBT9 = MOMG(XALPHAG,XNUG,2.) * MOMG(XALPHAS,XNUS,2.)
- XFQSDRYGBT10 = MOMG(XALPHAS,XNUS,4.)
- XFQSDRYGBT11 = 2. * MOMG(XALPHAG,XNUG,1.) * MOMG(XALPHAS,XNUS,3.)
-!
- IF( .NOT.ALLOCATED(XKER_Q_SDRYGB)) ALLOCATE( XKER_Q_SDRYGB(NDRYLBDAG,NDRYLBDAS) )
- CALL VQZCOLX (KND, XALPHAG, XNUG, XALPHAS, XNUS, &
- ZEGS, 2., XCG, XDG, XCS, XDS, 2., &
- XDRYLBDAG_MAX, XDRYLBDAS_MAX, XDRYLBDAG_MIN, XDRYLBDAS_MIN, &
- PFDINFTY, XKER_Q_SDRYGB )
+ XFQSDRYGBT9 = MOMG(ZALPHAG,ZNUG,2.) * MOMG(ZALPHAS,ZNUS,2.)
+ XFQSDRYGBT10 = MOMG(ZALPHAS,ZNUS,4.)
+ XFQSDRYGBT11 = 2. * MOMG(ZALPHAG,ZNUG,1.) * MOMG(ZALPHAS,ZNUS,3.)
+!
+ IF( .NOT.ALLOCATED(XKER_Q_SDRYGB)) ALLOCATE( XKER_Q_SDRYGB(IDRYLBDAG,IDRYLBDAS) )
+ CALL VQZCOLX (IND, ZALPHAG, ZNUG, ZALPHAS, ZNUS, &
+ ZEGS, 2., ZCG, ZDG, ZCS, ZDS, 2., &
+ ZDRYLBDAG_MAX, ZDRYLBDAS_MAX, ZDRYLBDAG_MIN, ZDRYLBDAS_MIN, &
+ ZFDINFTY, XKER_Q_SDRYGB )
END IF
!
!
@@ -996,15 +1307,19 @@ IF (CNI_CHARGING == 'TAKAH' .OR. CNI_CHARGING == 'SAP98' .OR. &
CNI_CHARGING == 'GARDI' .OR. &
CNI_CHARGING == 'BSMP1' .OR. CNI_CHARGING == 'BSMP2' .OR. &
CNI_CHARGING == 'TEEWC' .OR. CNI_CHARGING == 'TERAR') THEN
- XAUX_LIM = (XPI / 4.0) * XCCG * XCCS
- XAUX_LIM1 = MOMG(XALPHAS,XNUS,2.)
- XAUX_LIM2 = 2. * MOMG(XALPHAS,XNUS,1.) * MOMG(XALPHAG,XNUG,1.)
- XAUX_LIM3 = MOMG(XALPHAG,XNUG,2.)
- IF( .NOT.ALLOCATED(XKER_Q_LIMSG)) ALLOCATE( XKER_Q_LIMSG(NDRYLBDAG,NDRYLBDAS) )
- CALL RZCOLX (KND, XALPHAG, XNUG, XALPHAS, XNUS, &
- ZEGS, 0., XCG, XDG, 0., XCS, XDS, 0., &
- XDRYLBDAG_MAX, XDRYLBDAS_MAX, XDRYLBDAG_MIN, XDRYLBDAS_MIN, &
- PFDINFTY, XKER_Q_LIMSG)
+ IF (HELEC == 'ELE4') THEN
+ XAUX_LIM = XPI / 4.0
+ ELSE
+ XAUX_LIM = (XPI / 4.0) * ZCCG * ZCCS
+ END IF
+ XAUX_LIM1 = MOMG(ZALPHAS,ZNUS,2.)
+ XAUX_LIM2 = 2. * MOMG(ZALPHAS,ZNUS,1.) * MOMG(ZALPHAG,ZNUG,1.)
+ XAUX_LIM3 = MOMG(ZALPHAG,ZNUG,2.)
+ IF( .NOT.ALLOCATED(XKER_Q_LIMSG)) ALLOCATE( XKER_Q_LIMSG(IDRYLBDAG,IDRYLBDAS) )
+ CALL RZCOLX (IND, ZALPHAG, ZNUG, ZALPHAS, ZNUS, &
+ ZEGS, 0., ZCG, ZDG, 0., ZCS, ZDS, 0., &
+ ZDRYLBDAG_MAX, ZDRYLBDAS_MAX, ZDRYLBDAG_MIN, ZDRYLBDAS_MIN, &
+ ZFDINFTY, XKER_Q_LIMSG)
ENDIF
!
!
@@ -1013,20 +1328,24 @@ ENDIF
!* 12. DRY GROWTH OF GRAUPELN BY CAPTURE OF RAINDROP
! ---------------------------------------------
!
-IF( .NOT.ALLOCATED(XKER_Q_RDRYG)) ALLOCATE( XKER_Q_RDRYG(NDRYLBDAG,NDRYLBDAR) )
+IF( .NOT.ALLOCATED(XKER_Q_RDRYG)) ALLOCATE( XKER_Q_RDRYG(IDRYLBDAG,IDRYLBDAR) )
!
-XFQRDRYG = (XPI / 4.0) * XCCG * XCCR * (PRHO00**XCEXVT)
+IF (HELEC == 'ELE4') THEN
+ XFQRDRYG = (XPI / 4.0) * PRHO00**ZCEXVT
+ELSE
+ XFQRDRYG = (XPI / 4.0) * ZCCG * ZCCR * (PRHO00**ZCEXVT)
+END IF
!
-XLBQRDRYG1 = MOMG(XALPHAR,XNUR,2.+XFR)
-XLBQRDRYG2 = 2. * MOMG(XALPHAR,XNUR,1.+XFR) * MOMG(XALPHAG,XNUG,1.)
-XLBQRDRYG3 = MOMG(XALPHAR,XNUR,XFR) * MOMG(XALPHAG,XNUG,2.)
+XLBQRDRYG1 = MOMG(ZALPHAR,ZNUR,2.+XFR)
+XLBQRDRYG2 = 2. * MOMG(ZALPHAR,ZNUR,1.+XFR) * MOMG(ZALPHAG,ZNUG,1.)
+XLBQRDRYG3 = MOMG(ZALPHAR,ZNUR,XFR) * MOMG(ZALPHAG,ZNUG,2.)
!
ZEGR = 1.0
!
-CALL RZCOLX (KND, XALPHAG, XNUG, XALPHAR, XNUR, &
- ZEGR, XFR, XCG, XDG, 0., XCR, XDR, 0., &
- XDRYLBDAG_MAX, XDRYLBDAR_MAX, XDRYLBDAG_MIN, XDRYLBDAR_MIN, &
- PFDINFTY, XKER_Q_RDRYG )
+CALL RZCOLX (IND, ZALPHAG, ZNUG, ZALPHAR, ZNUR, &
+ ZEGR, XFR, ZCG, ZDG, 0., ZCR, ZDR, 0., &
+ ZDRYLBDAG_MAX, ZDRYLBDAR_MAX, ZDRYLBDAG_MIN, ZDRYLBDAR_MIN, &
+ ZFDINFTY, XKER_Q_RDRYG )
!
!
!-------------------------------------------------------------------------------
@@ -1034,15 +1353,17 @@ CALL RZCOLX (KND, XALPHAG, XNUG, XALPHAR, XNUR, &
!* 13. UPDATE THE Q=f(D) RELATION
! --------------------------
!
-XFQUPDC = 400.E6 * MOMG(XALPHACQ,XNUCQ,XFC) / XLBDACQ**XFC ! Nc~400E6 m-3 as
+IF (HCLOUD(1:3) == 'ICE') THEN
+ XFQUPDC = 400.E6 * MOMG(XALPHACQ,XNUCQ,XFC) / XLBDACQ**XFC ! Nc~400E6 m-3 as
! proposed for RCHONI
-!
-XFQUPDR = XCCR * MOMG(XALPHAR,XNUR,XFR)
-XEXFQUPDI = (XFI/XBI)
-XFQUPDI = MOMG(XALPHAI,XNUI,XFI) * (XAI*MOMG(XALPHAI,XNUI,XBI))**(-XEXFQUPDI)
-XFQUPDS = XCCS * MOMG(XALPHAS,XNUS,XFS)
-XFQUPDG = XCCG * MOMG(XALPHAG,XNUG,XFG)
-XFQUPDH = XCCH * MOMG(XALPHAH,XNUH,XFH)
+ !
+ XFQUPDR = ZCCR * MOMG(ZALPHAR,ZNUR,XFR)
+ XEXFQUPDI = XFI / ZBI
+ XFQUPDI = MOMG(ZALPHAI,ZNUI,XFI) * (ZAI * MOMG(ZALPHAI,ZNUI,ZBI))**(-XEXFQUPDI)
+END IF
+XFQUPDS = ZCCS * MOMG(ZALPHAS,ZNUS,XFS)
+XFQUPDG = ZCCG * MOMG(ZALPHAG,ZNUG,XFG)
+XFQUPDH = ZCCH * MOMG(ZALPHAH,ZNUH,XFH)
!
!
!------------------------------------------------------------------------------
@@ -1057,39 +1378,17 @@ XEBOUND = 0.1
XALPHA_IND = 0.07 ! moderate inductive charging
XCOS_THETA = 0.2
!
-XIND1 = (XPI**3 / 8.) * (15.E-6)**2 * &
- XCG * 400.E6 * XCCG * &
- XCOLCG_IND * XEBOUND * XALPHA_IND
-XIND2 = XPI * XEPSILON * XCOS_THETA * MOMG(XALPHAG,XNUG,2.+XDG)
-XIND3 = MOMG(XALPHAG,XNUG,XDG+XFG) / 3.
-!
-!-------------------------------------------------------------------------------
-!
-!* 15. LIGHTNING FLASHES
-! -----------------
-!
-XFQLIGHTC = 660. * MOMG(3.,3.,2.) / MOMG(3.,3.,3.) ! PI/A*lbda^(b-2) = 660.
-!
-XFQLIGHTR = XPI * XCCR * MOMG(XALPHAR,XNUR,2.)
-XEXQLIGHTR = XCXR - 2.
-!
-XEXQLIGHTI = 2. / XBI
-XFQLIGHTI = XPI / 4. * MOMG(XALPHAI,XNUI,2.) * &
- (XAI * MOMG(XALPHAI,XNUI,XBI))**(-XEXQLIGHTI)
-!
-XFQLIGHTS = XPI * XCCS * MOMG(XALPHAS,XNUS,2.)
-XEXQLIGHTS = XCXS - 2.
-!
-XFQLIGHTG = XPI * XCCG * MOMG(XALPHAG,XNUG,2.)
-XEXQLIGHTG = XCXG - 2.
-!
-XFQLIGHTH = XPI * XCCH * MOMG(XALPHAH,XNUH,2.)
-XEXQLIGHTH = XCXH - 2.
-!
-IF( .NOT.ALLOCATED(XNEUT_POS)) ALLOCATE( XNEUT_POS(NLGHTMAX) )
-IF( .NOT.ALLOCATED(XNEUT_NEG)) ALLOCATE( XNEUT_NEG(NLGHTMAX) )
-XNEUT_POS(:) = 0.
-XNEUT_NEG(:) = 0.
+IF (HELEC == 'ELE4') THEN
+ XIND1 = (XPI**3 / 8.) * (15.E-6)**2 * &
+ ZCG * 400.E6 * &
+ XCOLCG_IND * XEBOUND * XALPHA_IND
+ELSE
+ XIND1 = (XPI**3 / 8.) * (15.E-6)**2 * &
+ ZCG * 400.E6 * ZCCG * &
+ XCOLCG_IND * XEBOUND * XALPHA_IND
+END IF
+XIND2 = XPI * XEPSILON * XCOS_THETA * MOMG(ZALPHAG,ZNUG,2.+ZDG)
+XIND3 = MOMG(ZALPHAG,ZNUG,ZDG+XFG) / 3.
!
!-------------------------------------------------------------------------------
!
diff --git a/src/PHYEX/micro/lima.f90 b/src/PHYEX/micro/lima.f90
index 6665319bc5689b249629c1cf42b6ce5ded85919b..27d8c5ac54dfcc1e4245902ac3de887c671634ff 100644
--- a/src/PHYEX/micro/lima.f90
+++ b/src/PHYEX/micro/lima.f90
@@ -5,14 +5,15 @@
!-----------------------------------------------------------------
! #####################################################################
SUBROUTINE LIMA ( D, CST, BUCONF, TBUDGETS, KBUDGETS, &
- PTSTEP, &
+ PTSTEP, OELEC, &
PRHODREF, PEXNREF, PDZZ, &
PRHODJ, PPABST, &
NCCN, NIFN, NIMM, &
PDTHRAD, PTHT, PRT, PSVT, PW_NU, &
PTHS, PRS, PSVS, &
PINPRC, PINDEP, PINPRR, PINPRI, PINPRS, PINPRG, PINPRH, &
- PEVAP3D, PCLDFR, PICEFR, PPRCFR, PFPR )
+ PEVAP3D, PCLDFR, PICEFR, PPRCFR, PFPR, &
+ PLATHAM_IAGGS, PEFIELDW, PSV_ELEC_T, PSV_ELEC_S )
! #####################################################################
!
!! PURPOSE
@@ -41,6 +42,9 @@ SUBROUTINE LIMA ( D, CST, BUCONF, TBUDGETS, KBUDGETS, &
! P. Wautelet 28/05/2020: bugfix: correct array start for PSVT and PSVS
! P. Wautelet 03/02/2021: budgets: add new source if LIMA splitting: CORR2
! B. Vie 06/2021: add subgrid condensation with LIMA
+! C. Barthe 04/2022: add cloud electrification
+! C. Barthe 03/2023: add CIBU, RDSF and 2 moments for s, g and h in cloud electrification
+!
!-----------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -52,7 +56,7 @@ USE MODD_CST, ONLY: CST_t
USE MODD_NSV, ONLY: NSV_LIMA_NC, NSV_LIMA_NR, NSV_LIMA_CCN_FREE, NSV_LIMA_CCN_ACTI, &
NSV_LIMA_NI, NSV_LIMA_NS, NSV_LIMA_NG, NSV_LIMA_NH, &
NSV_LIMA_IFN_FREE, NSV_LIMA_IFN_NUCL, NSV_LIMA_IMM_NUCL, NSV_LIMA_HOM_HAZE, &
- NSV_LIMA_BEG
+ NSV_LIMA_BEG, NSV_ELECBEG
USE MODD_PARAM_LIMA, ONLY: NMOD_CCN, NMOD_IFN, NMOD_IMM, LHHONI, &
LFEEDBACKT, NMAXITER, XMRSTEP, XTSTEP_TS, &
LSEDC, LSEDI, XRTMIN, XCTMIN, LDEPOC, XVDEPOC, &
@@ -68,6 +72,8 @@ USE MODE_LIMA_NUCLEATION_PROCS, ONLY: LIMA_NUCLEATION_PROCS
USE MODE_LIMA_SEDIMENTATION, ONLY: LIMA_SEDIMENTATION
USE MODE_LIMA_TENDENCIES, ONLY: LIMA_TENDENCIES
!
+USE MODI_ELEC_TENDENCIES
+!
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
@@ -80,6 +86,8 @@ INTEGER, INTENT(IN) :: KBUDGETS
!
REAL, INTENT(IN) :: PTSTEP ! Time step
!
+LOGICAL, INTENT(IN) :: OELEC ! if true, cloud electrification is activated
+!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Reference density
REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! Layer thikness (m)
@@ -115,6 +123,11 @@ REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PICEFR ! Cloud fraction
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PPRCFR ! Cloud fraction
REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PFPR ! Precipitation fluxes in altitude
!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLATHAM_IAGGS ! Factor for IAGGS modification due to Efield
+REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(IN) :: PEFIELDW ! Vertical component of the electric field
+REAL, DIMENSION(:,:,:,:), OPTIONAL, INTENT(IN) :: PSV_ELEC_T ! Charge density at time t
+REAL, DIMENSION(:,:,:,:), OPTIONAL, INTENT(INOUT) :: PSV_ELEC_S ! Charge density sources
+!
!* 0.2 Declarations of local variables :
!
!
@@ -169,9 +182,15 @@ REAL, DIMENSION(:), ALLOCATABLE :: &
Z_RI_AGGS, Z_CI_AGGS, & ! aggregation of ice on snow (AGGS) : ri, Ni, rs=-ri
Z_TH_DEPG, Z_RG_DEPG, & ! deposition of vapor on graupel (DEPG) : rv=-rg, rg, th
Z_TH_BERFI, Z_RC_BERFI, & ! Bergeron (BERFI) : rc, ri=-rc, th
- Z_TH_RIM, Z_RC_RIM, Z_CC_RIM, Z_RS_RIM, Z_CS_RIM, Z_RG_RIM, & ! cloud droplet riming (RIM) : rc, Nc, rs, Ns, rg, Ng=-Ns, th
+!++cb++
+! Z_TH_RIM, Z_RC_RIM, Z_CC_RIM, Z_RS_RIM, Z_CS_RIM, Z_RG_RIM, & ! cloud droplet riming (RIM) : rc, Nc, rs, Ns, rg, Ng=-Ns, th
+ Z_TH_RIM, Z_CC_RIM, Z_CS_RIM, Z_RC_RIMSS, Z_RC_RIMSG, Z_RS_RIMCG, & ! cloud droplet riming (RIM) : rc, Nc, rs, rg, th
+!--cb--
Z_RI_HMS, Z_CI_HMS, Z_RS_HMS, & ! hallett mossop snow (HMS) : ri, Ni, rs
- Z_TH_ACC, Z_RR_ACC, Z_CR_ACC, Z_RS_ACC, Z_CS_ACC, Z_RG_ACC, & ! rain accretion on aggregates (ACC) : rr, Nr, rs, Ns, rg, Ng=-Ns, th
+!++cb++
+! Z_TH_ACC, Z_RR_ACC, Z_CR_ACC, Z_RS_ACC, Z_CS_ACC, Z_RG_ACC, & ! rain accretion on aggregates (ACC) : rr, Nr, rs, Ns, rg, Ng=-Ns, th
+ Z_TH_ACC, Z_CR_ACC, Z_CS_ACC, Z_RR_ACCSS, Z_RR_ACCSG, Z_RS_ACCRG, & ! rain accretion on aggregates (ACC) : rr, Nr, rs, rg, th
+!--cb--
Z_RS_CMEL, Z_CS_CMEL, & ! conversion-melting (CMEL) : rs, rg=-rs
Z_TH_CFRZ, Z_RR_CFRZ, Z_CR_CFRZ, Z_RI_CFRZ, Z_CI_CFRZ, & ! rain freezing (CFRZ) : rr, Nr, ri, Ni, rg=-rr-ri, th
Z_RI_CIBU, Z_CI_CIBU, & ! collisional ice break-up (CIBU) : ri, Ni, rs=-ri
@@ -188,7 +207,10 @@ REAL, DIMENSION(:), ALLOCATABLE :: &
Z_RG_COHG, Z_CG_COHG, & ! conversion of hail into graupel (COHG) : rg, rh
Z_TH_HMLT, Z_RR_HMLT, Z_CR_HMLT, Z_CH_HMLT, & ! hail melting (HMLT) : rr, Nr, rh=-rr, th
Z_RV_CORR2, Z_RC_CORR2, Z_RR_CORR2, Z_RI_CORR2, &
- Z_CC_CORR2, Z_CR_CORR2, Z_CI_CORR2
+ Z_CC_CORR2, Z_CR_CORR2, Z_CI_CORR2, &
+!++cb+ +
+ Z_RI_HIND, Z_RC_HINC, Z_RV_HENU, Z_RV_HONH
+!--cb--
!
! for the conversion from rain to cloud, we need a 3D variable instead of a 1D packed variable
REAL, DIMENSION(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)) :: &
@@ -224,9 +246,15 @@ REAL, DIMENSION(:,:,:), ALLOCATABLE :: &
ZTOT_RI_AGGS, ZTOT_CI_AGGS, & ! aggregation of ice on snow (AGGS)
ZTOT_TH_DEPG, ZTOT_RG_DEPG, & ! deposition of vapor on graupel (DEPG)
ZTOT_TH_BERFI, ZTOT_RC_BERFI, & ! Bergeron (BERFI)
- ZTOT_TH_RIM, ZTOT_RC_RIM, ZTOT_CC_RIM, ZTOT_RS_RIM, ZTOT_CS_RIM, ZTOT_RG_RIM, & ! cloud droplet riming (RIM)
+!++cb++
+! ZTOT_TH_RIM, ZTOT_RC_RIM, ZTOT_CC_RIM, ZTOT_RS_RIM, ZTOT_CS_RIM, ZTOT_RG_RIM, & ! cloud droplet riming (RIM)
+ ZTOT_TH_RIM, ZTOT_CC_RIM, ZTOT_CS_RIM, ZTOT_RC_RIMSS, ZTOT_RC_RIMSG, ZTOT_RS_RIMCG, & ! cloud droplet riming (RIM)
+!--cb--
ZTOT_RI_HMS, ZTOT_CI_HMS, ZTOT_RS_HMS, & ! hallett mossop snow (HMS)
- ZTOT_TH_ACC, ZTOT_RR_ACC, ZTOT_CR_ACC, ZTOT_RS_ACC, ZTOT_CS_ACC, ZTOT_RG_ACC, & ! rain accretion on aggregates (ACC)
+!++cb++
+! ZTOT_TH_ACC, ZTOT_RR_ACC, ZTOT_CR_ACC, ZTOT_RS_ACC, ZTOT_CS_ACC, ZTOT_RG_ACC, & ! rain accretion on aggregates (ACC)
+ ZTOT_TH_ACC, ZTOT_CR_ACC, ZTOT_CS_ACC, ZTOT_RR_ACCSS, ZTOT_RR_ACCSG, ZTOT_RS_ACCRG, & ! rain accretion on aggregates (ACC)
+!--cb--
ZTOT_RS_CMEL, ZTOT_CS_CMEL, & ! conversion-melting (CMEL)
ZTOT_TH_CFRZ, ZTOT_RR_CFRZ, ZTOT_CR_CFRZ, ZTOT_RI_CFRZ, ZTOT_CI_CFRZ, & ! rain freezing (CFRZ)
ZTOT_RI_CIBU, ZTOT_CI_CIBU, & ! collisional ice break-up (CIBU)
@@ -244,7 +272,10 @@ REAL, DIMENSION(:,:,:), ALLOCATABLE :: &
ZTOT_TH_HMLT, ZTOT_RR_HMLT, ZTOT_CR_HMLT, ZTOT_CH_HMLT, & ! hail melting (HMLT)
ZTOT_RR_CVRC, ZTOT_CR_CVRC, & ! conversion of rain into cloud droplets if diameter too small
ZTOT_RV_CORR2, ZTOT_RC_CORR2, ZTOT_RR_CORR2, ZTOT_RI_CORR2, &
- ZTOT_CC_CORR2, ZTOT_CR_CORR2, ZTOT_CI_CORR2
+ ZTOT_CC_CORR2, ZTOT_CR_CORR2, ZTOT_CI_CORR2, &
+!++cb++
+ ZTOT_RI_HIND, ZTOT_RC_HINC, ZTOT_RV_HENU, ZTOT_RV_HONH
+!--cb--
REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZTOT_IFNN_IMLT
!
@@ -294,6 +325,16 @@ INTEGER :: ISV_LIMA_IFN_NUCL
INTEGER :: ISV_LIMA_IMM_NUCL
INTEGER :: ISV_LIMA_HOM_HAZE
!
+! Variables for the electrification scheme
+LOGICAL, DIMENSION(:,:,:), ALLOCATABLE :: GMASK_ELEC
+INTEGER :: JL ! loop index
+INTEGER :: IELEC ! nb of points where the electrification scheme may apply
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZQPIT, ZQNIT, ZQCT, ZQRT, ZQIT, ZQST, ZQGT, ZQHT
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZQPIS, ZQNIS, ZQCS, ZQRS, ZQIS, ZQSS, ZQGS, ZQHS
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRVT_ELEC, ZRCT_ELEC, ZRRT_ELEC, ZRIT_ELEC, ZRST_ELEC, ZRGT_ELEC, ZRHT_ELEC
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZCCT_ELEC, ZCRT_ELEC, ZCIT_ELEC, ZCST_ELEC, ZCGT_ELEC, ZCHT_ELEC
+REAL, DIMENSION(:), ALLOCATABLE :: ZLATHAM_IAGGS
+!
!-------------------------------------------------------------------------------
!
!* 0. Init
@@ -354,7 +395,9 @@ ZIMMNS(:,:,:,:) = 0.
ZHOMFT(:,:,:) = 0.
ZHOMFS(:,:,:) = 0.
-if ( BUCONF%lbu_enable ) then
+!++cb++
+if ( BUCONF%lbu_enable .OR. OELEC) then
+!--cb--
Z_RR_CVRC(:,:,:) = 0.
Z_CR_CVRC(:,:,:) = 0.
allocate( ZTOT_CR_BRKU (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_CR_BRKU(:,:,:) = 0.
@@ -395,21 +438,31 @@ if ( BUCONF%lbu_enable ) then
allocate( ZTOT_RG_DEPG (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RG_DEPG(:,:,:) = 0.
allocate( ZTOT_TH_BERFI(size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_TH_BERFI(:,:,:) = 0.
allocate( ZTOT_RC_BERFI(size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RC_BERFI(:,:,:) = 0.
+!++cb++ need rcrimss, rcrimsg and rsrimcg to be consistent with ice3
allocate( ZTOT_TH_RIM (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_TH_RIM(:,:,:) = 0.
- allocate( ZTOT_RC_RIM (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RC_RIM(:,:,:) = 0.
+! allocate( ZTOT_RC_RIM (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RC_RIM(:,:,:) = 0.
allocate( ZTOT_CC_RIM (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_CC_RIM(:,:,:) = 0.
- allocate( ZTOT_RS_RIM (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RS_RIM(:,:,:) = 0.
+! allocate( ZTOT_RS_RIM (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RS_RIM(:,:,:) = 0.
allocate( ZTOT_CS_RIM (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_CS_RIM(:,:,:) = 0.
- allocate( ZTOT_RG_RIM (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RG_RIM(:,:,:) = 0.
+! allocate( ZTOT_RG_RIM (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RG_RIM(:,:,:) = 0.
+ allocate( ZTOT_RC_RIMSS (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RC_RIMSS(:,:,:) = 0.
+ allocate( ZTOT_RC_RIMSG (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RC_RIMSG(:,:,:) = 0.
+ allocate( ZTOT_RS_RIMCG (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RS_RIMCG(:,:,:) = 0.
+!--cb--
allocate( ZTOT_RI_HMS (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RI_HMS(:,:,:) = 0.
allocate( ZTOT_CI_HMS (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_CI_HMS(:,:,:) = 0.
allocate( ZTOT_RS_HMS (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RS_HMS(:,:,:) = 0.
+!++cb++ need rraccss, rraccsg and rsaccrg to be consistent with ice3
allocate( ZTOT_TH_ACC (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_TH_ACC(:,:,:) = 0.
- allocate( ZTOT_RR_ACC (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RR_ACC(:,:,:) = 0.
+! allocate( ZTOT_RR_ACC (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RR_ACC(:,:,:) = 0.
allocate( ZTOT_CR_ACC (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_CR_ACC(:,:,:) = 0.
- allocate( ZTOT_RS_ACC (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RS_ACC(:,:,:) = 0.
+! allocate( ZTOT_RS_ACC (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RS_ACC(:,:,:) = 0.
allocate( ZTOT_CS_ACC (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_CS_ACC(:,:,:) = 0.
- allocate( ZTOT_RG_ACC (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RG_ACC(:,:,:) = 0.
+! allocate( ZTOT_RG_ACC (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RG_ACC(:,:,:) = 0.
+ allocate( ZTOT_RR_ACCSS(size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RR_ACCSS(:,:,:) = 0.
+ allocate( ZTOT_RR_ACCSG(size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RR_ACCSG(:,:,:) = 0.
+ allocate( ZTOT_RS_ACCRG(size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RS_ACCRG(:,:,:) = 0.
+!--cb--
allocate( ZTOT_RS_CMEL (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RS_CMEL(:,:,:) = 0.
allocate( ZTOT_CS_CMEL (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_CS_CMEL(:,:,:) = 0.
allocate( ZTOT_TH_CFRZ (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_TH_CFRZ(:,:,:) = 0.
@@ -482,6 +535,13 @@ if ( BUCONF%lbu_enable ) then
allocate( ZTOT_CI_CORR2 (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_CI_CORR2(:,:,:) = 0.
END IF
!
+!++cb++ necessaire pour l'electricite
+ALLOCATE (ZTOT_RI_HIND(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3))) ; ZTOT_RI_HIND(:,:,:) = 0.
+ALLOCATE (ZTOT_RC_HINC(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3))) ; ZTOT_RC_HINC(:,:,:) = 0.
+ALLOCATE (ZTOT_RV_HENU(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3))) ; ZTOT_RV_HENU(:,:,:) = 0.
+ALLOCATE (ZTOT_RV_HONH(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3))) ; ZTOT_RV_HONH(:,:,:) = 0.
+!--cb--
+!
! Initial values computed as source * PTSTEP
!
! Mixing ratios
@@ -542,6 +602,69 @@ ZINV_TSTEP = 1./PTSTEP
ZEXN(:,:,:) = (PPABST(:,:,:)/CST%XP00)**(CST%XRD/CST%XCPD)
ZT(:,:,:) = ZTHT(:,:,:) * ZEXN(:,:,:)
!
+! Electric charge density
+!
+IF (OELEC) THEN
+ ALLOCATE(ZQPIT(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)))
+ ALLOCATE(ZQCT(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)))
+ ALLOCATE(ZQRT(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)))
+ ALLOCATE(ZQIT(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)))
+ ALLOCATE(ZQST(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)))
+ ALLOCATE(ZQGT(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)))
+ ALLOCATE(ZQNIT(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)))
+ IF (KRR == 7) ALLOCATE(ZQHT(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)))
+ !
+ ALLOCATE(ZQPIS(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)))
+ ALLOCATE(ZQCS(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)))
+ ALLOCATE(ZQRS(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)))
+ ALLOCATE(ZQIS(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)))
+ ALLOCATE(ZQSS(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)))
+ ALLOCATE(ZQGS(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)))
+ ALLOCATE(ZQNIS(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)))
+ IF (KRR == 7) ALLOCATE(ZQHS(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)))
+ !
+ ALLOCATE(ZRVT_ELEC(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)))
+ ALLOCATE(ZRCT_ELEC(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)))
+ ALLOCATE(ZRRT_ELEC(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)))
+ ALLOCATE(ZRIT_ELEC(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)))
+ ALLOCATE(ZRST_ELEC(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)))
+ ALLOCATE(ZRGT_ELEC(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)))
+ IF (KRR == 7) ALLOCATE(ZRHT_ELEC(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)))
+ ALLOCATE(ZCCT_ELEC(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)))
+ ALLOCATE(ZCRT_ELEC(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)))
+ ALLOCATE(ZCIT_ELEC(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)))
+ ALLOCATE(ZCST_ELEC(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)))
+ ALLOCATE(ZCGT_ELEC(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)))
+ IF (KRR == 7) ALLOCATE(ZCHT_ELEC(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)))
+!
+!++cb++ 21/04/23 source * ptstep
+ ZQPIT(:,:,:) = PSV_ELEC_S(:,:,:,1) * PTSTEP
+ ZQCT(:,:,:) = PSV_ELEC_S(:,:,:,2) * PTSTEP
+ ZQRT(:,:,:) = PSV_ELEC_S(:,:,:,3) * PTSTEP
+ ZQIT(:,:,:) = PSV_ELEC_S(:,:,:,4) * PTSTEP
+ ZQST(:,:,:) = PSV_ELEC_S(:,:,:,5) * PTSTEP
+ ZQGT(:,:,:) = PSV_ELEC_S(:,:,:,6) * PTSTEP
+ IF (KRR == 6) THEN
+ ZQNIT(:,:,:) = PSV_ELEC_S(:,:,:,7) * PTSTEP
+ ELSE IF (KRR == 7) THEN
+ ZQHT(:,:,:) = PSV_ELEC_S(:,:,:,7) * PTSTEP
+ ZQNIT(:,:,:) = PSV_ELEC_S(:,:,:,8) * PTSTEP
+ END IF
+ !
+ ZQPIS(:,:,:) = PSV_ELEC_S(:,:,:,1)
+ ZQCS(:,:,:) = PSV_ELEC_S(:,:,:,2)
+ ZQRS(:,:,:) = PSV_ELEC_S(:,:,:,3)
+ ZQIS(:,:,:) = PSV_ELEC_S(:,:,:,4)
+ ZQSS(:,:,:) = PSV_ELEC_S(:,:,:,5)
+ ZQGS(:,:,:) = PSV_ELEC_S(:,:,:,6)
+ IF (KRR == 6) THEN
+ ZQNIS(:,:,:) = PSV_ELEC_S(:,:,:,7)
+ ELSE IF (KRR == 7) THEN
+ ZQHS(:,:,:) = PSV_ELEC_S(:,:,:,7)
+ ZQNIS(:,:,:) = PSV_ELEC_S(:,:,:,8)
+ END IF
+END IF
+!
!-------------------------------------------------------------------------------
!
!* 0. Check mean diameter for cloud, rain and ice
@@ -625,20 +748,20 @@ PINPRS=0.
PINPRG=0.
PINPRH=0.
if ( BUCONF%lbu_enable ) then
- if ( BUCONF%lbudget_th ) &
- call BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_TH), 'SEDI', zths(:, :, :) * prhodj(:, :, :) )
- if ( BUCONF%lbudget_rc .and. nmom_c.ge.1 .and. lsedc ) &
- call BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RC), 'SEDI', zrcs(:, :, :) * prhodj(:, :, :) )
- if ( BUCONF%lbudget_rr .and. nmom_r.ge.1 ) &
- call BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RR), 'SEDI', zrrs(:, :, :) * prhodj(:, :, :) )
- if ( BUCONF%lbudget_ri .and. nmom_i.ge.1 .and. lsedi ) &
- call BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RI), 'SEDI', zris(:, :, :) * prhodj(:, :, :) )
- if ( BUCONF%lbudget_rs .and. nmom_s.ge.1 ) &
- call BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RS), 'SEDI', zrss(:, :, :) * prhodj(:, :, :) )
- if ( BUCONF%lbudget_rg .and. nmom_g.ge.1 ) &
- call BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RG), 'SEDI', zrgs(:, :, :) * prhodj(:, :, :) )
- if ( BUCONF%lbudget_rh .and. nmom_h.ge.1 ) &
- call BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RH), 'SEDI', zrhs(:, :, :) * prhodj(:, :, :) )
+ if ( BUCONF%lbudget_th ) &
+ call BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_TH), 'SEDI', zths(:, :, :) * prhodj(:, :, :) )
+ if ( BUCONF%lbudget_rc .and. nmom_c.ge.1 .and. lsedc ) &
+ call BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RC), 'SEDI', zrcs(:, :, :) * prhodj(:, :, :) )
+ if ( BUCONF%lbudget_rr .and. nmom_r.ge.1 ) &
+ call BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RR), 'SEDI', zrrs(:, :, :) * prhodj(:, :, :) )
+ if ( BUCONF%lbudget_ri .and. nmom_i.ge.1 .and. lsedi ) &
+ call BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RI), 'SEDI', zris(:, :, :) * prhodj(:, :, :) )
+ if ( BUCONF%lbudget_rs .and. nmom_s.ge.1 ) &
+ call BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RS), 'SEDI', zrss(:, :, :) * prhodj(:, :, :) )
+ if ( BUCONF%lbudget_rg .and. nmom_g.ge.1 ) &
+ call BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RG), 'SEDI', zrgs(:, :, :) * prhodj(:, :, :) )
+ if ( BUCONF%lbudget_rh .and. nmom_h.ge.1 ) &
+ call BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RH), 'SEDI', zrhs(:, :, :) * prhodj(:, :, :) )
if ( BUCONF%lbudget_sv ) then
if ( lsedc .and. nmom_c.ge.2) &
call BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + nsv_lima_nc), 'SEDI', zccs(:, :, :) * prhodj(:, :, :) )
@@ -652,53 +775,132 @@ if ( BUCONF%lbu_enable ) then
call BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + nsv_lima_ng), 'SEDI', zcgs(:, :, :) * prhodj(:, :, :) )
if ( nmom_h.ge.2) &
call BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + nsv_lima_nh), 'SEDI', zchs(:, :, :) * prhodj(:, :, :) )
+ !
+ if (oelec) then
+ if ( lsedc ) &
+ call BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + nsv_elecbeg + 1), 'SEDI', zqcs(:, :, :) * prhodj(:, :, :) )
+ call BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + nsv_elecbeg + 2), 'SEDI', zqrs(:, :, :) * prhodj(:, :, :) )
+ if ( lsedi ) &
+ call BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + nsv_elecbeg + 3), 'SEDI', zqis(:, :, :) * prhodj(:, :, :) )
+ call BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + nsv_elecbeg + 4), 'SEDI', zqss(:, :, :) * prhodj(:, :, :) )
+ call BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + nsv_elecbeg + 5), 'SEDI', zqgs(:, :, :) * prhodj(:, :, :) )
+ if (nmom_h .ge. 1) &
+ call BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + nsv_elecbeg + 6), 'SEDI', zqhs(:, :, :) * prhodj(:, :, :) )
+ end if
end if
end if
+!
PFPR(:,:,:,:)=0.
+!
+! sedimentation of cloud droplets
ZRT_SUM = (ZRVS + ZRCS + ZRRS + ZRIS + ZRSS + ZRGS + ZRHS)*PTSTEP
ZCPT = CST%XCPD + (CST%XCPV * ZRVS + CST%XCL * (ZRCS + ZRRS) + CST%XCI * (ZRIS + ZRSS + ZRGS + ZRHS))*PTSTEP
-IF (NMOM_C.GE.1 .AND. LSEDC) CALL LIMA_SEDIMENTATION(D, CST, &
- 'L', 2, 2, 1, PTSTEP, PDZZ, PRHODREF, PPABST, ZT, ZRT_SUM, ZCPT, ZRCS, ZCCS, PINPRC, PFPR(:,:,:,2))
+IF (NMOM_C.GE.1 .AND. LSEDC) THEN
+ IF (OELEC) THEN
+ CALL LIMA_SEDIMENTATION(D, CST, &
+ 'L', 2, 2, 1, PTSTEP, OELEC, PDZZ, PRHODREF, PPABST, ZT, ZRT_SUM, ZCPT, &
+ ZRCS, ZCCS, PINPRC, PFPR(:,:,:,2), PEFIELDW, ZQCS)
+ ELSE
+ CALL LIMA_SEDIMENTATION(D, CST, &
+ 'L', 2, 2, 1, PTSTEP, OELEC, PDZZ, PRHODREF, PPABST, ZT, ZRT_SUM, ZCPT, &
+ ZRCS, ZCCS, PINPRC, PFPR(:,:,:,2))
+ END IF
+END IF
+!
+! sedimentation of raindrops
ZRT_SUM = (ZRVS + ZRCS + ZRRS + ZRIS + ZRSS + ZRGS + ZRHS)*PTSTEP
ZCPT = CST%XCPD + (CST%XCPV * ZRVS + CST%XCL * (ZRCS + ZRRS) + CST%XCI * (ZRIS + ZRSS + ZRGS + ZRHS))*PTSTEP
-IF (NMOM_R.GE.1) CALL LIMA_SEDIMENTATION(D, CST, &
- 'L', NMOM_R, 3, 1, PTSTEP, PDZZ, PRHODREF, PPABST, ZT, ZRT_SUM, ZCPT, ZRRS, ZCRS, PINPRR, PFPR(:,:,:,3))
+IF (NMOM_R.GE.1) THEN
+ IF (OELEC) THEN
+ CALL LIMA_SEDIMENTATION(D, CST, &
+ 'L', NMOM_R, 3, 1, PTSTEP, OELEC, PDZZ, PRHODREF, PPABST, ZT, ZRT_SUM, ZCPT, &
+ ZRRS, ZCRS, PINPRR, PFPR(:,:,:,3), PEFIELDW, ZQRS)
+ ELSE
+ CALL LIMA_SEDIMENTATION(D, CST, &
+ 'L', NMOM_R, 3, 1, PTSTEP, OELEC, PDZZ, PRHODREF, PPABST, ZT, ZRT_SUM, ZCPT, &
+ ZRRS, ZCRS, PINPRR, PFPR(:,:,:,3))
+ END IF
+END IF
+!
+! sedimentation of ice crystals
ZRT_SUM = (ZRVS + ZRCS + ZRRS + ZRIS + ZRSS + ZRGS + ZRHS)*PTSTEP
ZCPT = CST%XCPD + (CST%XCPV * ZRVS + CST%XCL * (ZRCS + ZRRS) + CST%XCI * (ZRIS + ZRSS + ZRGS + ZRHS))*PTSTEP
-IF (NMOM_I.GE.1 .AND. LSEDI) CALL LIMA_SEDIMENTATION(D, CST, &
- 'I', NMOM_I, 4, 1, PTSTEP, PDZZ, PRHODREF, PPABST, ZT, ZRT_SUM, ZCPT, ZRIS, ZCIS, ZW2D, PFPR(:,:,:,4))
+IF (NMOM_I.GE.1 .AND. LSEDI) THEN
+ IF (OELEC) THEN
+ CALL LIMA_SEDIMENTATION(D, CST, &
+ 'I', NMOM_I, 4, 1, PTSTEP, OELEC, PDZZ, PRHODREF, PPABST, ZT, ZRT_SUM, ZCPT, &
+ ZRIS, ZCIS, ZW2D, PFPR(:,:,:,4), PEFIELDW, ZQIS)
+ ELSE
+ CALL LIMA_SEDIMENTATION(D, CST, &
+ 'I', NMOM_I, 4, 1, PTSTEP, OELEC, PDZZ, PRHODREF, PPABST, ZT, ZRT_SUM, ZCPT, &
+ ZRIS, ZCIS, ZW2D, PFPR(:,:,:,4))
+ END IF
+END IF
+!
+! sedimentation of snow/aggregates
ZRT_SUM = (ZRVS + ZRCS + ZRRS + ZRIS + ZRSS + ZRGS + ZRHS)*PTSTEP
ZCPT = CST%XCPD + (CST%XCPV * ZRVS + CST%XCL * (ZRCS + ZRRS) + CST%XCI * (ZRIS + ZRSS + ZRGS + ZRHS))*PTSTEP
-IF (NMOM_S.GE.1) CALL LIMA_SEDIMENTATION(D, CST, &
- 'I', NMOM_S, 5, 1, PTSTEP, PDZZ, PRHODREF, PPABST, ZT, ZRT_SUM, ZCPT, ZRSS, ZCSS, PINPRS, PFPR(:,:,:,5))
+IF (NMOM_S.GE.1) THEN
+ IF (OELEC) THEN
+ CALL LIMA_SEDIMENTATION(D, CST, &
+ 'I', NMOM_S, 5, 1, PTSTEP, OELEC, PDZZ, PRHODREF, PPABST, ZT, ZRT_SUM, ZCPT, &
+ ZRSS, ZCSS, PINPRS, PFPR(:,:,:,5), PEFIELDW, ZQSS)
+ ELSE
+ CALL LIMA_SEDIMENTATION(D, CST, &
+ 'I', NMOM_S, 5, 1, PTSTEP, OELEC, PDZZ, PRHODREF, PPABST, ZT, ZRT_SUM, ZCPT, &
+ ZRSS, ZCSS, PINPRS, PFPR(:,:,:,5))
+ END IF
+END IF
+!
+! sedimentation of graupel
ZRT_SUM = (ZRVS + ZRCS + ZRRS + ZRIS + ZRSS + ZRGS + ZRHS)*PTSTEP
ZCPT = CST%XCPD + (CST%XCPV * ZRVS + CST%XCL * (ZRCS + ZRRS) + CST%XCI * (ZRIS + ZRSS + ZRGS + ZRHS))*PTSTEP
-IF (NMOM_G.GE.1) CALL LIMA_SEDIMENTATION(D, CST, &
- 'I', NMOM_G, 6, 1, PTSTEP, PDZZ, PRHODREF, PPABST, ZT, ZRT_SUM, ZCPT, ZRGS, ZCGS, PINPRG, PFPR(:,:,:,6))
+IF (NMOM_G.GE.1) THEN
+ IF (OELEC) THEN
+ CALL LIMA_SEDIMENTATION(D, CST, &
+ 'I', NMOM_G, 6, 1, PTSTEP, OELEC, PDZZ, PRHODREF, PPABST, ZT, ZRT_SUM, ZCPT, &
+ ZRGS, ZCGS, PINPRG, PFPR(:,:,:,6), PEFIELDW, ZQGS)
+ ELSE
+ CALL LIMA_SEDIMENTATION(D, CST, &
+ 'I', NMOM_G, 6, 1, PTSTEP, OELEC, PDZZ, PRHODREF, PPABST, ZT, ZRT_SUM, ZCPT, &
+ ZRGS, ZCGS, PINPRG, PFPR(:,:,:,6))
+ END IF
+END IF
+!
+! sedimentation of hail
ZRT_SUM = (ZRVS + ZRCS + ZRRS + ZRIS + ZRSS + ZRGS + ZRHS)*PTSTEP
ZCPT = CST%XCPD + (CST%XCPV * ZRVS + CST%XCL * (ZRCS + ZRRS) + CST%XCI * (ZRIS + ZRSS + ZRGS + ZRHS))*PTSTEP
-IF (NMOM_H.GE.1) CALL LIMA_SEDIMENTATION(D, CST, &
- 'I', NMOM_H, 7, 1, PTSTEP, PDZZ, PRHODREF, PPABST, ZT, ZRT_SUM, ZCPT, ZRHS, ZCHS, PINPRH, PFPR(:,:,:,7))
+IF (NMOM_H.GE.1) THEN
+ IF (OELEC) THEN
+ CALL LIMA_SEDIMENTATION(D, CST, &
+ 'I', NMOM_H, 7, 1, PTSTEP, OELEC, PDZZ, PRHODREF, PPABST, ZT, ZRT_SUM, ZCPT, &
+ ZRHS, ZCHS, PINPRH, PFPR(:,:,:,7), PEFIELDW, ZQHS)
+ ELSE
+ CALL LIMA_SEDIMENTATION(D, CST, &
+ 'I', NMOM_H, 7, 1, PTSTEP, OELEC, PDZZ, PRHODREF, PPABST, ZT, ZRT_SUM, ZCPT, &
+ ZRHS, ZCHS, PINPRH, PFPR(:,:,:,7))
+ END IF
+END IF
!
ZTHS(:,:,:) = ZT(:,:,:) / ZEXN(:,:,:) * ZINV_TSTEP
!
! Call budgets
!
if ( BUCONF%lbu_enable ) then
- if ( BUCONF%lbudget_th ) &
- call BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_TH), 'SEDI', zths(:, :, :) * prhodj(:, :, :) )
- if ( BUCONF%lbudget_rc .and. nmom_c.ge.1 .and. lsedc ) &
- call BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_RC), 'SEDI', zrcs(:, :, :) * prhodj(:, :, :) )
- if ( BUCONF%lbudget_rr .and. nmom_r.ge.2 ) &
- call BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_RR), 'SEDI', zrrs(:, :, :) * prhodj(:, :, :) )
- if ( BUCONF%lbudget_ri .and. nmom_i.ge.1 .and. lsedi ) &
- call BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_RI), 'SEDI', zris(:, :, :) * prhodj(:, :, :) )
- if ( BUCONF%lbudget_rs .and. nmom_s.ge.1 ) &
- call BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_RS), 'SEDI', zrss(:, :, :) * prhodj(:, :, :) )
- if ( BUCONF%lbudget_rg .and. nmom_g.ge.1 ) &
- call BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_RG), 'SEDI', zrgs(:, :, :) * prhodj(:, :, :) )
- if ( BUCONF%lbudget_rh .and. nmom_h.ge.1 ) &
- call BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_RH), 'SEDI', zrhs(:, :, :) * prhodj(:, :, :) )
+ if ( BUCONF%lbudget_th ) &
+ call BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_TH), 'SEDI', zths(:, :, :) * prhodj(:, :, :) )
+ if ( BUCONF%lbudget_rc .and. nmom_c.ge.1 .and. lsedc ) &
+ call BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_RC), 'SEDI', zrcs(:, :, :) * prhodj(:, :, :) )
+ if ( BUCONF%lbudget_rr .and. nmom_r.ge.2 ) &
+ call BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_RR), 'SEDI', zrrs(:, :, :) * prhodj(:, :, :) )
+ if ( BUCONF%lbudget_ri .and. nmom_i.ge.1 .and. lsedi ) &
+ call BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_RI), 'SEDI', zris(:, :, :) * prhodj(:, :, :) )
+ if ( BUCONF%lbudget_rs .and. nmom_s.ge.1 ) &
+ call BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_RS), 'SEDI', zrss(:, :, :) * prhodj(:, :, :) )
+ if ( BUCONF%lbudget_rg .and. nmom_g.ge.1 ) &
+ call BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_RG), 'SEDI', zrgs(:, :, :) * prhodj(:, :, :) )
+ if ( BUCONF%lbudget_rh .and. nmom_h.ge.1 ) &
+ call BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_RH), 'SEDI', zrhs(:, :, :) * prhodj(:, :, :) )
if ( BUCONF%lbudget_sv ) then
if ( lsedc .and. nmom_c.ge.2 ) &
call BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + nsv_lima_nc), 'SEDI', zccs(:, :, :) * prhodj(:, :, :) )
@@ -712,6 +914,18 @@ if ( BUCONF%lbu_enable ) then
call BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + nsv_lima_ng), 'SEDI', zcgs(:, :, :) * prhodj(:, :, :) )
if ( nmom_h.ge.2 ) &
call BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + nsv_lima_nh), 'SEDI', zchs(:, :, :) * prhodj(:, :, :) )
+!
+ if (oelec) then
+ if ( lsedc ) &
+ call BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + nsv_elecbeg + 1), 'SEDI', zqcs(:, :, :) * prhodj(:, :, :) )
+ call BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + nsv_elecbeg + 2), 'SEDI', zqrs(:, :, :) * prhodj(:, :, :) )
+ if ( lsedi ) &
+ call BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + nsv_elecbeg + 3), 'SEDI', zqis(:, :, :) * prhodj(:, :, :) )
+ call BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + nsv_elecbeg + 4), 'SEDI', zqss(:, :, :) * prhodj(:, :, :) )
+ call BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + nsv_elecbeg + 5), 'SEDI', zqgs(:, :, :) * prhodj(:, :, :) )
+ if (nmom_h .ge. 1) &
+ call BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + nsv_elecbeg + 6), 'SEDI', zqhs(:, :, :) * prhodj(:, :, :) )
+ end if
end if
end if
!
@@ -786,6 +1000,15 @@ IF ( NMOM_I.GE.2 ) ZCIT(:,:,:) = ZCIS(:,:,:) * PTSTEP
IF ( NMOM_S.GE.2 ) ZCST(:,:,:) = ZCSS(:,:,:) * PTSTEP
IF ( NMOM_G.GE.2 ) ZCGT(:,:,:) = ZCGS(:,:,:) * PTSTEP
IF ( NMOM_H.GE.2 ) ZCHT(:,:,:) = ZCHS(:,:,:) * PTSTEP
+!
+IF (OELEC) THEN
+ ZQCT(:,:,:) = ZQCS(:,:,:) * PTSTEP
+ ZQRT(:,:,:) = ZQRS(:,:,:) * PTSTEP
+ ZQIT(:,:,:) = ZQIS(:,:,:) * PTSTEP
+ ZQST(:,:,:) = ZQSS(:,:,:) * PTSTEP
+ ZQGT(:,:,:) = ZQGS(:,:,:) * PTSTEP
+ IF (NMOM_H .GE. 1) ZQHT(:,:,:) = ZQHS(:,:,:) * PTSTEP
+END IF
!
!-------------------------------------------------------------------------------
!
@@ -801,6 +1024,7 @@ CALL LIMA_COMPUTE_CLOUD_FRACTIONS (D, &
ZCHT, ZRHT, &
PCLDFR, PICEFR, PPRCFR )
!
+!
!-------------------------------------------------------------------------------
!
!* 2. Nucleation processes
@@ -812,7 +1036,8 @@ CALL LIMA_NUCLEATION_PROCS (D, CST, BUCONF, TBUDGETS, KBUDGETS,
ZTHT, ZRVT, ZRCT, ZRRT, ZRIT, ZRST, ZRGT, ZRHT, &
ZCCT, ZCRT, ZCIT, &
ZCCNFT, ZCCNAT, ZIFNFT, ZIFNNT, ZIMMNT, ZHOMFT, &
- PCLDFR, PICEFR, PPRCFR )
+ PCLDFR, PICEFR, PPRCFR, &
+ ZTOT_RV_HENU, ZTOT_RC_HINC, ZTOT_RI_HIND, ZTOT_RV_HONH)
!
! Saving sources before microphysics time-splitting loop
!
@@ -841,6 +1066,21 @@ ZHOMFS(:,:,:) = ZHOMFT(:,:,:) *ZINV_TSTEP
ZTHS(:,:,:) = ZTHT(:,:,:) *ZINV_TSTEP
ZT(:,:,:) = ZTHT(:,:,:) * ZEXN(:,:,:)
!
+IF (OELEC) THEN
+ ZRVT_ELEC(:,:,:) = ZRVT(:,:,:)
+ ZRCT_ELEC(:,:,:) = ZRCT(:,:,:)
+ ZRRT_ELEC(:,:,:) = ZRRT(:,:,:)
+ ZRIT_ELEC(:,:,:) = ZRIT(:,:,:)
+ ZRST_ELEC(:,:,:) = ZRST(:,:,:)
+ ZRGT_ELEC(:,:,:) = ZRGT(:,:,:)
+ IF (NMOM_H .GE. 1) ZRHT_ELEC(:,:,:) = ZRHT(:,:,:)
+ IF (NMOM_C .GE. 2) ZCCT_ELEC(:,:,:) = ZCCT(:,:,:)
+ IF (NMOM_R .GE. 2) ZCRT_ELEC(:,:,:) = ZCRT(:,:,:)
+ IF (NMOM_I .GE. 2) ZCIT_ELEC(:,:,:) = ZCIT(:,:,:)
+ IF (NMOM_S .GE. 2) ZCST_ELEC(:,:,:) = ZCST(:,:,:)
+ IF (NMOM_G .GE. 2) ZCGT_ELEC(:,:,:) = ZCGT(:,:,:)
+ IF (NMOM_H .GE. 2) ZCHT_ELEC(:,:,:) = ZCHT(:,:,:)
+END IF
!
!-------------------------------------------------------------------------------
!
@@ -932,6 +1172,7 @@ DO WHILE(ANY(ZTIME(D%NIB:D%NIE,D%NJB:D%NJE,D%NKTB:D%NKTE)<PTSTEP))
ALLOCATE(ZCF1D(IPACK))
ALLOCATE(ZIF1D(IPACK))
ALLOCATE(ZPF1D(IPACK))
+ ALLOCATE(ZLATHAM_IAGGS(IPACK))
IPACK = COUNTJV(LLCOMPUTE,I1,I2,I3)
DO II=1,IPACK
ZRHODREF1D(II) = PRHODREF(I1(II),I2(II),I3(II))
@@ -968,6 +1209,11 @@ DO WHILE(ANY(ZTIME(D%NIB:D%NIE,D%NJB:D%NJE,D%NKTB:D%NKTE)<PTSTEP))
ZCF1D(II) = PCLDFR(I1(II),I2(II),I3(II))
ZIF1D(II) = PICEFR(I1(II),I2(II),I3(II))
ZPF1D(II) = PPRCFR(I1(II),I2(II),I3(II))
+ IF (OELEC) THEN
+ ZLATHAM_IAGGS(II) = PLATHAM_IAGGS(I1(II),I2(II),I3(II))
+ ELSE
+ ZLATHAM_IAGGS(II) = 1.0
+ END IF
END DO
!
WHERE(ZCF1D(:)<1.E-10 .AND. ZRCT1D(:)>XRTMIN(2) .AND. ZCCT1D(:)>XCTMIN(2)) ZCF1D(:)=1.
@@ -1048,21 +1294,31 @@ DO WHILE(ANY(ZTIME(D%NIB:D%NIE,D%NJB:D%NJE,D%NKTB:D%NKTE)<PTSTEP))
ALLOCATE(Z_RG_DEPG(IPACK)) ; Z_RG_DEPG(:) = 0.
ALLOCATE(Z_TH_BERFI(IPACK)) ; Z_TH_BERFI(:) = 0.
ALLOCATE(Z_RC_BERFI(IPACK)) ; Z_RC_BERFI(:) = 0.
+!++cb++
ALLOCATE(Z_TH_RIM(IPACK)) ; Z_TH_RIM(:) = 0.
- ALLOCATE(Z_RC_RIM(IPACK)) ; Z_RC_RIM(:) = 0.
+! ALLOCATE(Z_RC_RIM(IPACK)) ; Z_RC_RIM(:) = 0.
ALLOCATE(Z_CC_RIM(IPACK)) ; Z_CC_RIM(:) = 0.
- ALLOCATE(Z_RS_RIM(IPACK)) ; Z_RS_RIM(:) = 0.
+! ALLOCATE(Z_RS_RIM(IPACK)) ; Z_RS_RIM(:) = 0.
ALLOCATE(Z_CS_RIM(IPACK)) ; Z_CS_RIM(:) = 0.
- ALLOCATE(Z_RG_RIM(IPACK)) ; Z_RG_RIM(:) = 0.
+! ALLOCATE(Z_RG_RIM(IPACK)) ; Z_RG_RIM(:) = 0.
+ ALLOCATE(Z_RC_RIMSS(IPACK)) ; Z_RC_RIMSS = 0.
+ ALLOCATE(Z_RC_RIMSG(IPACK)) ; Z_RC_RIMSG = 0.
+ ALLOCATE(Z_RS_RIMCG(IPACK)) ; Z_RS_RIMCG = 0.
+!--cb--
ALLOCATE(Z_RI_HMS(IPACK)) ; Z_RI_HMS(:) = 0.
ALLOCATE(Z_CI_HMS(IPACK)) ; Z_CI_HMS(:) = 0.
ALLOCATE(Z_RS_HMS(IPACK)) ; Z_RS_HMS(:) = 0.
+!++cb++
ALLOCATE(Z_TH_ACC(IPACK)) ; Z_TH_ACC(:) = 0.
- ALLOCATE(Z_RR_ACC(IPACK)) ; Z_RR_ACC(:) = 0.
+! ALLOCATE(Z_RR_ACC(IPACK)) ; Z_RR_ACC(:) = 0.
ALLOCATE(Z_CR_ACC(IPACK)) ; Z_CR_ACC(:) = 0.
- ALLOCATE(Z_RS_ACC(IPACK)) ; Z_RS_ACC(:) = 0.
+! ALLOCATE(Z_RS_ACC(IPACK)) ; Z_RS_ACC(:) = 0.
ALLOCATE(Z_CS_ACC(IPACK)) ; Z_CS_ACC(:) = 0.
- ALLOCATE(Z_RG_ACC(IPACK)) ; Z_RG_ACC(:) = 0.
+! ALLOCATE(Z_RG_ACC(IPACK)) ; Z_RG_ACC(:) = 0.
+ ALLOCATE(Z_RR_ACCSS(IPACK)) ; Z_RR_ACCSS = 0.
+ ALLOCATE(Z_RR_ACCSG(IPACK)) ; Z_RR_ACCSG = 0.
+ ALLOCATE(Z_RS_ACCRG(IPACK)) ; Z_RS_ACCRG = 0.
+!--cb--
ALLOCATE(Z_RS_CMEL(IPACK)) ; Z_RS_CMEL(:) = 0.
ALLOCATE(Z_CS_CMEL(IPACK)) ; Z_CS_CMEL(:) = 0.
ALLOCATE(Z_TH_CFRZ(IPACK)) ; Z_TH_CFRZ(:) = 0.
@@ -1132,9 +1388,8 @@ DO WHILE(ANY(ZTIME(D%NIB:D%NIE,D%NJB:D%NJE,D%NKTB:D%NKTE)<PTSTEP))
ALLOCATE(Z_CR_CORR2(IPACK)) ; Z_CR_CORR2(:) = 0.
ALLOCATE(Z_CI_CORR2(IPACK)) ; Z_CI_CORR2(:) = 0.
!
- !*** 4.1 Tendecies computation
+ !*** 4.1 Tendencies computation
!
-
CALL LIMA_INST_PROCS (PTSTEP, LLCOMPUTE1D, &
ZEXNREF1D, ZP1D, &
ZTHT1D, ZRVT1D, ZRCT1D, ZRRT1D, ZRIT1D, ZRST1D, ZRGT1D, &
@@ -1166,9 +1421,15 @@ DO WHILE(ANY(ZTIME(D%NIB:D%NIE,D%NJB:D%NJE,D%NKTB:D%NKTE)<PTSTEP))
Z_RI_AGGS, Z_CI_AGGS, &
Z_TH_DEPG, Z_RG_DEPG, &
Z_TH_BERFI, Z_RC_BERFI, &
- Z_TH_RIM, Z_RC_RIM, Z_CC_RIM, Z_RS_RIM, Z_CS_RIM, Z_RG_RIM, &
+!++cb++
+! Z_TH_RIM, Z_RC_RIM, Z_CC_RIM, Z_RS_RIM, Z_CS_RIM, Z_RG_RIM, &
+ Z_TH_RIM, Z_CC_RIM, Z_CS_RIM, Z_RC_RIMSS, Z_RC_RIMSG, Z_RS_RIMCG, &
+!--cb--
Z_RI_HMS, Z_CI_HMS, Z_RS_HMS, &
- Z_TH_ACC, Z_RR_ACC, Z_CR_ACC, Z_RS_ACC, Z_CS_ACC, Z_RG_ACC, &
+!++cb++
+! Z_TH_ACC, Z_RR_ACC, Z_CR_ACC, Z_RS_ACC, Z_CS_ACC, Z_RG_ACC, &
+ Z_TH_ACC, Z_CR_ACC, Z_CS_ACC, Z_RR_ACCSS, Z_RR_ACCSG, Z_RS_ACCRG, &
+!--cb--
Z_RS_CMEL, Z_CS_CMEL, &
Z_TH_CFRZ, Z_RR_CFRZ, Z_CR_CFRZ, Z_RI_CFRZ, Z_CI_CFRZ, &
Z_RI_CIBU, Z_CI_CIBU, &
@@ -1187,7 +1448,8 @@ DO WHILE(ANY(ZTIME(D%NIB:D%NIE,D%NJB:D%NJE,D%NKTB:D%NKTE)<PTSTEP))
ZA_TH, ZA_RV, ZA_RC, ZA_CC, ZA_RR, ZA_CR, &
ZA_RI, ZA_CI, ZA_RS, ZA_CS, ZA_RG, ZA_CG, ZA_RH, ZA_CH, &
ZEVAP1D, &
- ZCF1D, ZIF1D, ZPF1D )
+ ZCF1D, ZIF1D, ZPF1D, &
+ ZLATHAM_IAGGS )
!
!*** 4.2 Integration time
@@ -1420,7 +1682,7 @@ DO WHILE(ANY(ZTIME(D%NIB:D%NIE,D%NJB:D%NJE,D%NKTB:D%NKTE)<PTSTEP))
!
!*** 4.4 Unpacking for budgets
!
- IF(BUCONF%LBU_ENABLE) THEN
+ IF(BUCONF%LBU_ENABLE .OR. OELEC) THEN
ZTOT_RR_CVRC(:,:,:) = ZTOT_RR_CVRC(:,:,:) + Z_RR_CVRC(:,:,:)
ZTOT_CR_CVRC(:,:,:) = ZTOT_CR_CVRC(:,:,:) + Z_CR_CVRC(:,:,:)
@@ -1469,20 +1731,20 @@ DO WHILE(ANY(ZTIME(D%NIB:D%NIE,D%NJB:D%NJE,D%NKTB:D%NKTE)<PTSTEP))
ZTOT_TH_BERFI(I1(II),I2(II),I3(II))= ZTOT_TH_BERFI(I1(II),I2(II),I3(II)) + Z_TH_BERFI(II) * ZMAXTIME(II)
ZTOT_RC_BERFI(I1(II),I2(II),I3(II))= ZTOT_RC_BERFI(I1(II),I2(II),I3(II)) + Z_RC_BERFI(II) * ZMAXTIME(II)
ZTOT_TH_RIM(I1(II),I2(II),I3(II)) = ZTOT_TH_RIM(I1(II),I2(II),I3(II)) + Z_TH_RIM(II) * ZMAXTIME(II)
- ZTOT_RC_RIM(I1(II),I2(II),I3(II)) = ZTOT_RC_RIM(I1(II),I2(II),I3(II)) + Z_RC_RIM(II) * ZMAXTIME(II)
ZTOT_CC_RIM(I1(II),I2(II),I3(II)) = ZTOT_CC_RIM(I1(II),I2(II),I3(II)) + Z_CC_RIM(II) * ZMAXTIME(II)
- ZTOT_RS_RIM(I1(II),I2(II),I3(II)) = ZTOT_RS_RIM(I1(II),I2(II),I3(II)) + Z_RS_RIM(II) * ZMAXTIME(II)
ZTOT_CS_RIM(I1(II),I2(II),I3(II)) = ZTOT_CS_RIM(I1(II),I2(II),I3(II)) + Z_CS_RIM(II) * ZMAXTIME(II)
- ZTOT_RG_RIM(I1(II),I2(II),I3(II)) = ZTOT_RG_RIM(I1(II),I2(II),I3(II)) + Z_RG_RIM(II) * ZMAXTIME(II)
+ ZTOT_RC_RIMSS(I1(II),I2(II),I3(II))= ZTOT_RC_RIMSS(I1(II),I2(II),I3(II)) + Z_RC_RIMSS(II) * ZMAXTIME(II)
+ ZTOT_RC_RIMSG(I1(II),I2(II),I3(II))= ZTOT_RC_RIMSG(I1(II),I2(II),I3(II)) + Z_RC_RIMSG(II) * ZMAXTIME(II)
+ ZTOT_RS_RIMCG(I1(II),I2(II),I3(II))= ZTOT_RS_RIMCG(I1(II),I2(II),I3(II)) + Z_RS_RIMCG(II) * ZMAXTIME(II)
ZTOT_RI_HMS(I1(II),I2(II),I3(II)) = ZTOT_RI_HMS(I1(II),I2(II),I3(II)) + Z_RI_HMS(II) * ZMAXTIME(II)
ZTOT_CI_HMS(I1(II),I2(II),I3(II)) = ZTOT_CI_HMS(I1(II),I2(II),I3(II)) + Z_CI_HMS(II) * ZMAXTIME(II)
ZTOT_RS_HMS(I1(II),I2(II),I3(II)) = ZTOT_RS_HMS(I1(II),I2(II),I3(II)) + Z_RS_HMS(II) * ZMAXTIME(II)
ZTOT_TH_ACC(I1(II),I2(II),I3(II)) = ZTOT_TH_ACC(I1(II),I2(II),I3(II)) + Z_TH_ACC(II) * ZMAXTIME(II)
- ZTOT_RR_ACC(I1(II),I2(II),I3(II)) = ZTOT_RR_ACC(I1(II),I2(II),I3(II)) + Z_RR_ACC(II) * ZMAXTIME(II)
ZTOT_CR_ACC(I1(II),I2(II),I3(II)) = ZTOT_CR_ACC(I1(II),I2(II),I3(II)) + Z_CR_ACC(II) * ZMAXTIME(II)
- ZTOT_RS_ACC(I1(II),I2(II),I3(II)) = ZTOT_RS_ACC(I1(II),I2(II),I3(II)) + Z_RS_ACC(II) * ZMAXTIME(II)
ZTOT_CS_ACC(I1(II),I2(II),I3(II)) = ZTOT_CS_ACC(I1(II),I2(II),I3(II)) + Z_CS_ACC(II) * ZMAXTIME(II)
- ZTOT_RG_ACC(I1(II),I2(II),I3(II)) = ZTOT_RG_ACC(I1(II),I2(II),I3(II)) + Z_RG_ACC(II) * ZMAXTIME(II)
+ ZTOT_RR_ACCSS(I1(II),I2(II),I3(II))= ZTOT_RR_ACCSS(I1(II),I2(II),I3(II)) + Z_RR_ACCSS(II) * ZMAXTIME(II)
+ ZTOT_RR_ACCSG(I1(II),I2(II),I3(II))= ZTOT_RR_ACCSG(I1(II),I2(II),I3(II)) + Z_RR_ACCSG(II) * ZMAXTIME(II)
+ ZTOT_RS_ACCRG(I1(II),I2(II),I3(II))= ZTOT_RS_ACCRG(I1(II),I2(II),I3(II)) + Z_RS_ACCRG(II) * ZMAXTIME(II)
ZTOT_CS_CMEL(I1(II),I2(II),I3(II)) = ZTOT_CS_CMEL(I1(II),I2(II),I3(II)) + Z_CS_CMEL(II) * ZMAXTIME(II)
ZTOT_RS_CMEL(I1(II),I2(II),I3(II)) = ZTOT_RS_CMEL(I1(II),I2(II),I3(II)) + Z_RS_CMEL(II) * ZMAXTIME(II)
ZTOT_TH_CFRZ(I1(II),I2(II),I3(II)) = ZTOT_TH_CFRZ(I1(II),I2(II),I3(II)) + Z_TH_CFRZ(II) * ZMAXTIME(II)
@@ -1544,14 +1806,14 @@ DO WHILE(ANY(ZTIME(D%NIB:D%NIE,D%NJB:D%NJE,D%NKTB:D%NKTE)<PTSTEP))
ZTOT_CR_HMLT(I1(II),I2(II),I3(II)) = ZTOT_CR_HMLT(I1(II),I2(II),I3(II)) + Z_CR_HMLT(II) * ZMAXTIME(II)
ZTOT_CH_HMLT(I1(II),I2(II),I3(II)) = ZTOT_CH_HMLT(I1(II),I2(II),I3(II)) + Z_CH_HMLT(II) * ZMAXTIME(II)
- !Correction term
- ZTOT_RV_CORR2(I1(II),I2(II),I3(II)) = ZTOT_RV_CORR2(I1(II),I2(II),I3(II)) + Z_RV_CORR2(II)
- ZTOT_RC_CORR2(I1(II),I2(II),I3(II)) = ZTOT_RC_CORR2(I1(II),I2(II),I3(II)) + Z_RC_CORR2(II)
- ZTOT_RR_CORR2(I1(II),I2(II),I3(II)) = ZTOT_RR_CORR2(I1(II),I2(II),I3(II)) + Z_RR_CORR2(II)
- ZTOT_RI_CORR2(I1(II),I2(II),I3(II)) = ZTOT_RI_CORR2(I1(II),I2(II),I3(II)) + Z_RI_CORR2(II)
- ZTOT_CC_CORR2(I1(II),I2(II),I3(II)) = ZTOT_CC_CORR2(I1(II),I2(II),I3(II)) + Z_CC_CORR2(II)
- ZTOT_CR_CORR2(I1(II),I2(II),I3(II)) = ZTOT_CR_CORR2(I1(II),I2(II),I3(II)) + Z_CR_CORR2(II)
- ZTOT_CI_CORR2(I1(II),I2(II),I3(II)) = ZTOT_CI_CORR2(I1(II),I2(II),I3(II)) + Z_CI_CORR2(II)
+ ! Correction term
+ ZTOT_RV_CORR2(I1(II),I2(II),I3(II)) = ZTOT_RV_CORR2(I1(II),I2(II),I3(II)) + Z_RV_CORR2(II)
+ ZTOT_RC_CORR2(I1(II),I2(II),I3(II)) = ZTOT_RC_CORR2(I1(II),I2(II),I3(II)) + Z_RC_CORR2(II)
+ ZTOT_RR_CORR2(I1(II),I2(II),I3(II)) = ZTOT_RR_CORR2(I1(II),I2(II),I3(II)) + Z_RR_CORR2(II)
+ ZTOT_RI_CORR2(I1(II),I2(II),I3(II)) = ZTOT_RI_CORR2(I1(II),I2(II),I3(II)) + Z_RI_CORR2(II)
+ ZTOT_CC_CORR2(I1(II),I2(II),I3(II)) = ZTOT_CC_CORR2(I1(II),I2(II),I3(II)) + Z_CC_CORR2(II)
+ ZTOT_CR_CORR2(I1(II),I2(II),I3(II)) = ZTOT_CR_CORR2(I1(II),I2(II),I3(II)) + Z_CR_CORR2(II)
+ ZTOT_CI_CORR2(I1(II),I2(II),I3(II)) = ZTOT_CI_CORR2(I1(II),I2(II),I3(II)) + Z_CI_CORR2(II)
END DO
ENDIF
!
@@ -1594,6 +1856,7 @@ DO WHILE(ANY(ZTIME(D%NIB:D%NIE,D%NJB:D%NJE,D%NKTB:D%NKTE)<PTSTEP))
DEALLOCATE(ZCF1D)
DEALLOCATE(ZIF1D)
DEALLOCATE(ZPF1D)
+ DEALLOCATE(ZLATHAM_IAGGS)
!
DEALLOCATE(ZMAXTIME)
DEALLOCATE(ZTIME_THRESHOLD)
@@ -1665,20 +1928,20 @@ DO WHILE(ANY(ZTIME(D%NIB:D%NIE,D%NJB:D%NJE,D%NKTB:D%NKTE)<PTSTEP))
DEALLOCATE(Z_TH_BERFI)
DEALLOCATE(Z_RC_BERFI)
DEALLOCATE(Z_TH_RIM)
- DEALLOCATE(Z_RC_RIM)
DEALLOCATE(Z_CC_RIM)
- DEALLOCATE(Z_RS_RIM)
DEALLOCATE(Z_CS_RIM)
- DEALLOCATE(Z_RG_RIM)
+ DEALLOCATE(Z_RC_RIMSS)
+ DEALLOCATE(Z_RC_RIMSG)
+ DEALLOCATE(Z_RS_RIMCG)
DEALLOCATE(Z_RI_HMS)
DEALLOCATE(Z_CI_HMS)
- DEALLOCATE(Z_RS_HMS)
+ DEALLOCATE(Z_RS_HMS)
DEALLOCATE(Z_TH_ACC)
- DEALLOCATE(Z_RR_ACC)
DEALLOCATE(Z_CR_ACC)
- DEALLOCATE(Z_RS_ACC)
DEALLOCATE(Z_CS_ACC)
- DEALLOCATE(Z_RG_ACC)
+ DEALLOCATE(Z_RR_ACCSS)
+ DEALLOCATE(Z_RR_ACCSG)
+ DEALLOCATE(Z_RS_ACCRG)
DEALLOCATE(Z_CS_CMEL)
DEALLOCATE(Z_RS_CMEL)
DEALLOCATE(Z_TH_CFRZ)
@@ -1753,6 +2016,182 @@ ENDDO
!
!-------------------------------------------------------------------------------
!
+!* 7. CLOUD ELECTRIFICATION
+! ---------------------
+!
+!* 7.1 Packing variables
+! -----------------
+!
+IF (OELEC) THEN
+ ALLOCATE(GMASK_ELEC(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3)))
+ GMASK_ELEC(:,:,:) = .FALSE.
+ GMASK_ELEC(:,:,:) = ZTOT_RI_HIND(:,:,:) .NE. 0. .OR. ZTOT_RR_HONR(:,:,:) .NE. 0. .OR. &
+ ZTOT_RC_IMLT(:,:,:) .NE. 0. .OR. ZTOT_RC_HONC(:,:,:) .NE. 0. .OR. &
+ ZTOT_RS_DEPS(:,:,:) .NE. 0. .OR. ZTOT_RI_AGGS(:,:,:) .NE. 0. .OR. &
+ ZTOT_RI_CNVS(:,:,:) .NE. 0. .OR. ZTOT_RG_DEPG(:,:,:) .NE. 0. .OR. &
+ ZTOT_RC_AUTO(:,:,:) .NE. 0. .OR. ZTOT_RC_ACCR(:,:,:) .NE. 0. .OR. &
+ ZTOT_RR_EVAP(:,:,:) .NE. 0. .OR. ZTOT_RC_RIMSS(:,:,:) .NE. 0. .OR. &
+ ZTOT_RC_RIMSG(:,:,:) .NE. 0. .OR. ZTOT_RS_RIMCG(:,:,:) .NE. 0. .OR. &
+ ZTOT_RR_ACCSS(:,:,:) .NE. 0. .OR. ZTOT_RR_ACCSG(:,:,:) .NE. 0. .OR. &
+ ZTOT_RS_ACCRG(:,:,:) .NE. 0. .OR. ZTOT_RS_CMEL(:,:,:) .NE. 0. .OR. &
+ ZTOT_RR_CFRZ(:,:,:) .NE. 0. .OR. ZTOT_RI_CFRZ(:,:,:) .NE. 0. .OR. &
+ ZTOT_RI_CIBU(:,:,:) .NE. 0. .OR. ZTOT_RI_RDSF(:,:,:) .NE. 0. .OR. &
+ ZTOT_RC_WETG(:,:,:) .NE. 0. .OR. ZTOT_RI_WETG(:,:,:) .NE. 0. .OR. &
+ ZTOT_RR_WETG(:,:,:) .NE. 0. .OR. ZTOT_RS_WETG(:,:,:) .NE. 0. .OR. &
+ ZTOT_RC_DRYG(:,:,:) .NE. 0. .OR. ZTOT_RI_DRYG(:,:,:) .NE. 0. .OR. &
+ ZTOT_RR_DRYG(:,:,:) .NE. 0. .OR. ZTOT_RS_DRYG(:,:,:) .NE. 0. .OR. &
+ ZTOT_RH_WETG(:,:,:) .NE. 0. .OR. ZTOT_RR_GMLT(:,:,:) .NE. 0. .OR. &
+ ZTOT_RC_BERFI(:,:,:) .NE. 0. .OR. ZTOT_RV_HENU(:,:,:) .NE. 0. .OR. &
+ ZTOT_RC_HINC(:,:,:) .NE. 0. .OR. ZTOT_RV_HONH(:,:,:) .NE. 0. .OR. &
+ ZTOT_RR_CVRC(:,:,:) .NE. 0. .OR. ZTOT_RI_CNVI(:,:,:) .NE. 0. .OR. &
+ ZTOT_RI_DEPI(:,:,:) .NE. 0. .OR. ZTOT_RI_HMS(:,:,:) .NE. 0. .OR. &
+ ZTOT_RI_HMG(:,:,:) .NE. 0. .OR. ZTOT_RC_CORR2(:,:,:) .NE. 0. .OR. &
+ ZTOT_RR_CORR2(:,:,:) .NE. 0. .OR. ZTOT_RI_CORR2(:,:,:) .NE. 0.
+ IF (NMOM_H .GE. 1) &
+ GMASK_ELEC(:,:,:) = GMASK_ELEC(:,:,:) .OR. &
+ ZTOT_RC_WETH(:,:,:) .NE. 0. .OR. ZTOT_RI_WETH(:,:,:) .NE. 0. .OR. &
+ ZTOT_RS_WETH(:,:,:) .NE. 0. .OR. ZTOT_RG_WETH(:,:,:) .NE. 0. .OR. &
+ ZTOT_RR_WETH(:,:,:) .NE. 0. .OR. &
+ !ZTOT_RC_DRYH(:,:,:) .NE. 0. .OR. ZTOT_RI_DRYH(:,:,:) .NE. 0. .OR. &
+ !ZTOT_RS_DRYH(:,:,:) .NE. 0. .OR. ZTOT_RR_DRYH(:,:,:) .NE. 0. .OR. &
+ !ZTOT_RG_DRYH(:,:,:) .NE. 0. .OR. &
+ ZTOT_RG_COHG(:,:,:) .NE. 0. .OR. ZTOT_RR_HMLT(:,:,:) .NE. 0.
+ !
+ IELEC = COUNT(GMASK_ELEC)
+ !
+!
+!* 7.2 Cloud electrification:
+! ---------------------
+!
+! Attention, les signes des tendances ne sont pas traites de la meme facon dans ice3 et lima
+! On se cale sur la facon de faire dans ice3 => on fait en sorte que les tendances soient positives
+ IF (NMOM_H .GE. 1) THEN
+ CALL ELEC_TENDENCIES(D, KRR, IELEC, PTSTEP, GMASK_ELEC, &
+ PRHODREF, PRHODJ, ZT, ZCIT_ELEC, &
+ ZRVT_ELEC, ZRCT_ELEC, ZRRT_ELEC, ZRIT_ELEC, ZRST_ELEC, ZRGT_ELEC, &
+ ZQPIT, ZQCT, ZQRT, ZQIT, ZQST, ZQGT, ZQNIT, &
+ ZQPIS, ZQCS, ZQRS, ZQIS, ZQSS, ZQGS, ZQNIS, &
+ ZTOT_RI_HIND*ZINV_TSTEP, -ZTOT_RR_HONR*ZINV_TSTEP, ZTOT_RC_IMLT*ZINV_TSTEP, &
+ -ZTOT_RC_HONC*ZINV_TSTEP, ZTOT_RS_DEPS*ZINV_TSTEP, -ZTOT_RI_AGGS*ZINV_TSTEP, &
+ -ZTOT_RI_CNVS*ZINV_TSTEP, ZTOT_RG_DEPG*ZINV_TSTEP, -ZTOT_RC_AUTO*ZINV_TSTEP, &
+ -ZTOT_RC_ACCR*ZINV_TSTEP, -ZTOT_RR_EVAP*ZINV_TSTEP, &
+ ZTOT_RC_RIMSS*ZINV_TSTEP, ZTOT_RC_RIMSG*ZINV_TSTEP, ZTOT_RS_RIMCG*ZINV_TSTEP,&
+ ZTOT_RR_ACCSS*ZINV_TSTEP, ZTOT_RR_ACCSG*ZINV_TSTEP, ZTOT_RS_ACCRG*ZINV_TSTEP,&
+ -ZTOT_RS_CMEL*ZINV_TSTEP, -ZTOT_RI_CFRZ*ZINV_TSTEP, -ZTOT_RR_CFRZ*ZINV_TSTEP, &
+ -ZTOT_RC_WETG*ZINV_TSTEP, -ZTOT_RI_WETG*ZINV_TSTEP, -ZTOT_RR_WETG*ZINV_TSTEP, &
+ -ZTOT_RS_WETG*ZINV_TSTEP, &
+ -ZTOT_RC_DRYG*ZINV_TSTEP, -ZTOT_RI_DRYG*ZINV_TSTEP, -ZTOT_RR_DRYG*ZINV_TSTEP, &
+ -ZTOT_RS_DRYG*ZINV_TSTEP, &
+ ZTOT_RR_GMLT*ZINV_TSTEP, -ZTOT_RC_BERFI*ZINV_TSTEP, &
+! variables et processus optionnels propres a la grele : pas encore teste
+ PRWETGH=ZTOT_RH_WETG*ZINV_TSTEP, &
+ PRCWETH=ZTOT_RC_WETH, PRIWETH=ZTOT_RI_WETH, PRSWETH=ZTOT_RS_WETH, &
+ PRGWETH=ZTOT_RG_WETH, PRRWETH=ZTOT_RR_WETH, &
+! PRCDRYH=ZTOT_RC_DRYH, PRIDRYH=ZTOT_RI_DRYH, PRSDRYH=ZTOT_RS_DRYH, &
+! PRRDRYH=ZTOT_RR_DRYH, PRGDRYH=ZTOT_RG_DRYH, &
+ PRDRYHG=ZTOT_RG_COHG, PRHMLTR=ZTOT_RR_HMLT, &
+ PRHT=ZRHT, PRHS=ZRHS, PQHT=ZQHT, PQHS=ZQHS, PCHT=ZCHT, &
+! variables et processus optionnels propres a lima
+ PCCT=ZCCT_ELEC, PCRT=ZCRT_ELEC, PCST=ZCST_ELEC, PCGT=ZCGT_ELEC, &
+ PRVHENC=ZTOT_RV_HENU*ZINV_TSTEP, PRCHINC=-ZTOT_RC_HINC*ZINV_TSTEP, &
+ PRVHONH=-ZTOT_RV_HONH*ZINV_TSTEP, PRRCVRC=-ZTOT_RR_CVRC*ZINV_TSTEP, &
+ PRICNVI=ZTOT_RI_CNVI*ZINV_TSTEP, PRVDEPI=ZTOT_RI_DEPI*ZINV_TSTEP, &
+ PRSHMSI=ZTOT_RI_HMS*ZINV_TSTEP, PRGHMGI=ZTOT_RI_HMG*ZINV_TSTEP, &
+ PRICIBU=ZTOT_RI_CIBU*ZINV_TSTEP, PRIRDSF=ZTOT_RI_RDSF*ZINV_TSTEP, &
+ PRCCORR2=-ZTOT_RC_CORR2*ZINV_TSTEP, PRRCORR2=-ZTOT_RR_CORR2*ZINV_TSTEP, &
+ PRICORR2=-ZTOT_RI_CORR2*ZINV_TSTEP)
+ ELSE
+ CALL ELEC_TENDENCIES(D, KRR, IELEC, PTSTEP, GMASK_ELEC, &
+ PRHODREF, PRHODJ, ZT, ZCIT_ELEC, &
+ ZRVT_ELEC, ZRCT_ELEC, ZRRT_ELEC, ZRIT_ELEC, ZRST_ELEC, ZRGT_ELEC, &
+ ZQPIT, ZQCT, ZQRT, ZQIT, ZQST, ZQGT, ZQNIT, &
+ ZQPIS, ZQCS, ZQRS, ZQIS, ZQSS, ZQGS, ZQNIS, &
+ ZTOT_RI_HIND*ZINV_TSTEP, -ZTOT_RR_HONR*ZINV_TSTEP, ZTOT_RC_IMLT*ZINV_TSTEP, &
+ -ZTOT_RC_HONC*ZINV_TSTEP, ZTOT_RS_DEPS*ZINV_TSTEP, -ZTOT_RI_AGGS*ZINV_TSTEP, &
+ -ZTOT_RI_CNVS*ZINV_TSTEP, ZTOT_RG_DEPG*ZINV_TSTEP, -ZTOT_RC_AUTO*ZINV_TSTEP, &
+ -ZTOT_RC_ACCR*ZINV_TSTEP, -ZTOT_RR_EVAP*ZINV_TSTEP, &
+ ZTOT_RC_RIMSS*ZINV_TSTEP, ZTOT_RC_RIMSG*ZINV_TSTEP, ZTOT_RS_RIMCG*ZINV_TSTEP,&
+ ZTOT_RR_ACCSS*ZINV_TSTEP, ZTOT_RR_ACCSG*ZINV_TSTEP, ZTOT_RS_ACCRG*ZINV_TSTEP,&
+ -ZTOT_RS_CMEL*ZINV_TSTEP, -ZTOT_RI_CFRZ*ZINV_TSTEP, -ZTOT_RR_CFRZ*ZINV_TSTEP, &
+ -ZTOT_RC_WETG*ZINV_TSTEP, -ZTOT_RI_WETG*ZINV_TSTEP, -ZTOT_RR_WETG*ZINV_TSTEP, &
+ -ZTOT_RS_WETG*ZINV_TSTEP, &
+ -ZTOT_RC_DRYG*ZINV_TSTEP, -ZTOT_RI_DRYG*ZINV_TSTEP, -ZTOT_RR_DRYG*ZINV_TSTEP, &
+ -ZTOT_RS_DRYG*ZINV_TSTEP, &
+ ZTOT_RR_GMLT*ZINV_TSTEP, -ZTOT_RC_BERFI*ZINV_TSTEP, &
+! variables et processus optionnels propres a lima
+ PCCT=ZCCT, PCRT=ZCRT, PCST=ZCST, PCGT=ZCGT, &
+ PRVHENC=ZTOT_RV_HENU*ZINV_TSTEP, PRCHINC=-ZTOT_RC_HINC*ZINV_TSTEP, &
+ PRVHONH=-ZTOT_RV_HONH*ZINV_TSTEP, PRRCVRC=-ZTOT_RR_CVRC*ZINV_TSTEP, &
+ PRICNVI=ZTOT_RI_CNVI*ZINV_TSTEP, PRVDEPI=ZTOT_RI_DEPI*ZINV_TSTEP, &
+ PRSHMSI=ZTOT_RI_HMS*ZINV_TSTEP, PRGHMGI=ZTOT_RI_HMG*ZINV_TSTEP, &
+ PRICIBU=ZTOT_RI_CIBU*ZINV_TSTEP, PRIRDSF=ZTOT_RI_RDSF*ZINV_TSTEP, &
+ PRCCORR2=-ZTOT_RC_CORR2*ZINV_TSTEP, PRRCORR2=-ZTOT_RR_CORR2*ZINV_TSTEP, &
+ PRICORR2=-ZTOT_RI_CORR2*ZINV_TSTEP)
+ END IF
+ !
+ ! update the source variables
+ PSV_ELEC_S(:,:,:,1) = ZQPIS(:,:,:)
+ PSV_ELEC_S(:,:,:,2) = ZQCS(:,:,:)
+ PSV_ELEC_S(:,:,:,3) = ZQRS(:,:,:)
+ PSV_ELEC_S(:,:,:,4) = ZQIS(:,:,:)
+ PSV_ELEC_S(:,:,:,5) = ZQSS(:,:,:)
+ PSV_ELEC_S(:,:,:,6) = ZQGS(:,:,:)
+ IF (KRR == 6) THEN
+ PSV_ELEC_S(:,:,:,7) = ZQNIS(:,:,:)
+ ELSE IF (KRR == 7) THEN
+ PSV_ELEC_S(:,:,:,7) = ZQHS(:,:,:)
+ PSV_ELEC_S(:,:,:,8) = ZQNIS(:,:,:)
+ END IF
+ !
+ DEALLOCATE(GMASK_ELEC)
+ !
+ DEALLOCATE(ZQPIT)
+ DEALLOCATE(ZQNIT)
+ DEALLOCATE(ZQCT)
+ DEALLOCATE(ZQRT)
+ DEALLOCATE(ZQIT)
+ DEALLOCATE(ZQST)
+ DEALLOCATE(ZQGT)
+ IF (ALLOCATED(ZQHT)) DEALLOCATE(ZQHT)
+ DEALLOCATE(ZQPIS)
+ DEALLOCATE(ZQNIS)
+ DEALLOCATE(ZQCS)
+ DEALLOCATE(ZQRS)
+ DEALLOCATE(ZQIS)
+ DEALLOCATE(ZQSS)
+ DEALLOCATE(ZQGS)
+ IF (ALLOCATED(ZQHS)) DEALLOCATE(ZQHS)
+ !
+ DEALLOCATE(ZRVT_ELEC)
+ DEALLOCATE(ZRCT_ELEC)
+ DEALLOCATE(ZRRT_ELEC)
+ DEALLOCATE(ZRIT_ELEC)
+ DEALLOCATE(ZRST_ELEC)
+ DEALLOCATE(ZRGT_ELEC)
+ IF (ALLOCATED(ZRHT_ELEC)) DEALLOCATE(ZRHT_ELEC)
+ IF (ALLOCATED(ZCCT_ELEC)) DEALLOCATE(ZCCT_ELEC)
+ IF (ALLOCATED(ZCRT_ELEC)) DEALLOCATE(ZCRT_ELEC)
+ IF (ALLOCATED(ZCIT_ELEC)) DEALLOCATE(ZCIT_ELEC)
+ IF (ALLOCATED(ZCST_ELEC)) DEALLOCATE(ZCST_ELEC)
+ IF (ALLOCATED(ZCGT_ELEC)) DEALLOCATE(ZCGT_ELEC)
+ IF (ALLOCATED(ZCHT_ELEC)) DEALLOCATE(ZCHT_ELEC)
+ !
+END IF
+!
+DEALLOCATE(ZTOT_RI_HIND)
+DEALLOCATE(ZTOT_RC_HINC)
+DEALLOCATE(ZTOT_RV_HENU)
+DEALLOCATE(ZTOT_RV_HONH)
+!
+!
+!* 7.3 Unpacking variables
+! -------------------
+!
+! not necessary! the only variables needed in the following (PQxS) are already 3D
+!
+!
+!-------------------------------------------------------------------------------
+!
!* 7. TOTAL TENDENCIES
! ----------------
!
@@ -1826,7 +2265,9 @@ if ( BUCONF%lbu_enable ) then
call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RC), 'HONC', ztot_rc_honc (:, :, :) * zrhodjontstep(:, :, :) )
call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RC), 'IMLT', ztot_rc_imlt (:, :, :) * zrhodjontstep(:, :, :) )
call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RC), 'BERFI', ztot_rc_berfi(:, :, :) * zrhodjontstep(:, :, :) )
- call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RC), 'RIM', ztot_rc_rim (:, :, :) * zrhodjontstep(:, :, :) )
+! call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RC), 'RIM', ztot_rc_rim (:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RC), 'RIM', (ztot_rc_rimss(:, :, :) + ztot_rc_rimsg(:, :, :)) &
+ * zrhodjontstep(:, :, :) )
call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RC), 'WETG', ztot_rc_wetg (:, :, :) * zrhodjontstep(:, :, :) )
call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RC), 'DRYG', ztot_rc_dryg (:, :, :) * zrhodjontstep(:, :, :) )
call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RC), 'CVRC', -ztot_rr_cvrc (:, :, :) * zrhodjontstep(:, :, :) )
@@ -1839,7 +2280,9 @@ if ( BUCONF%lbu_enable ) then
call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RR), 'ACCR', -ztot_rc_accr(:, :, :) * zrhodjontstep(:, :, :) )
call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RR), 'REVA', ztot_rr_evap(:, :, :) * zrhodjontstep(:, :, :) )
call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RR), 'HONR', ztot_rr_honr(:, :, :) * zrhodjontstep(:, :, :) )
- call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RR), 'ACC', ztot_rr_acc (:, :, :) * zrhodjontstep(:, :, :) )
+! call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RR), 'ACC', ztot_rr_acc (:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RR), 'ACC', (ztot_rc_rimss(:, :, :) + ztot_rc_rimsg(:, :, :)) &
+ * zrhodjontstep(:, :, :) )
call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RR), 'CFRZ', ztot_rr_cfrz(:, :, :) * zrhodjontstep(:, :, :) )
call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RR), 'WETG', ztot_rr_wetg(:, :, :) * zrhodjontstep(:, :, :) )
call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RR), 'DRYG', ztot_rr_dryg(:, :, :) * zrhodjontstep(:, :, :) )
@@ -1874,9 +2317,13 @@ if ( BUCONF%lbu_enable ) then
call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RS), 'DEPS', ztot_rs_deps(:, :, :) * zrhodjontstep(:, :, :) )
call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RS), 'CNVS', -ztot_ri_cnvs(:, :, :) * zrhodjontstep(:, :, :) )
call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RS), 'AGGS', -ztot_ri_aggs(:, :, :) * zrhodjontstep(:, :, :) )
- call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RS), 'RIM', ztot_rs_rim (:, :, :) * zrhodjontstep(:, :, :) )
+! call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RS), 'RIM', ztot_rs_rim (:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RS), 'RIM', (-ztot_rc_rimss(:, :, :) - ztot_rs_rimcg(:, :, :)) &
+ * zrhodjontstep(:, :, :) )
call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RS), 'HMS', ztot_rs_hms (:, :, :) * zrhodjontstep(:, :, :) )
- call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RS), 'ACC', ztot_rs_acc (:, :, :) * zrhodjontstep(:, :, :) )
+! call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RS), 'ACC', ztot_rs_acc (:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RS), 'ACC', (ztot_rr_accss(:, :, :) - ztot_rs_accrg (:, :, :)) &
+ * zrhodjontstep(:, :, :) )
call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RS), 'CMEL', ztot_rs_cmel(:, :, :) * zrhodjontstep(:, :, :) )
call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RS), 'CIBU', -ztot_ri_cibu(:, :, :) * zrhodjontstep(:, :, :) )
call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RS), 'WETG', ztot_rs_wetg(:, :, :) * zrhodjontstep(:, :, :) )
@@ -1887,8 +2334,12 @@ if ( BUCONF%lbu_enable ) then
if ( BUCONF%lbudget_rg ) then
call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RG), 'HONR', -ztot_rr_honr(:, :, :) * zrhodjontstep(:, :, :) )
call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RG), 'DEPG', ztot_rg_depg(:, :, :) * zrhodjontstep(:, :, :) )
- call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RG), 'RIM', ztot_rg_rim (:, :, :) * zrhodjontstep(:, :, :) )
- call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RG), 'ACC', ztot_rg_acc (:, :, :) * zrhodjontstep(:, :, :) )
+! call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RG), 'RIM', ztot_rg_rim (:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RG), 'RIM', (-ztot_rc_rimsg(:, :, :) + ztot_rs_rimcg(:, :, :) ) &
+ * zrhodjontstep(:, :, :) )
+! call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RG), 'ACC', ztot_rg_acc (:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RG), 'ACC', (ztot_rr_accsg(:, :, :) + ztot_rs_accrg (:, :, :)) &
+ * zrhodjontstep(:, :, :) )
call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RG), 'CMEL', -ztot_rs_cmel(:, :, :) * zrhodjontstep(:, :, :) )
call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RG), 'CFRZ', ( -ztot_rr_cfrz(:, :, :) - ztot_ri_cfrz(:, :, :) ) &
* zrhodjontstep(:, :, :) )
diff --git a/src/PHYEX/micro/modd_elec_descr.f90 b/src/PHYEX/micro/modd_elec_descr.f90
index 82d346588cb8f8c435011290facd2b8c667f311f..24cdba934b55911b4d91d1a0da23427bd345a391 100644
--- a/src/PHYEX/micro/modd_elec_descr.f90
+++ b/src/PHYEX/micro/modd_elec_descr.f90
@@ -31,6 +31,8 @@
!! Helsdon-Farley (JGR, 1987, 5661-5675)
!! Add "Beard" effect via sedimentation process
!! J.-P. Pinty 25/10/13 Add "Latham" effect via aggregation process
+!! C. Barthe 05/07/23 New data structures for PHYEX - for sedimentation in ICE3
+!! + Remove unused variables
!!
!-------------------------------------------------------------------------------
!
@@ -90,30 +92,12 @@ REAL, DIMENSION(:), SAVE, ALLOCATABLE :: XQTMIN ! Min values allowed for the
! volumetric charge
REAL, DIMENSION(:) , ALLOCATABLE :: XRTMIN_ELEC ! Limit value of R where charge is available
!
-REAL, SAVE :: XCXR ! Exponent in the concentration-slope
REAL :: XEPSILON ! Dielectric permittivity of air (F/m)
REAL :: XECHARGE ! Elementary charge (C)
!
-! charge-diameter relationship : e_x and f_x in q_x=e_xD^f_x
-!
-REAL, DIMENSION(:), SAVE, ALLOCATABLE :: XEC, XER, XEI, XES, XEG, XEH ! e_x
-REAL, SAVE :: XFC, XFR, XFI, XFS, XFG, XFH ! f_x
-!
!
! parameters relative to electrification
!
-REAL :: XESR, & ! Mean collection efficiency for rain-aggregate,
- XEGR, & ! graupel_rain,
- XEGS ! graupel_snow
-REAL :: XDELTATMIN ! Minimum temperature gap between ZTT(:) and XQTC
-!
-REAL :: XQINDIV_C_CST, & !
- XQINDIV_R_CST, & !
- XQINDIV_I_CST, & ! Constants for the individual charge
- XQINDIV_I_EXP, & ! calculation
- XQINDIV_S_CST, & !
- XQINDIV_G_CST !
-!
REAL, SAVE :: XLBDAR_MAXE, & ! Max values allowed for the shape
XLBDAS_MAXE, & ! when computation of charge separation
XLBDAG_MAXE, & ! and of lightning neutralisation
@@ -175,4 +159,34 @@ LOGICAL :: LSEDIM_BEARD=.FALSE. ! .T.: to enable ELEC=>MICROPHYS via
LOGICAL :: LIAGGS_LATHAM=.FALSE. ! .T.: to enable ELEC=>MICROPHYS via
! ! ice aggregation rate
!
+! The following variables must be declared with a derived type to match with PHYEX requirements
+TYPE ELEC_DESCR_t
+ REAL :: XFC, XFR, XFI, XFS, XFG, XFH ! f_x in q_x = e_x D^f_x
+ REAL :: XCXR ! Exponent in the concentration-slope
+END TYPE ELEC_DESCR_t
+!
+TYPE(ELEC_DESCR_t), SAVE, TARGET :: ELEC_DESCR
+!
+REAL, POINTER :: XFC => NULL(), &
+ XFR => NULL(), &
+ XFI => NULL(), &
+ XFS => NULL(), &
+ XFG => NULL(), &
+ XFH => NULL(), &
+ XCXR => NULL()
+!
+CONTAINS
+!
+SUBROUTINE ELEC_DESCR_ASSOCIATE()
+ IMPLICIT NONE
+ !
+ XFC => ELEC_DESCR%XFC
+ XFR => ELEC_DESCR%XFR
+ XFI => ELEC_DESCR%XFI
+ XFS => ELEC_DESCR%XFS
+ XFG => ELEC_DESCR%XFG
+ XFH => ELEC_DESCR%XFH
+ XCXR => ELEC_DESCR%XCXR
+END SUBROUTINE ELEC_DESCR_ASSOCIATE
+!
END MODULE MODD_ELEC_DESCR
diff --git a/src/PHYEX/micro/mode_ice4_correct_negativities.f90 b/src/PHYEX/micro/mode_ice4_correct_negativities.f90
index cf569687e9cf6ddaac782d09e9f869eb0c5dde51..bb99a7cf1d25a40f136fb24824df880bf4863efe 100644
--- a/src/PHYEX/micro/mode_ice4_correct_negativities.f90
+++ b/src/PHYEX/micro/mode_ice4_correct_negativities.f90
@@ -6,24 +6,34 @@
MODULE MODE_ICE4_CORRECT_NEGATIVITIES
IMPLICIT NONE
CONTAINS
-SUBROUTINE ICE4_CORRECT_NEGATIVITIES(D, ICED, KRR, PRV, PRC, PRR, &
+ SUBROUTINE ICE4_CORRECT_NEGATIVITIES(D, ICED, KRR, PRV, PRC, PRR, &
&PRI, PRS, PRG, &
&PTH, PLVFACT, PLSFACT, PRH)
+ !SUBROUTINE ICE4_CORRECT_NEGATIVITIES(D, ICED, KRR, OELEC, PRV, PRC, PRR, &
+! &PRI, PRS, PRG, &
+! &PTH, PLVFACT, PLSFACT, PRH, &
+! &PQPI, PQC, PQR, PQI, PQS, PQG, PQNI, &
+! &PTH, PLVFACT, PLSFACT, PRH, PQH)
!
USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK
USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
USE MODD_RAIN_ICE_DESCR_n, ONLY: RAIN_ICE_DESCR_t
+!USE MODD_ELEC_DESCR, ONLY: XECHARGE
!
IMPLICIT NONE
!
TYPE(DIMPHYEX_t), INTENT(IN) :: D
TYPE(RAIN_ICE_DESCR_t), INTENT(IN) :: ICED
INTEGER, INTENT(IN) :: KRR
+!LOGICAL, INTENT(IN) :: OELEC
REAL, DIMENSION(D%NIJT, D%NKT), INTENT(INOUT) :: PRV, PRC, PRR, PRI, PRS, PRG, PTH
+!REAL, DIMENSION(D%NIJT, D%NKT), INTENT(INOUT) :: PQPI, PQC, PQR, PQI, PQS, PQG, PQNI
REAL, DIMENSION(D%NIJT, D%NKT), INTENT(IN) :: PLVFACT, PLSFACT
REAL, DIMENSION(D%NIJT, D%NKT), OPTIONAL, INTENT(INOUT) :: PRH
+!REAL, DIMENSION(D%NIJT, D%NKT), OPTIONAL, INTENT(INOUT) :: PQH
!
REAL :: ZW
+!REAL :: ZION, ZADD
INTEGER :: JIJ, JK, IKTB, IKTE, IIJB, IIJE
REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
@@ -43,32 +53,75 @@ DO JK = IKTB, IKTE
PRV(JIJ,JK)=PRV(JIJ,JK)+ZW
PTH(JIJ,JK)=PTH(JIJ,JK)-ZW*PLVFACT(JIJ,JK)
PRC(JIJ,JK)=PRC(JIJ,JK)-ZW
+!++cb-- pour l'elec, on peut eventuellement appeler une routine : ca evitera les pb avec xecharge ?
+! IF (OELEC .AND. ZW .LT. 0.) THEN
+! ZION = PQC(JIJ,JK) / XECHARGE
+! ZADD = 0.5 + SIGN(0.5, PQC(JIJ,JK))
+! PQPI(JIJ,JK) = PQPI(JIJ,JK) + ZADD * ZION
+! PQNI(JIJ,JK) = PQNI(JIJ,JK) + (1. - ZADD) * ZION
+! PQC(JIJ,JK) = 0.
+! END IF
ZW =PRR(JIJ,JK)-MAX(PRR(JIJ,JK), 0.)
PRV(JIJ,JK)=PRV(JIJ,JK)+ZW
PTH(JIJ,JK)=PTH(JIJ,JK)-ZW*PLVFACT(JIJ,JK)
PRR(JIJ,JK)=PRR(JIJ,JK)-ZW
+! IF (OELEC .AND. ZW .LT. 0.) THEN
+! ZION = PQR(JIJ,JK) / XECHARGE
+! ZADD = 0.5 + SIGN(0.5, PQR(JIJ,JK))
+! PQPI(JIJ,JK) = PQPI(JIJ,JK) + ZADD * ZION
+! PQNI(JIJ,JK) = PQNI(JIJ,JK) + (1. - ZADD) * ZION
+! PQR(JIJ,JK) = 0.
+! END IF
ZW =PRI(JIJ,JK)-MAX(PRI(JIJ,JK), 0.)
PRV(JIJ,JK)=PRV(JIJ,JK)+ZW
PTH(JIJ,JK)=PTH(JIJ,JK)-ZW*PLSFACT(JIJ,JK)
PRI(JIJ,JK)=PRI(JIJ,JK)-ZW
+! IF (OELEC .AND. ZW .LT. 0.) THEN
+! ZION = PQI(JIJ,JK) / XECHARGE
+! ZADD = 0.5 + SIGN(0.5, PQI(JIJ,JK))
+! PQPI(JIJ,JK) = PQPI(JIJ,JK) + ZADD * ZION
+! PQNI(JIJ,JK) = PQNI(JIJ,JK) + (1. - ZADD) * ZION
+! PQI(JIJ,JK) = 0.
+! END IF
ZW =PRS(JIJ,JK)-MAX(PRS(JIJ,JK), 0.)
PRV(JIJ,JK)=PRV(JIJ,JK)+ZW
PTH(JIJ,JK)=PTH(JIJ,JK)-ZW*PLSFACT(JIJ,JK)
PRS(JIJ,JK)=PRS(JIJ,JK)-ZW
+! IF (OELEC .AND. ZW .LT. 0.) THEN
+! ZION = PQS(JIJ,JK) / XECHARGE
+! ZADD = 0.5 + SIGN(0.5, PQS(JIJ,JK))
+! PQPI(JIJ,JK) = PQPI(JIJ,JK) + ZADD * ZION
+! PQNI(JIJ,JK) = PQNI(JIJ,JK) + (1. - ZADD) * ZION
+! PQS(JIJ,JK) = 0.
+! END IF
ZW =PRG(JIJ,JK)-MAX(PRG(JIJ,JK), 0.)
PRV(JIJ,JK)=PRV(JIJ,JK)+ZW
PTH(JIJ,JK)=PTH(JIJ,JK)-ZW*PLSFACT(JIJ,JK)
PRG(JIJ,JK)=PRG(JIJ,JK)-ZW
+! IF (OELEC .AND. ZW .LT. 0.) THEN
+! ZION = PQG(JIJ,JK) / XECHARGE
+! ZADD = 0.5 + SIGN(0.5, PQG(JIJ,JK))
+! PQPI(JIJ,JK) = PQPI(JIJ,JK) + ZADD * ZION
+! PQNI(JIJ,JK) = PQNI(JIJ,JK) + (1. - ZADD) * ZION
+! PQG(JIJ,JK) = 0.
+! END IF
IF(KRR==7) THEN
ZW =PRH(JIJ,JK)-MAX(PRH(JIJ,JK), 0.)
PRV(JIJ,JK)=PRV(JIJ,JK)+ZW
PTH(JIJ,JK)=PTH(JIJ,JK)-ZW*PLSFACT(JIJ,JK)
PRH(JIJ,JK)=PRH(JIJ,JK)-ZW
+! IF (OELEC .AND. ZW .LT. 0.) THEN
+! ZION = PQH(JIJ,JK) / XECHARGE
+! ZADD = 0.5 + SIGN(0.5, PQH(JIJ,JK))
+! PQPI(JIJ,JK) = PQPI(JIJ,JK) + ZADD * ZION
+! PQNI(JIJ,JK) = PQNI(JIJ,JK) + (1. - ZADD) * ZION
+! PQH(JIJ,JK) = 0.
+! END IF
ENDIF
! 2) deal with negative vapor mixing ratio
@@ -87,6 +140,13 @@ DO JK = IKTB, IKTE
PRV(JIJ,JK)=PRV(JIJ,JK)+ZW
PRR(JIJ,JK)=PRR(JIJ,JK)-ZW
PTH(JIJ,JK)=PTH(JIJ,JK)-ZW*PLVFACT(JIJ,JK)
+! IF (OELEC .AND. ZW .GT. 0.) THEN
+! ZION = PQR(JIJ,JK) / XECHARGE
+! ZADD = 0.5 + SIGN(0.5, PQG(JIJ,JK))
+! PQPI(JIJ,JK) = PQPI(JIJ,JK) + ZADD * ZION
+! PQNI(JIJ,JK) = PQNI(JIJ,JK) + (1. - ZADD) * ZION
+! PQR(JIJ,JK) = 0.
+! END IF
ZW=MIN(MAX(PRS(JIJ,JK), 0.), &
&MAX(ICED%XRTMIN(1)-PRV(JIJ,JK), 0.)) ! Quantity of rs to convert into rv
diff --git a/src/PHYEX/micro/mode_ice4_pack.f90 b/src/PHYEX/micro/mode_ice4_pack.f90
index 558f0ab52a7b1da958a7f4f89a8a0aabc022d474..8c334e752f0acf2e1b459e83f90394f8ee4f240d 100644
--- a/src/PHYEX/micro/mode_ice4_pack.f90
+++ b/src/PHYEX/micro/mode_ice4_pack.f90
@@ -8,7 +8,7 @@ IMPLICIT NONE
CONTAINS
SUBROUTINE ICE4_PACK(D, CST, PARAMI, ICEP, ICED, BUCONF, &
KPROMA, KSIZE, KSIZE2, &
- PTSTEP, KRR, ODMICRO, PEXN, &
+ PTSTEP, KRR, OSAVE_MICRO, ODMICRO, OELEC, PEXN, &
PRHODJ, PRHODREF, PEXNREF, PPABST, PCIT, PCLDFR, &
PHLC_HRC, PHLC_HCF, PHLI_HRI, PHLI_HCF, &
PTHS, PRVS, PRCS, PRRS, PRIS, PRSS, PRGS, &
@@ -17,7 +17,7 @@ SUBROUTINE ICE4_PACK(D, CST, PARAMI, ICEP, ICED, BUCONF, &
PRVHENI, PLVFACT, PLSFACT, &
PWR, &
TBUDGETS, KBUDGETS, &
- PRHS )
+ PMICRO_TEND, PLATHAM_IAGGS, PRHS )
! ######################################################################
!
!!**** * - compute the explicit microphysical sources
@@ -100,6 +100,8 @@ INTEGER, INTENT(IN) :: KSIZE
INTEGER, INTENT(IN) :: KSIZE2
REAL, INTENT(IN) :: PTSTEP ! Double Time step (single if cold start)
INTEGER, INTENT(IN) :: KRR ! Number of moist variable
+LOGICAL, INTENT(IN) :: OSAVE_MICRO ! If true, microphysical tendencies are saved
+LOGICAL, INTENT(IN) :: OELEC ! if true, cloud electricity is activated
LOGICAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: ODMICRO ! mask to limit computation
!
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PEXN ! Exner function
@@ -132,6 +134,11 @@ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PLSFACT
REAL, DIMENSION(D%NIJT,D%NKT,0:7), INTENT(INOUT) :: PWR
TYPE(TBUDGETDATA), DIMENSION(KBUDGETS), INTENT(INOUT) :: TBUDGETS
INTEGER, INTENT(IN) :: KBUDGETS
+REAL, DIMENSION(MERGE(D%NIJT,0,OSAVE_MICRO),MERGE(D%NKT,0,OSAVE_MICRO),MERGE(IBUNUM-IBUNUM_EXTRA,0,OSAVE_MICRO)), &
+ INTENT(INOUT) :: PMICRO_TEND ! Microphysical tendencies
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), &
+ INTENT(IN) :: PLATHAM_IAGGS ! E Function to simulate
+ ! enhancement of IAGGS
REAL, DIMENSION(D%NIJT,D%NKT), OPTIONAL, INTENT(INOUT) :: PRHS ! Hail m.r. source
!
!
@@ -172,6 +179,9 @@ REAL, DIMENSION(KPROMA, IBUNUM-IBUNUM_EXTRA) :: ZBU_SUM
REAL, DIMENSION(KPROMA,0:7) :: ZVART !Packed variables
REAL, DIMENSION(KSIZE2,0:7) :: ZEXTPK !To take into acount external tendencies inside the splitting
!
+!For retroaction of E on IAGGS
+REAL, DIMENSION(MERGE(KPROMA,0,OELEC)) :: ZLATHAM_IAGGS
+!
INTEGER, DIMENSION(KPROMA) :: I1,I2 ! Used to replace the COUNT and PACK intrinsics on variables
INTEGER, DIMENSION(KSIZE) :: I1TOT, I2TOT ! Used to replace the COUNT and PACK intrinsics
!
@@ -205,7 +215,7 @@ IF(PARAMI%LPACK_MICRO) THEN
! Another one would be to cut tendencies in 3 parts: before rainfr_vert, rainfr_vert, after rainfr_vert
ENDIF
!
- IF(BUCONF%LBU_ENABLE) THEN
+ IF(BUCONF%LBU_ENABLE .OR. OSAVE_MICRO) THEN
DO JV=1, IBUNUM-IBUNUM_EXTRA
ZBU_PACK(:, JV)=0.
ENDDO
@@ -285,6 +295,7 @@ IF(PARAMI%LPACK_MICRO) THEN
ZHLI_HCF(IC) = PHLI_HCF(JIJ, JK)
ZHLI_HRI(IC) = PHLI_HRI(JIJ, JK)
ENDIF
+ IF (OELEC) ZLATHAM_IAGGS(IC) = PLATHAM_IAGGS(JIJ, JK)
! Save indices for later usages:
I1(IC) = JIJ
I2(IC) = JK
@@ -323,14 +334,15 @@ IF(PARAMI%LPACK_MICRO) THEN
CALL ICE4_STEPPING(D, CST, PARAMI, ICEP, ICED, BUCONF, &
&LLSIGMA_RC, LL_AUCV_ADJU, GEXT_TEND, &
&KPROMA, IMICRO, LLMICRO, PTSTEP, &
- &KRR, &
+ &KRR, OSAVE_MICRO, OELEC, &
&ZEXN, ZRHODREF, I1, I2, &
&ZPRES, ZCF, ZSIGMA_RC, &
&ZCIT, &
&ZVART, &
&ZHLC_HCF, ZHLC_HRC, &
&ZHLI_HCF, ZHLI_HRI, PRAINFR, &
- &ZEXTPK, ZBU_SUM, ZRREVAV)
+ &ZEXTPK, ZBU_SUM, ZRREVAV, &
+ &ZLATHAM_IAGGS)
!
!* 6. UNPACKING
! ---------
@@ -350,7 +362,7 @@ IF(PARAMI%LPACK_MICRO) THEN
PWR(I1(JL),I2(JL),IRH)=ZVART(JL, IRH)
ENDIF
ENDDO
- IF(BUCONF%LBU_ENABLE) THEN
+ IF(BUCONF%LBU_ENABLE .OR. OSAVE_MICRO) THEN
DO JV=1, IBUNUM-IBUNUM_EXTRA
DO JL=1, IMICRO
ZBU_PACK(JMICRO+JL-1, JV) = ZBU_SUM(JL, JV)
@@ -432,17 +444,31 @@ ELSE ! PARAMI%LPACK_MICRO
CALL ICE4_STEPPING(D, CST, PARAMI, ICEP, ICED, BUCONF, &
&LLSIGMA_RC, LL_AUCV_ADJU, GEXT_TEND, &
&KSIZE, KSIZE, ODMICRO, PTSTEP, &
- &KRR, &
+ &KRR, OSAVE_MICRO, OELEC, &
&PEXN, PRHODREF, I1TOT, I2TOT, &
&PPABST, PCLDFR, ZSIGMA_RC, &
&PCIT, &
&PWR, &
&PHLC_HCF, PHLC_HRC, &
&PHLI_HCF, PHLI_HRI, PRAINFR, &
- &ZEXTPK, ZBU_PACK, PEVAP3D)
+ &ZEXTPK, ZBU_PACK, PEVAP3D, &
+ &ZLATHAM_IAGGS)
ENDIF ! PARAMI%LPACK_MICRO
!
+!
+!* 6. SAVE MICROPHYSICAL TENDENCIES USED BY OTHER PHYSICAL PARAMETERIZATIONS
+! ----------------------------------------------------------------------
+!
+IF (OSAVE_MICRO) THEN
+ DO JV = 1, IBUNUM-IBUNUM_EXTRA
+ DO JL = 1, KSIZE
+ PMICRO_TEND(I1TOT(JL),I2TOT(JL),JV) = ZBU_PACK(JL,JV)
+ ENDDO
+ ENDDO
+END IF
+!
+!
!* 7. BUDGETS
! -------
!
diff --git a/src/PHYEX/micro/mode_ice4_sedimentation.f90 b/src/PHYEX/micro/mode_ice4_sedimentation.f90
index 0a59d64e3d9c0407b4738743b36e99728933bb1a..52d72c4e3e7ac0a51c50faf09f071ff1af79964d 100644
--- a/src/PHYEX/micro/mode_ice4_sedimentation.f90
+++ b/src/PHYEX/micro/mode_ice4_sedimentation.f90
@@ -6,14 +6,16 @@
MODULE MODE_ICE4_SEDIMENTATION
IMPLICIT NONE
CONTAINS
-SUBROUTINE ICE4_SEDIMENTATION(D, CST, ICEP, ICED, PARAMI, BUCONF, &
- &PTSTEP, KRR, PDZZ, &
+SUBROUTINE ICE4_SEDIMENTATION(D, CST, ICEP, ICED, PARAMI, ELECP, ELECD, BUCONF, &
+ &OELEC, OSEDIM_BEARD, PTSTEP, KRR, PDZZ, &
&PLVFACT, PLSFACT, PRHODREF, PPABST, PTHT, PT, PRHODJ, &
&PTHS, PRVS, PRCS, PRCT, PRRS, PRRT, PRIS, PRIT, PRSS, PRST, PRGS, PRGT,&
&PINPRC, PINPRR, PINPRS, PINPRG, &
+ &PQCT, PQRT, PQIT, PQST, PQGT, PQCS, PQRS, PQIS, PQSS, PQGS, PEFIELDW, &
&TBUDGETS, KBUDGETS, &
&PSEA, PTOWN, &
- &PINPRH, PRHT, PRHS, PFPR)
+ &PINPRH, PRHT, PRHS, PFPR, &
+ &PQHT, PQHS)
!!
!!** PURPOSE
!! -------
@@ -33,12 +35,15 @@ SUBROUTINE ICE4_SEDIMENTATION(D, CST, ICEP, ICED, PARAMI, BUCONF, &
!
USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK
USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
-USE MODD_BUDGET, ONLY: TBUDGETDATA, TBUDGETCONF_t, NBUDGET_RC, &
+USE MODD_BUDGET, ONLY: TBUDGETDATA, TBUDGETCONF_t, NBUDGET_RC, NBUDGET_SV1, &
NBUDGET_RI, NBUDGET_RR, NBUDGET_RS, NBUDGET_RG, NBUDGET_RH
USE MODD_CST, ONLY: CST_t
USE MODD_RAIN_ICE_DESCR_n, ONLY: RAIN_ICE_DESCR_t
USE MODD_RAIN_ICE_PARAM_n, ONLY: RAIN_ICE_PARAM_t
USE MODD_PARAM_ICE_n, ONLY: PARAM_ICE_t
+USE MODD_ELEC_DESCR, ONLY: ELEC_DESCR_t
+USE MODD_ELEC_PARAM, ONLY: ELEC_PARAM_t
+USE MODD_NSV, ONLY: NSV_ELECBEG
!
USE MODE_MSG, ONLY: PRINT_MSG, NVERB_FATAL
USE MODE_BUDGET_PHY, ONLY: BUDGET_STORE_INIT_PHY, BUDGET_STORE_END_PHY
@@ -57,7 +62,11 @@ TYPE(CST_t), INTENT(IN) :: CST
TYPE(RAIN_ICE_PARAM_t), INTENT(IN) :: ICEP
TYPE(RAIN_ICE_DESCR_t), INTENT(IN) :: ICED
TYPE(PARAM_ICE_t), INTENT(IN) :: PARAMI
+TYPE(ELEC_PARAM_t), INTENT(IN) :: ELECP ! electrical parameters
+TYPE(ELEC_DESCR_t), INTENT(IN) :: ELECD ! electrical descriptive csts
TYPE(TBUDGETCONF_t), INTENT(IN) :: BUCONF
+LOGICAL, INTENT(IN) :: OELEC ! switch to activate cloud electrification
+LOGICAL, INTENT(IN) :: OSEDIM_BEARD ! Switch for effect of electrical forces on sedim.
REAL, INTENT(IN) :: PTSTEP ! Double Time step (single if cold start)
INTEGER, INTENT(IN) :: KRR ! Number of moist variable
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PDZZ ! Layer thikness (m)
@@ -86,12 +95,33 @@ REAL, DIMENSION(D%NIJT), INTENT(OUT) :: PINPRS ! Snow ins
REAL, DIMENSION(D%NIJT), INTENT(OUT) :: PINPRG ! Graupel instant precip
TYPE(TBUDGETDATA), DIMENSION(KBUDGETS), INTENT(INOUT) :: TBUDGETS
INTEGER, INTENT(IN) :: KBUDGETS
+!
+! variables for cloud electricity
+!
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), INTENT(IN) :: PQCT ! Cloud droplet |
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), INTENT(IN) :: PQRT ! Rain | electric
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), INTENT(IN) :: PQIT ! Ice crystals | charge
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), INTENT(IN) :: PQST ! Snow | at t
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), INTENT(IN) :: PQGT ! Graupel |
+!
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), INTENT(INOUT) :: PQCS ! Cloud droplet |
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), INTENT(INOUT) :: PQRS ! Rain | electric
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), INTENT(INOUT) :: PQIS ! Ice crystals | charge
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), INTENT(INOUT) :: PQSS ! Snow | source
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), INTENT(INOUT) :: PQGS ! Graupel |
+!
+REAL, DIMENSION(MERGE(D%NIJT,0,OSEDIM_BEARD),MERGE(D%NKT,0,OSEDIM_BEARD)), INTENT(IN) :: PEFIELDW ! vert. E field
+!
+! optional variables
REAL, DIMENSION(D%NIJT), OPTIONAL, INTENT(IN) :: PSEA ! Sea Mask
REAL, DIMENSION(D%NIJT), OPTIONAL, INTENT(IN) :: PTOWN ! Fraction that is town
REAL, DIMENSION(D%NIJT), OPTIONAL, INTENT(OUT) :: PINPRH ! Hail instant precip
REAL, DIMENSION(D%NIJT,D%NKT), OPTIONAL, INTENT(IN) :: PRHT ! Hail m.r. at t
REAL, DIMENSION(D%NIJT,D%NKT), OPTIONAL, INTENT(INOUT) :: PRHS ! Hail m.r. source
REAL, DIMENSION(D%NIJT,D%NKT,KRR), OPTIONAL, INTENT(OUT) :: PFPR ! upper-air precipitation fluxes
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), OPTIONAL, INTENT(IN) :: PQHT ! Hail electric charge at t
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), OPTIONAL, INTENT(INOUT) :: PQHS ! Hail electric charge source
+!
!
!* 0.2 declaration of local variables
!
@@ -120,7 +150,17 @@ IF (BUCONF%LBUDGET_RI) CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDG
IF (BUCONF%LBUDGET_RS) CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RS), 'SEDI', PRSS(:, :) * PRHODJ(:, :))
IF (BUCONF%LBUDGET_RG) CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RG), 'SEDI', PRGS(:, :) * PRHODJ(:, :))
IF (BUCONF%LBUDGET_RH .AND. KRR==7) CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RH), 'SEDI', PRHS(:, :) * PRHODJ(:, :))
-
+!
+! budget of electric charges
+IF (BUCONF%LBUDGET_SV .AND. OELEC) THEN
+ IF (PARAMI%LSEDIC) CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_SV1-1+NSV_ELECBEG+1), 'SEDI', PQCS(:, :) * PRHODJ(:, :))
+ CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_SV1-1+NSV_ELECBEG+2), 'SEDI', PQRS(:, :) * PRHODJ(:, :))
+ CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_SV1-1+NSV_ELECBEG+3), 'SEDI', PQIS(:, :) * PRHODJ(:, :))
+ CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_SV1-1+NSV_ELECBEG+4), 'SEDI', PQSS(:, :) * PRHODJ(:, :))
+ CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_SV1-1+NSV_ELECBEG+5), 'SEDI', PQGS(:, :) * PRHODJ(:, :))
+ IF (KRR == 7) CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_SV1-1+NSV_ELECBEG+6), 'SEDI', PQHS(:, :) * PRHODJ(:, :))
+END IF
+!
IF(PARAMI%CSEDIM=='STAT') THEN
DO JK = IKTB,IKTE
DO JIJ = IIJB,IIJE
@@ -143,13 +183,16 @@ IF(PARAMI%CSEDIM=='STAT') THEN
PINPRS(:) = PINPRS(:) + ZINPRI(:)
!No negativity correction here as we apply sedimentation on PR.S*PTSTEP variables
ELSEIF(PARAMI%CSEDIM=='SPLI') THEN
- CALL ICE4_SEDIMENTATION_SPLIT(D, CST, ICEP, ICED, PARAMI, &
- &PTSTEP, KRR, PDZZ, &
+ CALL ICE4_SEDIMENTATION_SPLIT(D, CST, ICEP, ICED, PARAMI, ELECP, ELECD, &
+ &OELEC, OSEDIM_BEARD, PTSTEP, KRR, PDZZ, &
&PRHODREF, PPABST, PTHT, PT, PRHODJ, &
&PRCS, PRCT, PRRS, PRRT, PRIS, PRIT, PRSS, PRST, PRGS, PRGT,&
&PINPRC, PINPRR, ZINPRI, PINPRS, PINPRG, &
+ &PQCT, PQRT, PQIT, PQST, PQGT, PQCS, PQRS, PQIS, PQSS, PQGS, &
+ &PEFIELDW, &
&PSEA=PSEA, PTOWN=PTOWN, &
- &PINPRH=PINPRH, PRHT=PRHT, PRHS=PRHS, PFPR=PFPR)
+ &PINPRH=PINPRH, PRHT=PRHT, PRHS=PRHS, PFPR=PFPR, &
+ &PQHT=PQHT, PQHS=PQHS)
PINPRS(:) = PINPRS(:) + ZINPRI(:)
!We correct negativities with conservation
!SPLI algorith uses a time-splitting. Inside the loop a temporary m.r. is used.
@@ -161,9 +204,15 @@ ELSEIF(PARAMI%CSEDIM=='SPLI') THEN
! will be still active and will lead to negative values.
! We could prevent the algorithm to not consume too much a species, instead we apply
! a correction here.
+!++cb-- il faudrait faire la correction correspondante sur les charges electriques pour eviter de se retrouver
+! avec des points ou il y a de la charge mais pas de masse !
CALL ICE4_CORRECT_NEGATIVITIES(D, ICED, KRR, PRVS, PRCS, PRRS, &
&PRIS, PRSS, PRGS, &
&PTHS, PLVFACT, PLSFACT, PRHS)
+! CALL ICE4_CORRECT_NEGATIVITIES(D, ICED, KRR, PRVS, PRCS, PRRS, &
+! &PRIS, PRSS, PRGS, &
+! &PQPIS, PQCS, PQRS, PQIS, PQSS, PQGS, PQNIS, &
+! &PTHS, PLVFACT, PLSFACT, PRHS, PQHS)
ELSEIF(PARAMI%CSEDIM=='NONE') THEN
ELSE
CALL PRINT_MSG(NVERB_FATAL, 'GEN', 'RAIN_ICE', 'no sedimentation scheme for PARAMI%CSEDIM='//PARAMI%CSEDIM)
@@ -177,6 +226,16 @@ IF (BUCONF%LBUDGET_RS) CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGE
IF (BUCONF%LBUDGET_RG) CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_RG), 'SEDI', PRGS(:, :) * PRHODJ(:, :))
IF (BUCONF%LBUDGET_RH .AND. KRR==7) CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_RH), 'SEDI', PRHS(:, :) * PRHODJ(:, :))
!
+! Budget for electric charges
+IF (BUCONF%LBUDGET_SV .AND. OELEC) THEN
+ IF (PARAMI%LSEDIC) CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_SV1-1+NSV_ELECBEG+1), 'SEDI', PQCS(:, :) * PRHODJ(:, :))
+ CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_SV1-1+NSV_ELECBEG+2), 'SEDI', PQRS(:, :) * PRHODJ(:, :))
+ CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_SV1-1+NSV_ELECBEG+3), 'SEDI', PQIS(:, :) * PRHODJ(:, :))
+ CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_SV1-1+NSV_ELECBEG+4), 'SEDI', PQSS(:, :) * PRHODJ(:, :))
+ CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_SV1-1+NSV_ELECBEG+5), 'SEDI', PQGS(:, :) * PRHODJ(:, :))
+ IF (KRR == 7) CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_SV1-1+NSV_ELECBEG+6), 'SEDI', PQHS(:, :) * PRHODJ(:, :))
+END IF
+!
IF (LHOOK) CALL DR_HOOK('ICE4_SEDIMENTATION', 1, ZHOOK_HANDLE)
!
END SUBROUTINE ICE4_SEDIMENTATION
diff --git a/src/PHYEX/micro/mode_ice4_sedimentation_split.f90 b/src/PHYEX/micro/mode_ice4_sedimentation_split.f90
index b2ef8d05bda3cadc3cca8095a718c98e4f880adc..829cb2189c7c2a85a945f7338cec1380437451d2 100644
--- a/src/PHYEX/micro/mode_ice4_sedimentation_split.f90
+++ b/src/PHYEX/micro/mode_ice4_sedimentation_split.f90
@@ -6,13 +6,16 @@
MODULE MODE_ICE4_SEDIMENTATION_SPLIT
IMPLICIT NONE
CONTAINS
-SUBROUTINE ICE4_SEDIMENTATION_SPLIT(D, CST, ICEP, ICED, PARAMI, &
- &PTSTEP, KRR, PDZZ, &
+SUBROUTINE ICE4_SEDIMENTATION_SPLIT(D, CST, ICEP, ICED, PARAMI, ELECP, ELECD, &
+ &OELEC, OSEDIM_BEARD, PTSTEP, KRR, PDZZ, &
&PRHODREF, PPABST, PTHT, PT, PRHODJ, &
&PRCS, PRCT, PRRS, PRRT, PRIS, PRIT, PRSS, PRST, PRGS, PRGT,&
&PINPRC, PINPRR, PINPRI, PINPRS, PINPRG, &
+ &PQCT, PQRT, PQIT, PQST, PQGT, PQCS, PQRS, PQIS, PQSS, PQGS,&
+ &PEFIELDW, &
&PSEA, PTOWN, &
- &PINPRH, PRHT, PRHS, PFPR)
+ &PINPRH, PRHT, PRHS, PFPR, &
+ &PQHT, PQHS)
!!
!!** PURPOSE
!! -------
@@ -28,6 +31,7 @@ SUBROUTINE ICE4_SEDIMENTATION_SPLIT(D, CST, ICEP, ICED, PARAMI, &
!!
! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
! J. Wurtz 03/2022: New snow characteristics with LSNOW_T
+! C. Barthe 03/2023: Add sedimentation of electric charges
!
!
!* 0. DECLARATIONS
@@ -39,8 +43,11 @@ USE MODD_CST, ONLY: CST_t
USE MODD_RAIN_ICE_DESCR_n, ONLY: RAIN_ICE_DESCR_t
USE MODD_RAIN_ICE_PARAM_n, ONLY: RAIN_ICE_PARAM_t
USE MODD_PARAM_ICE_n, ONLY: PARAM_ICE_t
+USE MODD_ELEC_DESCR, ONLY: ELEC_DESCR_t
+USE MODD_ELEC_PARAM, ONLY: ELEC_PARAM_t
!
USE MODE_MSG, ONLY: PRINT_MSG, NVERB_FATAL
+USE MODE_ELEC_BEARD_EFFECT, ONLY: ELEC_BEARD_EFFECT
!
USE MODI_GAMMA, ONLY: GAMMA
!
@@ -48,13 +55,17 @@ IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
!
-TYPE(DIMPHYEX_t), INTENT(IN) :: D !array dimensions
-TYPE(CST_t), INTENT(IN) :: CST
-TYPE(RAIN_ICE_PARAM_t), INTENT(IN) :: ICEP
-TYPE(RAIN_ICE_DESCR_t), INTENT(IN) :: ICED
-TYPE(PARAM_ICE_t), INTENT(IN) :: PARAMI
-REAL, INTENT(IN) :: PTSTEP ! Double Time step (single if cold start)
-INTEGER, INTENT(IN) :: KRR ! Number of moist variable
+TYPE(DIMPHYEX_t), INTENT(IN) :: D !array dimensions
+TYPE(CST_t), INTENT(IN) :: CST
+TYPE(RAIN_ICE_PARAM_t), INTENT(IN) :: ICEP
+TYPE(RAIN_ICE_DESCR_t), INTENT(IN) :: ICED
+TYPE(PARAM_ICE_t), INTENT(IN) :: PARAMI
+TYPE(ELEC_PARAM_t), INTENT(IN) :: ELECP ! electrical parameters
+TYPE(ELEC_DESCR_t), INTENT(IN) :: ELECD ! electrical descriptive csts
+LOGICAL, INTENT(IN) :: OELEC ! if true, cloud electricity is activated
+LOGICAL, INTENT(IN) :: OSEDIM_BEARD ! if true, effect of electrical forces on sedim.
+REAL, INTENT(IN) :: PTSTEP ! Double Time step (single if cold start)
+INTEGER, INTENT(IN) :: KRR ! Number of moist variable
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PDZZ ! Layer thikness (m)
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRHODREF! Reference density
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PPABST ! absolute pressure at t
@@ -71,44 +82,62 @@ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT) :: PRSS ! Snow/aggrega
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT) :: PRGS ! Graupel m.r. source
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRGT ! Graupel/hail m.r. at t
-REAL, DIMENSION(D%NIJT), INTENT(OUT) :: PINPRC ! Cloud instant precip
-REAL, DIMENSION(D%NIJT), INTENT(OUT) :: PINPRR ! Rain instant precip
-REAL, DIMENSION(D%NIJT), INTENT(OUT) :: PINPRI ! Pristine ice instant precip
-REAL, DIMENSION(D%NIJT), INTENT(OUT) :: PINPRS ! Snow instant precip
-REAL, DIMENSION(D%NIJT), INTENT(OUT) :: PINPRG ! Graupel instant precip
-REAL, DIMENSION(D%NIJT), OPTIONAL, INTENT(IN) :: PSEA ! Sea Mask
-REAL, DIMENSION(D%NIJT), OPTIONAL, INTENT(IN) :: PTOWN ! Fraction that is town
-REAL, DIMENSION(D%NIJT), OPTIONAL, INTENT(OUT) :: PINPRH ! Hail instant precip
+REAL, DIMENSION(D%NIJT), INTENT(OUT) :: PINPRC ! Cloud instant precip
+REAL, DIMENSION(D%NIJT), INTENT(OUT) :: PINPRR ! Rain instant precip
+REAL, DIMENSION(D%NIJT), INTENT(OUT) :: PINPRI ! Pristine ice instant precip
+REAL, DIMENSION(D%NIJT), INTENT(OUT) :: PINPRS ! Snow instant precip
+REAL, DIMENSION(D%NIJT), INTENT(OUT) :: PINPRG ! Graupel instant precip
+REAL, DIMENSION(D%NIJT), OPTIONAL, INTENT(IN) :: PSEA ! Sea Mask
+REAL, DIMENSION(D%NIJT), OPTIONAL, INTENT(IN) :: PTOWN ! Fraction that is town
+REAL, DIMENSION(D%NIJT), OPTIONAL, INTENT(OUT) :: PINPRH ! Hail instant precip
REAL, DIMENSION(D%NIJT,D%NKT), OPTIONAL, INTENT(IN) :: PRHT ! Hail m.r. at t
REAL, DIMENSION(D%NIJT,D%NKT), OPTIONAL, INTENT(INOUT) :: PRHS ! Hail m.r. source
REAL, DIMENSION(D%NIJT,D%NKT,KRR), OPTIONAL, INTENT(OUT) :: PFPR ! upper-air precipitation fluxes
+! variables for cloud electricity
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), INTENT(IN) :: PQCT ! Cloud water electric charge at t
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), INTENT(IN) :: PQRT ! Rain water electric charge at t
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), INTENT(IN) :: PQIT ! Pristine ice electric charge at t
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), INTENT(IN) :: PQST ! Snow/aggregate electric charge at t
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), INTENT(IN) :: PQGT ! Graupel electric charge at t
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), OPTIONAL, INTENT(IN) :: PQHT ! Hail electric charge at t
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), INTENT(INOUT) :: PQCS ! Cloud water electric charge source
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), INTENT(INOUT) :: PQRS ! Rain water electric charge source
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), INTENT(INOUT) :: PQIS ! Pristine ice electric charge source
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), INTENT(INOUT) :: PQSS ! Snow/aggregate electric charge source
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), INTENT(INOUT) :: PQGS ! Graupel electric charge source
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), OPTIONAL, INTENT(INOUT) :: PQHS ! Hail electric charge source
+REAL, DIMENSION(MERGE(D%NIJT,0,OSEDIM_BEARD),MERGE(D%NKT,0,OSEDIM_BEARD)), INTENT(IN) :: PEFIELDW ! Vertical E field
!
!* 0.2 declaration of local variables
!
!
-INTEGER :: JIJ, JK
-INTEGER :: IKTB, IKTE, IIJE, IIJB
-INTEGER :: IRR !Workaround of PGI bug with OpenACC (at least up to 18.10 version)
-LOGICAL :: GSEDIC !Workaround of PGI bug with OpenACC (at least up to 18.10 version)
-LOGICAL :: GPRESENT_PFPR, GPRESENT_PSEA
-REAL :: ZINVTSTEP
-REAL, DIMENSION(D%NIJT) :: ZCONC_TMP ! Weighted concentration
-REAL, DIMENSION(D%NIJT,D%NKTB:D%NKTE) :: ZW ! work array
-REAL, DIMENSION(D%NIJT, D%NKT) :: ZCONC3D, & ! droplet condensation
- & ZRAY, & ! Cloud Mean radius
- & ZLBC, & ! XLBC weighted by sea fraction
- & ZFSEDC, &
- & ZPRCS,ZPRRS,ZPRIS,ZPRSS,ZPRGS,ZPRHS, & ! Mixing ratios created during the time step
- & ZRCT, &
- & ZRRT, &
- & ZRIT, &
- & ZRST, &
- & ZRGT, &
- & ZRHT
+INTEGER :: JIJ, JK
+INTEGER :: IKTB, IKTE, IKB, IKL, IIJE, IIJB
+INTEGER :: IRR !Workaround of PGI bug with OpenACC (at least up to 18.10 version)
+LOGICAL :: GSEDIC !Workaround of PGI bug with OpenACC (at least up to 18.10 version)
+LOGICAL :: GPRESENT_PFPR, GPRESENT_PSEA
+REAL :: ZINVTSTEP
+REAL, DIMENSION(D%NIJT) :: ZCONC_TMP ! Weighted concentration
+REAL, DIMENSION(D%NIJT,D%NKTB:D%NKTE) :: ZW ! work array
+REAL, DIMENSION(D%NIJT, D%NKT) :: ZCONC3D, & ! droplet condensation
+ & ZRAY, & ! Cloud Mean radius
+ & ZLBC, & ! XLBC weighted by sea fraction
+ & ZFSEDC, &
+ & ZPRCS,ZPRRS,ZPRIS,ZPRSS,ZPRGS,ZPRHS, & ! Mixing ratios created during the time step
+ & ZRCT, &
+ & ZRRT, &
+ & ZRIT, &
+ & ZRST, &
+ & ZRGT, &
+ & ZRHT
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)) :: &
+ ZQCT, ZQRT, ZQIT, ZQST, ZQGT, ZQHT, & ! electric charge a t
+ ZPQCS, ZPQRS, ZPQIS, ZPQSS, ZPQGS, ZPQHS ! electric charge created during the time step
REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------------
!
IF (LHOOK) CALL DR_HOOK('ICE4_SEDIMENTATION_SPLIT', 0, ZHOOK_HANDLE)
+
!-------------------------------------------------------------------------------
!
!
@@ -204,6 +233,23 @@ DO JK=IKTB, IKTE
END IF
!
ZW(JIJ,JK) =1./(PRHODREF(JIJ,JK)* PDZZ(JIJ,JK))
+ !
+ ! Cloud electricity
+ IF (OELEC) THEN
+ IF (GSEDIC) ZPQCS(JIJ,JK) = PQCS(JIJ,JK) - PQCT(JIJ,JK) * ZINVTSTEP
+ ZPQRS(JIJ,JK) = PQRS(JIJ,JK) - PQRT(JIJ,JK) * ZINVTSTEP
+ ZPQIS(JIJ,JK) = PQIS(JIJ,JK) - PQIT(JIJ,JK) * ZINVTSTEP
+ ZPQSS(JIJ,JK) = PQSS(JIJ,JK) - PQST(JIJ,JK) * ZINVTSTEP
+ ZPQGS(JIJ,JK) = PQGS(JIJ,JK) - PQGT(JIJ,JK) * ZINVTSTEP
+ IF (IRR==7) ZPQHS(JIJ,JK) = PQHS(JIJ,JK) - PQHT(JIJ,JK) * ZINVTSTEP
+ !
+ ZQCT(JIJ,JK) = PQCT(JIJ,JK)
+ ZQRT(JIJ,JK) = PQST(JIJ,JK)
+ ZQIT(JIJ,JK) = PQIT(JIJ,JK)
+ ZQST(JIJ,JK) = PQST(JIJ,JK)
+ ZQGT(JIJ,JK) = PQGT(JIJ,JK)
+ IF (IRR==7) ZQHT(JIJ,JK) = PQHT(JIJ,JK)
+ ENDIF
ENDDO
ENDDO
!
@@ -211,52 +257,65 @@ ENDDO
!* 2.1 for cloud
!
IF (GSEDIC) THEN
- CALL INTERNAL_SEDIM_SPLI(D, CST, ICEP, ICED, PARAMI, KRR, &
+ CALL INTERNAL_SEDIM_SPLI(D, CST, ICEP, ICED, PARAMI, ELECP, ELECD, &
+ &KRR, OELEC, OSEDIM_BEARD, &
&PRHODREF, ZW, PDZZ, PPABST, PTHT, PT, PTSTEP, &
&2, &
&ZRCT, PRCS, PINPRC, ZPRCS, &
- &ZRAY, ZLBC, ZFSEDC, ZCONC3D, PFPR=PFPR)
+ &ZQCT, PQCS, ZPQCS, PEFIELDW, &
+ &PRAY=ZRAY, PLBC=ZLBC, PFSEDC=ZFSEDC, PCONC3D=ZCONC3D, &
+ &PFPR=PFPR)
ENDIF
!
!* 2.2 for rain
!
- CALL INTERNAL_SEDIM_SPLI(D, CST, ICEP, ICED, PARAMI, KRR, &
+ CALL INTERNAL_SEDIM_SPLI(D, CST, ICEP, ICED, PARAMI, ELECP, ELECD, &
+ &KRR, OELEC, OSEDIM_BEARD, &
&PRHODREF, ZW, PDZZ, PPABST, PTHT, PT, PTSTEP, &
&3, &
&ZRRT, PRRS, PINPRR, ZPRRS, &
+ &ZQRT, PQRS, ZPQRS, PEFIELDW, &
&PFPR=PFPR)
!
!* 2.3 for pristine ice
!
- CALL INTERNAL_SEDIM_SPLI(D, CST, ICEP, ICED, PARAMI, KRR, &
+ CALL INTERNAL_SEDIM_SPLI(D, CST, ICEP, ICED, PARAMI, ELECP, ELECD, &
+ &KRR, OELEC, OSEDIM_BEARD, &
&PRHODREF, ZW, PDZZ, PPABST, PTHT, PT, PTSTEP, &
&4, &
&ZRIT, PRIS, PINPRI, ZPRIS, &
+ &ZQIT, PQIS, ZPQIS, PEFIELDW, &
&PFPR=PFPR)
!
!* 2.4 for aggregates/snow
!
- CALL INTERNAL_SEDIM_SPLI(D, CST, ICEP, ICED, PARAMI, KRR, &
+ CALL INTERNAL_SEDIM_SPLI(D, CST, ICEP, ICED, PARAMI, ELECP, ELECD, &
+ &KRR, OELEC, OSEDIM_BEARD, &
&PRHODREF, ZW, PDZZ, PPABST, PTHT, PT, PTSTEP, &
&5, &
&ZRST, PRSS, PINPRS, ZPRSS, &
+ &ZQST, PQSS, ZPQSS, PEFIELDW, &
&PFPR=PFPR)
!
!* 2.5 for graupeln
!
- CALL INTERNAL_SEDIM_SPLI(D, CST, ICEP, ICED, PARAMI, KRR, &
+ CALL INTERNAL_SEDIM_SPLI(D, CST, ICEP, ICED, PARAMI, ELECP, ELECD, &
+ &KRR, OELEC, OSEDIM_BEARD, &
&PRHODREF, ZW, PDZZ, PPABST, PTHT, PT, PTSTEP, &
&6, &
&ZRGT, PRGS, PINPRG, ZPRGS, &
+ &ZQGT, PQGS, ZPQGS, PEFIELDW, &
&PFPR=PFPR)
!
!* 2.6 for hail
!
IF (IRR==7) THEN
- CALL INTERNAL_SEDIM_SPLI(D, CST, ICEP, ICED, PARAMI, KRR, &
+ CALL INTERNAL_SEDIM_SPLI(D, CST, ICEP, ICED, PARAMI, ELECP, ELECD, &
+ &KRR, OELEC, OSEDIM_BEARD, &
&PRHODREF, ZW, PDZZ, PPABST, PTHT, PT, PTSTEP, &
&7, &
&ZRHT, PRHS, PINPRH, ZPRHS, &
+ &ZQHT, PQHS, ZPQHS, PEFIELDW, &
&PFPR=PFPR)
ENDIF
!
@@ -268,10 +327,12 @@ CONTAINS
!-------------------------------------------------------------------------------
!
!
-SUBROUTINE INTERNAL_SEDIM_SPLI(D, CST, ICEP, ICED, PARAMI, KRR, &
+SUBROUTINE INTERNAL_SEDIM_SPLI(D, CST, ICEP, ICED, PARAMI, ELECP, ELECD, &
+ &KRR, OELEC, OSEDIM_BEARD, &
&PRHODREF, POORHODZ, PDZZ, PPABST, PTHT, PT, PTSTEP, &
&KSPE, &
&PRXT, PRXS, PINPRX, PPRXS, &
+ &PQXT, PQXS, PPQXS, PEFIELDW, &
&PRAY, PLBC, PFSEDC, PCONC3D, PFPR)
!
!* 0. DECLARATIONS
@@ -282,6 +343,12 @@ USE MODD_RAIN_ICE_DESCR_n, ONLY: RAIN_ICE_DESCR_t
USE MODD_RAIN_ICE_PARAM_n, ONLY: RAIN_ICE_PARAM_t
USE MODD_PARAM_ICE_n, ONLY: PARAM_ICE_t
!
+! parameters for electricity
+USE MODD_ELEC_PARAM, ONLY: ELEC_PARAM_t
+USE MODD_ELEC_DESCR, ONLY: ELEC_DESCR_t
+!
+USE MODI_MOMG
+!
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
@@ -291,19 +358,28 @@ TYPE(CST_t), INTENT(IN) :: CST
TYPE(RAIN_ICE_PARAM_t), INTENT(IN) :: ICEP
TYPE(RAIN_ICE_DESCR_t), INTENT(IN) :: ICED
TYPE(PARAM_ICE_t), INTENT(IN) :: PARAMI
+TYPE(ELEC_PARAM_t), INTENT(IN) :: ELECP ! electrical parameters
+TYPE(ELEC_DESCR_t), INTENT(IN) :: ELECD ! electrical descriptive csts
INTEGER, INTENT(IN) :: KRR
-REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRHODREF ! Reference density
-REAL, DIMENSION(D%NIJT,D%NKTB:D%NKTE), INTENT(IN) :: POORHODZ ! One Over (Rhodref times delta Z)
-REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PDZZ ! layer thikness (m)
-REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PPABST
-REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PTHT
-REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PT
-REAL, INTENT(IN) :: PTSTEP ! total timestep
-INTEGER, INTENT(IN) :: KSPE ! 1 for rc, 2 for rr...
-REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT) :: PRXT ! mr of specy X
-REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT) :: PRXS !Tendency of the specy KSPE
-REAL, DIMENSION(D%NIJT), INTENT(OUT) :: PINPRX ! instant precip
-REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PPRXS ! external tendencie
+LOGICAL, INTENT(IN) :: OELEC ! if true, sedimentation of elec. charges
+LOGICAL, INTENT(IN) :: OSEDIM_BEARD ! if true, effect of electric forces on sedim.
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRHODREF ! Reference density
+REAL, DIMENSION(D%NIJT,D%NKTB:D%NKTE), INTENT(IN) :: POORHODZ ! One Over (Rhodref times delta Z)
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PDZZ ! layer thikness (m)
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PPABST
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PTHT
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PT
+REAL, INTENT(IN) :: PTSTEP ! total timestep
+INTEGER, INTENT(IN) :: KSPE ! 1 for rc, 2 for rr...
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT) :: PRXT ! mr of specy X
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT) :: PRXS !Tendency of the specy KSPE
+REAL, DIMENSION(D%NIJT), INTENT(OUT) :: PINPRX ! instant precip
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PPRXS ! external tendencie
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), INTENT(INOUT) :: PQXT ! electric charge at t for specy KSPE
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), INTENT(INOUT) :: PQXS ! tendency of the electric charge
+ ! for specy KSPE
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), INTENT(IN) :: PPQXS ! external tendency
+REAL, DIMENSION(MERGE(D%NIJT,0,OSEDIM_BEARD),MERGE(D%NKT,0,OSEDIM_BEARD)), INTENT(IN) :: PEFIELDW ! Vertical E field
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN), OPTIONAL :: PRAY, PLBC, PFSEDC, PCONC3D
REAL, DIMENSION(D%NIJT,D%NKT,KRR), INTENT(INOUT), OPTIONAL :: PFPR ! upper-air precipitation fluxes
!
@@ -316,13 +392,40 @@ REAL :: ZINVTSTEP
REAL :: ZZWLBDC, ZRAY, ZZT, ZZWLBDA, ZZCC
REAL :: ZLBDA
REAL :: ZFSED, ZEXSED
-REAL :: ZMRCHANGE
+REAL :: ZMRCHANGE
REAL, DIMENSION(D%NIJT) :: ZMAX_TSTEP ! Maximum CFL in column
REAL, DIMENSION(SIZE(ICED%XRTMIN)) :: ZRSMIN
REAL, DIMENSION(D%NIJT) :: ZREMAINT ! Remaining time until the timestep end
REAL, DIMENSION(D%NIJT, 0:D%NKT+1) :: ZWSED ! Sedimentation fluxes
INTEGER :: IKTB, IKTE, IKB, IKL, IIJE, IIJB
REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
+!
+! local variables for cloud electricity
+REAL :: ZEXT ! e_x coefficient of the q(D) relation
+REAL :: ZNCI ! N_ci for ice crystal sedimentation
+!REAL, DIMENSION(D%NIJT,0:D%NKT+1) :: ZWSEDQ ! Sedimentation fluxes for electric charges
+!REAL, DIMENSION(D%NIJT,0:D%NKT+1) :: ZBEARDCOEFF ! effect of electric forces on sedimentation
+!REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(0:D%NKT+1,0,OELEC)) :: &
+!++cb-- est-ce que cette declaration est correcte par rapport a ce qui est fait pour zwsed ?
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT+2,0,OELEC)) :: &
+ ZWSEDQ ! Sedimentation fluxes for electric charges
+!REAL, DIMENSION(MERGE(D%NIJT,0,OSEDIM_BEARD),MERGE(0:D%NKT+1,0,OSEDIM_BEARD)) :: &
+REAL, DIMENSION(MERGE(D%NIJT,0,OSEDIM_BEARD),MERGE(D%NKT,0,OSEDIM_BEARD)) :: &
+ ZBEARDCOEFF ! effect of electric forces on sedimentation
+!REAL, DIMENSION(MERGE(D%NIJT,0,OSEDIM_BEARD),MERGE(0:D%NKT+1,0,OSEDIM_BEARD)) :: &
+REAL, DIMENSION(MERGE(D%NIJT,0,OSEDIM_BEARD),MERGE(D%NKT,0,OSEDIM_BEARD)) :: &
+ ZLBDA3 ! slope parameter of the distribution
+!LOGICAL, DIMENSION(MERGE(D%NIJT,0,OSEDIM_BEARD),MERGE(0:D%NKT+1,0,OSEDIM_BEARD)) :: GMASK
+LOGICAL, DIMENSION(MERGE(D%NIJT,0,OSEDIM_BEARD),MERGE(D%NKT,0,OSEDIM_BEARD)) :: GMASK
+REAL :: ZQCHANGE
+REAL :: ZFQSED, ZEXQSED
+REAL :: ZEXMIN, ZEXMAX
+REAL :: ZLBX, ZLBEXX
+REAL :: ZFQUPDX
+REAL :: ZCXX
+REAL :: ZFX
+! end - local variables for cloud electricity
+!
IF (LHOOK) CALL DR_HOOK('ICE4_SEDIMENTATION_SPLIT:INTERNAL_SEDIM_SPLIT', 0, ZHOOK_HANDLE)
!
IKTB=D%NKTB
@@ -348,6 +451,18 @@ ZREMAINT(:) = PTSTEP
!
DO WHILE (ANY(ZREMAINT>0.))
!
+ ! Effect of electrical forces on sedimentation
+ IF (OELEC .AND. OSEDIM_BEARD) THEN
+ DO JK = IKTB, IKTE
+ DO JIJ = IIJB, IIJE
+ IF (PRXT(JIJ,JK)>ICED%XRTMIN(KSPE) .AND. ZREMAINT(JIJ)>0.) THEN
+ GMASK(JIJ,JK) = .TRUE.
+ ELSE
+ GMASK(JIJ,JK) = .FALSE.
+ END IF
+ END DO
+ END DO
+ END IF
!
!* 1. Parameters for cloud sedimentation
!
@@ -358,6 +473,10 @@ DO WHILE (ANY(ZREMAINT>0.))
IF(KSPE==2) THEN
!******* for cloud
ZWSED(:,:) = 0.
+ IF (OELEC) THEN
+ ZWSEDQ(:,:) = 0.
+ ZLBDA3(:,:) = 0.
+ END IF
DO JK = IKTB,IKTE
DO JIJ = IIJB,IIJE
IF(PRXT(JIJ,JK)>ICED%XRTMIN(KSPE) .AND. ZREMAINT(JIJ)>0.) THEN
@@ -370,12 +489,37 @@ DO WHILE (ANY(ZREMAINT>0.))
ZZCC = ICED%XCC*(1.+1.26*ZZWLBDA/ZRAY)
ZWSED(JIJ, JK) = PRHODREF(JIJ,JK)**(-ICED%XCEXVT +1 ) * &
&ZZWLBDC**(-ICED%XDC)*ZZCC*PFSEDC(JIJ,JK) * PRXT(JIJ,JK)
+!++cb++ nouveau : traitement de la sedimentation des charges portees par les gouttelettes
+! A TESTER
+ IF (OELEC) THEN
+ ZEXT = PQXT(JIJ,JK) / ELECP%XFQUPDC * PRHODREF(JIJ,JK)
+ IF (ABS(ZEXT) .GT. ELECP%XECMIN) THEN
+ ZWSEDQ(JIJ,JK) = ELECP%XFQSEDC * ZEXT * PCONC3D(JIJ,JK) * &
+ PRHODREF(JIJ,JK)**(-ICED%XCEXVT) * &
+ ZZCC * ZZWLBDC**(-ELECP%XEXQSEDC)
+ IF (OSEDIM_BEARD) ZLBDA3(JIJ,JK) = ZZWLBDC
+ ENDIF
+ ENDIF
ENDIF
+!--cb--
ENDDO
ENDDO
+ IF (OELEC .AND. OSEDIM_BEARD) THEN
+ CALL ELEC_BEARD_EFFECT(D, KSPE, GMASK, PT, PRHODREF, PRXT, PQXT, PEFIELDW, ZLBDA3, ZBEARDCOEFF)
+ DO JK = IKTB,IKTE
+ DO JIJ = IIJB,IIJE
+ ZWSED(JIJ,JK) = ZWSED(JIJ,JK) * ZBEARDCOEFF(JIJ,JK)
+ ZWSEDQ(JIJ,JK) = ZWSEDQ(JIJ,JK) * ZBEARDCOEFF(JIJ,JK)
+ END DO
+ END DO
+ END IF
ELSEIF(KSPE==4) THEN
! ******* for pristine ice
ZWSED(:,:) = 0.
+ IF (OELEC) THEN
+ ZWSEDQ(:,:) = 0.
+ ZLBDA3(:,:) = 0.
+ END IF
DO JK = IKTB,IKTE
DO JIJ = IIJB,IIJE
IF(PRXT(JIJ, JK) .GT. MAX(ICED%XRTMIN(4), 1.0E-7) .AND. ZREMAINT(JIJ)>0.) THEN
@@ -383,33 +527,81 @@ DO WHILE (ANY(ZREMAINT>0.))
& PRHODREF(JIJ,JK)**(1.-ICED%XCEXVT) * & ! McF&H
& MAX( 0.05E6,-0.15319E6-0.021454E6* &
& ALOG(PRHODREF(JIJ,JK)*PRXT(JIJ,JK)) )**ICEP%XEXCSEDI
+ IF (OELEC) THEN
+ ! N_ci from McF&H
+ ZNCI = ELECP%XFCI * PRHODREF(JIJ,JK) * PRXT(JIJ,JK) * &
+ MAX(0.05E6,-0.15319E6-0.021454E6*ALOG(PRHODREF(JIJ,JK)*PRXT(JIJ,JK)))**3.
+ ! compute e_i of the q - D relationship
+ ZEXT = PQXT(JIJ,JK) / ELECP%XFQUPDI * &
+ (PRHODREF(JIJ,JK) * PRXT(JIJ,JK))**(-ELECP%XEXFQUPDI) * &
+ ZNCI**(ELECP%XEXFQUPDI-1.)
+ IF (ABS(ZEXT) .GT. ELECP%XEIMIN) THEN
+ ZWSEDQ(JIJ,JK) = ELECP%XFQSEDI * ZEXT * PRXT(JIJ,JK) * &
+ PRHODREF(JIJ,JK)**(1.-ICED%XCEXVT) * &
+ MAX( 0.05E6,-0.15319E6-0.021454E6* & ! McF&H
+ ALOG(PRHODREF(JIJ,JK)*PRXT(JIJ,JK)) )**(3.*(1-ELECP%XEXQSEDI))
+ IF (OSEDIM_BEARD) ZLBDA3(JIJ,JK) = (2.14E-3 * MOMG(ICED%XALPHAI,ICED%XNUI,1.7) * &
+ ZNCI / (PRHODREF(JIJ,JK) * PRXT(JIJ,JK)))**0.588235
+ ENDIF
+ ENDIF
ENDIF
ENDDO
ENDDO
-#ifdef REPRO48
+ IF (OELEC .AND. OSEDIM_BEARD) THEN
+ CALL ELEC_BEARD_EFFECT(D, KSPE, GMASK, PT, PRHODREF, PRXT, PQXT, PEFIELDW, ZLBDA3, ZBEARDCOEFF)
+ DO JK = IKTB,IKTE
+ DO JIJ = IIJB,IIJE
+ ZWSED(JIJ,JK) = ZWSED(JIJ,JK) * ZBEARDCOEFF(JIJ,JK)
+ ZWSEDQ(JIJ,JK) = ZWSEDQ(JIJ,JK) * ZBEARDCOEFF(JIJ,JK)
+ END DO
+ END DO
+ END IF
+#ifdef REPRO48
#else
ELSEIF(KSPE==5) THEN
! ******* for snow
ZWSED(:,:) = 0.
+ IF (OELEC) THEN
+ ZWSEDQ(:,:) = 0.
+ ZLBDA3(:,:) = 0.
+ END IF
DO JK = IKTB,IKTE
DO JIJ = IIJB,IIJE
IF(PRXT(JIJ,JK)> ICED%XRTMIN(KSPE) .AND. ZREMAINT(JIJ)>0.) THEN
- IF (PARAMI%LSNOW_T .AND. PT(JIJ,JK)>263.15) THEN
- ZLBDA = MAX(MIN(ICED%XLBDAS_MAX, 10**(14.554-0.0423*PT(JIJ,JK))),ICED%XLBDAS_MIN)*ICED%XTRANS_MP_GAMMAS
- ELSE IF (PARAMI%LSNOW_T) THEN
- ZLBDA = MAX(MIN(ICED%XLBDAS_MAX, 10**(6.226 -0.0106*PT(JIJ,JK))),ICED%XLBDAS_MIN)*ICED%XTRANS_MP_GAMMAS
- ELSE
- ZLBDA=MAX(MIN(ICED%XLBDAS_MAX, ICED%XLBS * ( PRHODREF(JIJ,JK) * PRXT(JIJ,JK) )**ICED%XLBEXS),ICED%XLBDAS_MIN)
- END IF
- ZWSED(JIJ, JK) = ICEP%XFSEDS * &
- & PRXT(JIJ,JK)* &
- & PRHODREF(JIJ,JK)**(1-ICED%XCEXVT) * &
- & (1 + (ICED%XFVELOS/ZLBDA)**ICED%XALPHAS)** (-ICED%XNUS+ICEP%XEXSEDS/ICED%XALPHAS) * &
- & ZLBDA ** (ICED%XBS+ICEP%XEXSEDS)
-
+ IF (PARAMI%LSNOW_T .AND. PT(JIJ,JK)>263.15) THEN
+ ZLBDA = MAX(MIN(ICED%XLBDAS_MAX, 10**(14.554-0.0423*PT(JIJ,JK))),ICED%XLBDAS_MIN)*ICED%XTRANS_MP_GAMMAS
+ ELSE IF (PARAMI%LSNOW_T) THEN
+ ZLBDA = MAX(MIN(ICED%XLBDAS_MAX, 10**(6.226 -0.0106*PT(JIJ,JK))),ICED%XLBDAS_MIN)*ICED%XTRANS_MP_GAMMAS
+ ELSE
+ ZLBDA=MAX(MIN(ICED%XLBDAS_MAX, ICED%XLBS * ( PRHODREF(JIJ,JK) * PRXT(JIJ,JK) )**ICED%XLBEXS),ICED%XLBDAS_MIN)
+ END IF
+ ZWSED(JIJ, JK) = ICEP%XFSEDS * &
+ & PRXT(JIJ,JK)* &
+ & PRHODREF(JIJ,JK)**(1-ICED%XCEXVT) * &
+ & (1 + (ICED%XFVELOS/ZLBDA)**ICED%XALPHAS)** (-ICED%XNUS+ICEP%XEXSEDS/ICED%XALPHAS) * &
+ & ZLBDA ** (ICED%XBS+ICEP%XEXSEDS)
+ IF (OELEC .AND. ZLBDA > 0.) THEN
+ ! compute the e_x coefficient of the q - D relationship
+ ZEXT = PRHODREF(JIJ,JK) * PQXT(JIJ,JK) / (ELECP%XFQUPDS * ZLBDA**(ICED%XCXS-ELECD%XFS))
+ ZEXT = SIGN( MIN(ABS(ZEXT), ELECP%XESMAX), ZEXT)
+ IF (ABS(ZEXT) > ELECP%XESMIN) THEN
+ ZWSEDQ(JIJ,JK) = ELECP%XFQSEDS * ZEXT * PRXT(JIJ,JK)**ELECP%XEXQSEDS &
+ * PRHODREF(JIJ,JK)**(ELECP%XEXQSEDS-ICED%XCEXVT)
+ IF (OSEDIM_BEARD) ZLBDA3(JIJ,JK) = ZLBDA
+ ENDIF
+ ENDIF
ENDIF
ENDDO
ENDDO
+ IF (OELEC .AND. OSEDIM_BEARD) THEN
+ CALL ELEC_BEARD_EFFECT(D, KSPE, GMASK, PT, PRHODREF, PRXT, PQXT, PEFIELDW, ZLBDA3, ZBEARDCOEFF)
+ DO JK = IKTB,IKTE
+ DO JIJ = IIJB,IIJE
+ ZWSED(JIJ,JK) = ZWSED(JIJ,JK) * ZBEARDCOEFF(JIJ,JK)
+ ZWSEDQ(JIJ,JK) = ZWSEDQ(JIJ,JK) * ZBEARDCOEFF(JIJ,JK)
+ END DO
+ END DO
+ END IF
#endif
ELSE
! ******* for other species
@@ -434,15 +626,80 @@ DO WHILE (ANY(ZREMAINT>0.))
CALL PRINT_MSG(NVERB_FATAL, 'GEN', 'ICE4_SEDIMENTATION_SPLIT', 'no sedimentation parameter for KSPE='//TRIM(YSPE) )
END SELECT
!
+ IF (OELEC) THEN
+ SELECT CASE(KSPE)
+ CASE(3)
+ ZFQSED = ELECP%XFQSEDR
+ ZEXQSED = ELECP%XEXQSEDR
+ ZEXMIN = ELECP%XERMIN
+ ZEXMAX = ELECP%XERMAX
+ ZLBX = ICED%XLBR
+ ZLBEXX = ICED%XLBEXR
+ ZFQUPDX = ELECP%XFQUPDR
+ ZCXX = ELECD%XCXR
+ ZFX = ELECD%XFR
+ CASE(6)
+ ZFQSED = ELECP%XFQSEDG
+ ZEXQSED = ELECP%XEXQSEDG
+ ZEXMIN = ELECP%XEGMIN
+ ZEXMAX = ELECP%XEGMAX
+ ZLBX = ICED%XLBG
+ ZLBEXX = ICED%XLBEXG
+ ZFQUPDX = ELECP%XFQUPDG
+ ZCXX = ICED%XCXG
+ ZFX = ELECD%XFG
+ CASE(7)
+ ZFQSED = ELECP%XFQSEDH
+ ZEXQSED = ELECP%XEXQSEDH
+ ZEXMIN = ELECP%XEHMIN
+ ZEXMAX = ELECP%XEHMAX
+ ZLBX = ICED%XLBH
+ ZLBEXX = ICED%XLBEXH
+ ZFQUPDX = ELECP%XFQUPDH
+ ZCXX = ICED%XCXH
+ ZFX = ELECD%XFH
+ CASE DEFAULT
+ write( yspe, '( I10 )' ) kspe
+ call Print_msg( NVERB_FATAL, 'GEN', 'ICE4_SEDIMENTATION_SPLIT', 'no sedimentation parameter for KSPE='//trim(yspe) )
+ END SELECT
+ END IF
+ !
ZWSED(:,:) = 0.
+ IF (OELEC) THEN
+ ZWSEDQ(:,:) = 0.
+ ZLBDA3(:,:) = 0.
+ END IF
DO JK = IKTB,IKTE
DO JIJ = IIJB,IIJE
IF(PRXT(JIJ,JK)>ICED%XRTMIN(KSPE) .AND. ZREMAINT(JIJ)>0.) THEN
ZWSED(JIJ, JK) = ZFSED * PRXT(JIJ, JK)**ZEXSED &
& * PRHODREF(JIJ, JK)**(ZEXSED-ICED%XCEXVT)
+ IF (OELEC) THEN
+ ! need lambda_x to compute e_x
+ ZLBDA = ZLBX * (PRHODREF(JIJ,JK) * MAX(PRXT(JIJ,JK), ICED%XRTMIN(KSPE)))**ZLBEXX
+ IF (ZLBDA > 0.) THEN
+ ! compute the e_x coefficient of the q - D relationship
+ ZEXT = PRHODREF(JIJ,JK) * PQXT(JIJ,JK) / (ZFQUPDX * ZLBDA**(ZCXX-ZFX))
+ ZEXT = SIGN( MIN(ABS(ZEXT), ZEXMAX), ZEXT)
+ END IF
+ IF (ABS(ZEXT) > ZEXMIN) THEN
+ ZWSEDQ(JIJ,JK) = ZFQSED * ZEXT * PRXT(JIJ,JK)**ZEXQSED &
+ * PRHODREF(JIJ,JK)**(ZEXQSED-ICED%XCEXVT)
+ IF (OSEDIM_BEARD) ZLBDA3(JIJ,JK) = ZLBDA
+ END IF
+ ENDIF
ENDIF
ENDDO
ENDDO
+ IF (OELEC .AND. OSEDIM_BEARD) THEN
+ CALL ELEC_BEARD_EFFECT(D, KSPE, GMASK, PT, PRHODREF, PRXT, PQXT, PEFIELDW, ZLBDA3, ZBEARDCOEFF)
+ DO JK = IKTB,IKTE
+ DO JIJ = IIJB,IIJE
+ ZWSED(JIJ,JK) = ZWSED(JIJ,JK) * ZBEARDCOEFF(JIJ,JK)
+ ZWSEDQ(JIJ,JK) = ZWSEDQ(JIJ,JK) * ZBEARDCOEFF(JIJ,JK)
+ END DO
+ END DO
+ END IF
ENDIF
ZMAX_TSTEP(:) = ZREMAINT(:)
DO JK = IKTB,IKTE
@@ -467,6 +724,11 @@ DO WHILE (ANY(ZREMAINT>0.))
IF (GPRESENT_PFPR) THEN
PFPR(JIJ,JK,KSPE) = PFPR(JIJ,JK,KSPE) + ZWSED(JIJ,JK) * (ZMAX_TSTEP(JIJ) * ZINVTSTEP)
ENDIF
+ IF (OELEC) THEN
+ ZQCHANGE = ZMAX_TSTEP(JIJ) * POORHODZ(JIJ,JK) * (ZWSEDQ(JIJ,JK+IKL) - ZWSEDQ(JIJ,JK))
+ PQXT(JIJ,JK) = PQXT(JIJ,JK) + ZQCHANGE + PPQXS(JIJ,JK) * ZMAX_TSTEP(JIJ)
+ PQXS(JIJ,JK) = PQXS(JIJ,JK) + ZQCHANGE * ZINVTSTEP
+ ENDIF
ENDDO
ENDDO
!
diff --git a/src/PHYEX/micro/mode_ice4_slow.f90 b/src/PHYEX/micro/mode_ice4_slow.f90
index e05c784fae93f11baa945c7859f61084cd5ccbcc..6b6c7140e0351dbedde6ffe0a1850d2e39b0982b 100644
--- a/src/PHYEX/micro/mode_ice4_slow.f90
+++ b/src/PHYEX/micro/mode_ice4_slow.f90
@@ -5,11 +5,12 @@
MODULE MODE_ICE4_SLOW
IMPLICIT NONE
CONTAINS
-SUBROUTINE ICE4_SLOW(CST, ICEP, ICED, KPROMA, KSIZE, LDSOFT, LDCOMPUTE, PRHODREF, PT, &
+SUBROUTINE ICE4_SLOW(CST, ICEP, ICED, KPROMA, KSIZE, LDSOFT, OELEC, LDCOMPUTE, PRHODREF, PT, &
&PSSI, PLVFACT, PLSFACT, &
&PRVT, PRCT, PRIT, PRST, PRGT, &
&PLBDAS, PLBDAG, &
&PAI, PCJ, PHLI_HCF, PHLI_HRI,&
+ &PLATHAM_IAGGS, &
&PRCHONI, PRVDEPS, PRIAGGS, PRIAUTS, PRVDEPG)
!!
!!** PURPOSE
@@ -25,6 +26,7 @@ SUBROUTINE ICE4_SLOW(CST, ICEP, ICED, KPROMA, KSIZE, LDSOFT, LDCOMPUTE, PRHODREF
!!
!! R. El Khatib 24-Aug-2021 Optimizations
! J. Wurtz 03/2022: New snow characteristics with LSNOW_T
+! C. Barthe 06/2023: Add retroaction of electric field on IAGGS
!
!
!* 0. DECLARATIONS
@@ -44,6 +46,7 @@ TYPE(RAIN_ICE_PARAM_t), INTENT(IN) :: ICEP
TYPE(RAIN_ICE_DESCR_t), INTENT(IN) :: ICED
INTEGER, INTENT(IN) :: KPROMA, KSIZE
LOGICAL, INTENT(IN) :: LDSOFT
+LOGICAL, INTENT(IN) :: OELEC
LOGICAL, DIMENSION(KPROMA), INTENT(IN) :: LDCOMPUTE
REAL, DIMENSION(KPROMA), INTENT(IN) :: PRHODREF ! Reference density
REAL, DIMENSION(KPROMA), INTENT(IN) :: PT ! Temperature
@@ -61,6 +64,7 @@ REAL, DIMENSION(KPROMA), INTENT(IN) :: PAI ! Thermodynamical functi
REAL, DIMENSION(KPROMA), INTENT(IN) :: PCJ ! Function to compute the ventilation coefficient
REAL, DIMENSION(KPROMA), INTENT(IN) :: PHLI_HCF !
REAL, DIMENSION(KPROMA), INTENT(IN) :: PHLI_HRI !
+REAL, DIMENSION(MERGE(KPROMA,0,OELEC)), INTENT(IN) :: PLATHAM_IAGGS ! enhancement factor of IAGGS due to Efield
REAL, DIMENSION(KPROMA), INTENT(INOUT) :: PRCHONI ! Homogeneous nucleation
REAL, DIMENSION(KPROMA), INTENT(INOUT) :: PRVDEPS ! Deposition on r_s
REAL, DIMENSION(KPROMA), INTENT(INOUT) :: PRIAGGS ! Aggregation on r_s
@@ -144,6 +148,7 @@ DO JL=1, KSIZE
* PRHODREF(JL)**(-ICED%XCEXVT+1.) &
* ((PLBDAS(JL))**(ICED%XBS+ICEP%XEXIAGGS))
#endif
+ IF (OELEC) PRIAGGS(JL) = PRIAGGS(JL) * PLATHAM_IAGGS(JL)
ENDIF
ELSE
PRIAGGS(JL) = 0.
diff --git a/src/PHYEX/micro/mode_ice4_stepping.f90 b/src/PHYEX/micro/mode_ice4_stepping.f90
index 43604d778dd49d7da69518fc55b4ad0b608e4165..2494a19afb24944ecd7ede51364ddd4d845a9ddc 100644
--- a/src/PHYEX/micro/mode_ice4_stepping.f90
+++ b/src/PHYEX/micro/mode_ice4_stepping.f90
@@ -9,14 +9,15 @@ CONTAINS
SUBROUTINE ICE4_STEPPING(D, CST, PARAMI, ICEP, ICED, BUCONF, &
&LDSIGMA_RC, LDAUCV_ADJU, LDEXT_TEND, &
&KPROMA, KMICRO, LDMICRO, PTSTEP, &
- &KRR, &
+ &KRR, OSAVE_MICRO, OELEC, &
&PEXN, PRHODREF, K1, K2, &
&PPRES, PCF, PSIGMA_RC, &
&PCIT, &
&PVART, &
&PHLC_HCF, PHLC_HRC, &
&PHLI_HCF, PHLI_HRI, PRAINFR, &
- &PEXTPK, PBU_SUM, PRREVAV)
+ &PEXTPK, PBU_SUM, PRREVAV, &
+ &PLATHAM_IAGGS)
! ######################################################################
!
!!**** * - compute the explicit microphysical sources
@@ -82,6 +83,8 @@ INTEGER, INTENT(IN) :: KMICRO ! Case r_x>0 locations
LOGICAL, DIMENSION(KPROMA), INTENT(IN) :: LDMICRO
REAL, INTENT(IN) :: PTSTEP ! Double Time step (single if cold start)
INTEGER, INTENT(IN) :: KRR ! Number of moist variable
+LOGICAL, INTENT(IN) :: OSAVE_MICRO ! if true, save the microphysical tendencies
+LOGICAL, INTENT(IN) :: OELEC ! if true, cloud electricity is activated
!
REAL, DIMENSION(KPROMA), INTENT(IN) :: PEXN ! Exner function
REAL, DIMENSION(KPROMA), INTENT(IN) :: PRHODREF! Reference density
@@ -99,6 +102,8 @@ REAL, DIMENSION(KPROMA), INTENT(OUT) :: PRAINFR
REAL, DIMENSION(KPROMA,0:7), INTENT(INOUT) :: PEXTPK !To take into acount external tendencies inside the splitting
REAL, DIMENSION(KPROMA, IBUNUM-IBUNUM_EXTRA),INTENT(OUT) :: PBU_SUM
REAL, DIMENSION(KPROMA), INTENT(INOUT) :: PRREVAV
+REAL, DIMENSION(MERGE(KPROMA,0,OELEC)), INTENT(IN) :: PLATHAM_IAGGS ! E Function to simulate
+ ! enhancement of IAGGS
!
!
!* 0.2 Declarations of local variables :
@@ -156,7 +161,7 @@ IF (LHOOK) CALL DR_HOOK('ICE4_STEPPING', 0, ZHOOK_HANDLE)
!
ZINV_TSTEP=1./PTSTEP
!
-IF(BUCONF%LBU_ENABLE) THEN
+IF(BUCONF%LBU_ENABLE .OR. OSAVE_MICRO) THEN
DO JV=1, IBUNUM-IBUNUM_EXTRA
PBU_SUM(:, JV)=0.
ENDDO
@@ -255,10 +260,12 @@ DO WHILE(ANY(ZTIME(1:KMICRO)<PTSTEP)) ! Loop to *really* compute tendencies
CALL ICE4_TENDENCIES(D, CST, PARAMI, ICEP, ICED, BUCONF, &
&KPROMA, KMICRO, &
&KRR, LSOFT, LLCOMPUTE, &
+ &OSAVE_MICRO, OELEC, &
&PEXN, PRHODREF, ZLVFACT, ZLSFACT, K1, K2, &
&PPRES, PCF, PSIGMA_RC, &
&PCIT, &
&ZZT, PVART, &
+ &PLATHAM_IAGGS, &
&ZBU_INST, &
&ZRS_TEND, ZRG_TEND, ZRH_TEND, ZSSI, &
&ZA, ZB, &
@@ -397,7 +404,7 @@ DO WHILE(ANY(ZTIME(1:KMICRO)<PTSTEP)) ! Loop to *really* compute tendencies
!
!*** 4.8 Mixing ratio change due to each process
!
- IF(BUCONF%LBU_ENABLE) THEN
+ IF(BUCONF%LBU_ENABLE .OR. OSAVE_MICRO) THEN
!Mixing ratio change due to a tendency
DO JV=1, IBUNUM-IBUNUM_MR-IBUNUM_EXTRA
DO JL=1, KMICRO
diff --git a/src/PHYEX/micro/mode_ice4_tendencies.f90 b/src/PHYEX/micro/mode_ice4_tendencies.f90
index 0883b6c8fa9fc2e7bceb0216b00f48c84382b1f5..611c82c1548a01a526448410c7f2d8b775bbaf86 100644
--- a/src/PHYEX/micro/mode_ice4_tendencies.f90
+++ b/src/PHYEX/micro/mode_ice4_tendencies.f90
@@ -8,10 +8,12 @@ IMPLICIT NONE
CONTAINS
SUBROUTINE ICE4_TENDENCIES(D, CST, PARAMI, ICEP, ICED, BUCONF, KPROMA, KSIZE, &
&KRR, ODSOFT, LDCOMPUTE, &
+ &OSAVE_MICRO, OELEC, &
&PEXN, PRHODREF, PLVFACT, PLSFACT, K1, K2, &
&PPRES, PCF, PSIGMA_RC, &
&PCIT, &
&PT, PVART, &
+ &PLATHAM_IAGGS, &
&PBU_INST, &
&PRS_TEND, PRG_TEND, PRH_TEND, PSSI, &
&PA, PB, &
@@ -32,6 +34,7 @@ SUBROUTINE ICE4_TENDENCIES(D, CST, PARAMI, ICEP, ICED, BUCONF, KPROMA, KSIZE, &
!!
! P. Wautelet 29/05/2019: remove PACK/UNPACK intrinsics (to get more performance and better OpenACC support)
!! R. El Khatib 24-Aug-2021 Optimizations
+!! C. Barthe 06/2023: Add retroaction of electric field on IAGGS
!
!
!* 0. DECLARATIONS
@@ -74,6 +77,8 @@ INTEGER, INTENT(IN) :: KPROMA, KSIZE
INTEGER, INTENT(IN) :: KRR
LOGICAL, INTENT(IN) :: ODSOFT
LOGICAL, DIMENSION(KPROMA), INTENT(IN) :: LDCOMPUTE
+LOGICAL, INTENT(IN) :: OSAVE_MICRO
+LOGICAL, INTENT(IN) :: OELEC
REAL, DIMENSION(KPROMA), INTENT(IN) :: PEXN
REAL, DIMENSION(KPROMA), INTENT(IN) :: PRHODREF
REAL, DIMENSION(KPROMA), INTENT(IN) :: PLVFACT
@@ -86,6 +91,7 @@ REAL, DIMENSION(KPROMA), INTENT(IN) :: PSIGMA_RC
REAL, DIMENSION(KPROMA), INTENT(INOUT) :: PCIT
REAL, DIMENSION(KPROMA), INTENT(IN) :: PT
REAL, DIMENSION(KPROMA,0:KRR), INTENT(IN) :: PVART
+REAL, DIMENSION(MERGE(KPROMA,0,OELEC)), INTENT(IN) :: PLATHAM_IAGGS
REAL, DIMENSION(KPROMA, IBUNUM),INTENT(INOUT):: PBU_INST
REAL, DIMENSION(KPROMA, 8), INTENT(INOUT) :: PRS_TEND
REAL, DIMENSION(KPROMA, 8), INTENT(INOUT) :: PRG_TEND
@@ -330,11 +336,12 @@ DO JL=1, KSIZE
ENDDO
!
!
-CALL ICE4_SLOW(CST, ICEP, ICED, KPROMA, KSIZE, ODSOFT, LDCOMPUTE, PRHODREF, ZT, &
+CALL ICE4_SLOW(CST, ICEP, ICED, KPROMA, KSIZE, ODSOFT, OELEC, LDCOMPUTE, PRHODREF, ZT, &
&PSSI, PLVFACT, PLSFACT, &
&ZVART(:,IRV), ZVART(:,IRC), ZVART(:,IRI), ZVART(:,IRS), ZVART(:,IRG), &
&ZLBDAS, ZLBDAG, &
&ZAI, ZCJ, PHLI_HCF, PHLI_HRI, &
+ &PLATHAM_IAGGS, &
&PBU_INST(:, IRCHONI), PBU_INST(:, IRVDEPS), PBU_INST(:, IRIAGGS), PBU_INST(:, IRIAUTS), PBU_INST(:, IRVDEPG))
!
!-------------------------------------------------------------------------------
@@ -417,7 +424,7 @@ IF (KRR==7) THEN
&PBU_INST(:, IRCDRYH), PBU_INST(:, IRIDRYH), PBU_INST(:, IRSDRYH), PBU_INST(:, IRRDRYH), &
&PBU_INST(:, IRGDRYH), PBU_INST(:, IRDRYHG), PBU_INST(:, IRHMLTR), &
&PRH_TEND)
-ELSEIF (BUCONF%LBU_ENABLE) THEN
+ELSEIF (BUCONF%LBU_ENABLE .OR. OSAVE_MICRO) THEN
PBU_INST(:, IRCWETH)=0.
PBU_INST(:, IRIWETH)=0.
PBU_INST(:, IRSWETH)=0.
diff --git a/src/PHYEX/micro/mode_lima_ccn_activation.f90 b/src/PHYEX/micro/mode_lima_ccn_activation.f90
index 38732eee869583c4958e6624ee743a1e322a847f..b7886c3bb8d572d3a1ce708194ae1fe719926b4f 100644
--- a/src/PHYEX/micro/mode_lima_ccn_activation.f90
+++ b/src/PHYEX/micro/mode_lima_ccn_activation.f90
@@ -10,7 +10,7 @@ CONTAINS
SUBROUTINE LIMA_CCN_ACTIVATION (CST, &
PRHODREF, PEXNREF, PPABST, PT, PDTHRAD, PW_NU, &
PTHT, PRVT, PRCT, PCCT, PRRT, PNFT, PNAT, &
- PCLDFR )
+ PCLDFR, PTOT_RV_HENU )
! ##############################################################################
!
!!
@@ -59,6 +59,7 @@ CONTAINS
! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90
+! C. Barthe 06/2022: save mixing ratio change for cloud electrification
!
!-------------------------------------------------------------------------------
!
@@ -107,6 +108,8 @@ REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PNAT ! CCN C. activated at t
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PCLDFR ! Precipitation fraction
!
+REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(INOUT) :: PTOT_RV_HENU ! Mixing ratio change due to HENU
+!
!* 0.1 Declarations of local variables :
!
! Packing variables
@@ -421,8 +424,10 @@ IF( INUCT >= 1 ) THEN
ZZW1(:) = MIN(XCSTDCRIT*ZZW6(:)/(((ZZT(:)*ZSMAX(:))**3)*ZRHODREF(:)),1.E-5)
END WHERE
!
+ PTOT_RV_HENU(:,:,:) = 0.
IF (.NOT.LSUBG_COND) THEN
ZW(:,:,:) = MIN( UNPACK( ZZW1(:),MASK=GNUCT(:,:,:),FIELD=0.0 ),PRVT(:,:,:) )
+ PTOT_RV_HENU(:,:,:) = ZW(:,:,:)
PTHT(:,:,:) = PTHT(:,:,:) + ZW(:,:,:) * (CST%XLVTT+(CST%XCPV-CST%XCL)*(PT(:,:,:)-CST%XTT))/ &
(PEXNREF(:,:,:)*(CST%XCPD+CST%XCPV*PRVT(:,:,:)+CST%XCL*(PRCT(:,:,:)+PRRT(:,:,:))))
PRVT(:,:,:) = PRVT(:,:,:) - ZW(:,:,:)
@@ -433,6 +438,8 @@ IF( INUCT >= 1 ) THEN
PCCT(:,:,:) = PCCT(:,:,:) + ZCLDFR(:,:,:) * UNPACK( ZZW6(:),MASK=GNUCT(:,:,:),FIELD=0. )
END IF
!
+!++cb-- A quoi servent ces 2 dernieres lignes ? variables locales, non sauvees, et ne servent pas
+! a calculer quoi que ce soit (fin de la routine)
ZW(:,:,:) = UNPACK( 100.0*ZSMAX(:),MASK=GNUCT(:,:,:),FIELD=0.0 )
ZW2(:,:,:) = ZCLDFR(:,:,:) * UNPACK( ZZW6(:),MASK=GNUCT(:,:,:),FIELD=0.0 )
!
diff --git a/src/PHYEX/micro/mode_lima_ccn_hom_freezing.f90 b/src/PHYEX/micro/mode_lima_ccn_hom_freezing.f90
index 38f760fc59473f3cad1d4d5ef76083cf52a7bd16..f3b9dc125e3d7a7282392b769be65ea4950f0c7d 100644
--- a/src/PHYEX/micro/mode_lima_ccn_hom_freezing.f90
+++ b/src/PHYEX/micro/mode_lima_ccn_hom_freezing.f90
@@ -10,7 +10,7 @@ CONTAINS
SUBROUTINE LIMA_CCN_HOM_FREEZING (CST, PRHODREF, PEXNREF, PPABST, PW_NU, &
PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
PCCT, PCRT, PCIT, PNFT, PNHT , &
- PICEFR )
+ PICEFR, PTOT_RV_HONH )
! ##########################################################################
!
!! PURPOSE
@@ -29,6 +29,7 @@ CONTAINS
!! -------------
!! Original 15/03/2018
! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90
+! C. Barthe 07/06/2022: save mixing ratio change for cloud electrification
!
!-------------------------------------------------------------------------------
!
@@ -74,6 +75,8 @@ REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PNHT ! haze homogeneous freezing
!
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PICEFR ! Ice fraction
!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTOT_RV_HONH ! Mixing ratio change due to HONH
+!
!* 0.2 Declarations of local variables :
!
REAL, DIMENSION(:), ALLOCATABLE :: ZRVT ! Water vapor m.r. at t
@@ -299,6 +302,8 @@ IF (INEGT.GT.0) THEN
END WHERE
PNFT(:,:,:,JMOD_CCN) = PNFT(:,:,:,JMOD_CCN) - UNPACK( ZCCNFROZEN(:), MASK=GNEGT(:,:,:),FIELD=0.)
END DO
+!
+ PTOT_RV_HONH(:,:,:) = UNPACK( ZZW(:), MASK=GNEGT(:,:,:),FIELD=0.)
!
PTHT(:,:,:) = PTHT(:,:,:) + UNPACK( ZZW(:)*(ZLSFACT(:)-ZLVFACT(:)), MASK=GNEGT(:,:,:),FIELD=0.)
PRVT(:,:,:) = PRVT(:,:,:) - UNPACK( ZZW(:), MASK=GNEGT(:,:,:),FIELD=0.)
diff --git a/src/PHYEX/micro/mode_lima_droplets_riming_snow.f90 b/src/PHYEX/micro/mode_lima_droplets_riming_snow.f90
index 9974166a1111a0ed9f0815781a6333b6eac5661e..56b57d5d8c7ecdecdbdd168e9da5ad189697de28 100644
--- a/src/PHYEX/micro/mode_lima_droplets_riming_snow.f90
+++ b/src/PHYEX/micro/mode_lima_droplets_riming_snow.f90
@@ -6,13 +6,16 @@
MODULE MODE_LIMA_DROPLETS_RIMING_SNOW
IMPLICIT NONE
CONTAINS
-! #########################################################################################
- SUBROUTINE LIMA_DROPLETS_RIMING_SNOW (PTSTEP, LDCOMPUTE, &
- PRHODREF, PT, &
- PRCT, PCCT, PRST, PCST, PLBDC, PLBDS, PLVFACT, PLSFACT, &
- P_TH_RIM, P_RC_RIM, P_CC_RIM, P_RS_RIM, P_CS_RIM, P_RG_RIM, &
- P_RI_HMS, P_CI_HMS, P_RS_HMS )
-! #########################################################################################
+! ###########################################################################################
+ SUBROUTINE LIMA_DROPLETS_RIMING_SNOW (PTSTEP, LDCOMPUTE, &
+ PRHODREF, PT, &
+ PRCT, PCCT, PRST, PCST, PLBDC, PLBDS, PLVFACT, PLSFACT, &
+!++cb++
+! P_TH_RIM, P_RC_RIM, P_CC_RIM, P_RS_RIM, P_CS_RIM, P_RG_RIM, &
+ P_TH_RIM, P_CC_RIM, P_CS_RIM, &
+ P_RC_RIMSS, P_RC_RIMSG, P_RS_RIMCG, &
+ P_RI_HMS, P_CI_HMS, P_RS_HMS )
+! ###########################################################################################
!
!! PURPOSE
!! -------
@@ -31,6 +34,8 @@ CONTAINS
!! Original 15/03/2018
! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
! J. Wurtz 03/2022: new snow characteristics
+! C. Barthe 06/2022: modify the microphysics terms to save to simplify the merging with the electrification scheme
+! (same terms as in ICE3)
!
!-------------------------------------------------------------------------------
!
@@ -63,11 +68,16 @@ REAL, DIMENSION(:), INTENT(IN) :: PLBDS !
REAL, DIMENSION(:), INTENT(IN) :: PLVFACT !
REAL, DIMENSION(:), INTENT(IN) :: PLSFACT !
!
-REAL, DIMENSION(:), INTENT(OUT) :: P_RC_RIM
+!++cb++
+!REAL, DIMENSION(:), INTENT(OUT) :: P_RC_RIM
REAL, DIMENSION(:), INTENT(OUT) :: P_CC_RIM
-REAL, DIMENSION(:), INTENT(OUT) :: P_RS_RIM
+!REAL, DIMENSION(:), INTENT(OUT) :: P_RS_RIM
REAL, DIMENSION(:), INTENT(OUT) :: P_CS_RIM
-REAL, DIMENSION(:), INTENT(OUT) :: P_RG_RIM
+!REAL, DIMENSION(:), INTENT(OUT) :: P_RG_RIM
+REAL, DIMENSION(:), INTENT(OUT) :: P_RC_RIMSS
+REAL, DIMENSION(:), INTENT(OUT) :: P_RC_RIMSG
+REAL, DIMENSION(:), INTENT(OUT) :: P_RS_RIMCG
+!--cb--
!
REAL, DIMENSION(:), INTENT(OUT) :: P_TH_RIM
REAL, DIMENSION(:), INTENT(OUT) :: P_RI_HMS
@@ -77,6 +87,7 @@ REAL, DIMENSION(:), INTENT(OUT) :: P_RS_HMS
!* 0.2 Declarations of local variables :
!
REAL, DIMENSION(SIZE(PRCT)) :: ZZW1, ZZW2, ZZW3, ZZW4, ZZW5
+REAL, DIMENSION(SIZE(PRCT)) :: Z_RC_RIM, Z_RS_RIM, Z_RG_RIM !++cb--
!
INTEGER, DIMENSION(SIZE(PRCT)) :: IVEC2 ! Vector of indices
REAL, DIMENSION(SIZE(PRCT)) :: ZVEC1,ZVEC2,ZVEC1W ! Work vectors
@@ -85,112 +96,127 @@ INTEGER :: JI
!-------------------------------------------------------------------------------
!
!
-!
DO JI = 1, SIZE(PRCT)
!
!* Cloud droplet riming of the aggregates
! --------------------------------------
!
- IF ( PRCT(JI)>XRTMIN(2) .AND. PRST(JI)>XRTMIN(5) .AND. PT(JI)<XTT .AND. &
- PCCT(JI)>XCTMIN(2) .AND. PCST(JI)>XCTMIN(5) .AND. LDCOMPUTE(JI) ) THEN
+ IF ( PRCT(JI)>XRTMIN(2) .AND. PRST(JI)>XRTMIN(5) .AND. PT(JI)<XTT .AND. &
+ PCCT(JI)>XCTMIN(2) .AND. PCST(JI)>XCTMIN(5) .AND. LDCOMPUTE(JI) ) THEN
!
- ZVEC1(JI) = PLBDS(JI)
- ZVEC1W(JI)= ( XFVELOS**XALPHAS + PLBDS(JI)**XALPHAS ) ** (1./XALPHAS) ! modified equivalent lambda
+ ZVEC1(JI) = PLBDS(JI)
+ ZVEC1W(JI)= ( XFVELOS**XALPHAS + PLBDS(JI)**XALPHAS ) ** (1./XALPHAS) ! modified equivalent lambda
!
! 2. perform the linear interpolation of the normalized
! "2+XDS"-moment of the incomplete gamma function using the modified equivalent lambda
!
- ZVEC2(JI) = MAX( 1.0001, MIN( REAL(NGAMINC)-0.0001, &
- XRIMINTP1 * LOG( ZVEC1W(JI) ) + XRIMINTP2 ) )
- IVEC2(JI) = INT( ZVEC2(JI) )
- ZVEC2(JI) = ZVEC2(JI) - REAL( IVEC2(JI) )
+ ZVEC2(JI) = MAX( 1.0001, MIN( REAL(NGAMINC)-0.0001, &
+ XRIMINTP1 * LOG( ZVEC1W(JI) ) + XRIMINTP2 ) )
+ IVEC2(JI) = INT( ZVEC2(JI) )
+ ZVEC2(JI) = ZVEC2(JI) - REAL( IVEC2(JI) )
!
- ZZW1(JI) = XGAMINC_RIM1( IVEC2(JI)+1 )* ZVEC2(JI) &
- - XGAMINC_RIM1( IVEC2(JI) )*(ZVEC2(JI) - 1.0)
+ ZZW1(JI) = XGAMINC_RIM1( IVEC2(JI)+1 )* ZVEC2(JI) &
+ - XGAMINC_RIM1( IVEC2(JI) )*(ZVEC2(JI) - 1.0)
!
! 3. perform the linear interpolation of the normalized
! "XBS"-moment of the incomplete gamma function
!
- ZVEC2(JI) = MAX( 1.0001, MIN( REAL(NGAMINC)-0.0001, &
- XRIMINTP1 * LOG( ZVEC1(JI) ) + XRIMINTP2 ) )
- IVEC2(JI) = INT( ZVEC2(JI) )
- ZVEC2(JI) = ZVEC2(JI) - REAL( IVEC2(JI) )
+ ZVEC2(JI) = MAX( 1.0001, MIN( REAL(NGAMINC)-0.0001, &
+ XRIMINTP1 * LOG( ZVEC1(JI) ) + XRIMINTP2 ) )
+ IVEC2(JI) = INT( ZVEC2(JI) )
+ ZVEC2(JI) = ZVEC2(JI) - REAL( IVEC2(JI) )
!
- ZZW2(JI) = XGAMINC_RIM2( IVEC2(JI)+1 )* ZVEC2(JI) &
- - XGAMINC_RIM2( IVEC2(JI) )*(ZVEC2(JI) - 1.0)
+ ZZW2(JI) = XGAMINC_RIM2( IVEC2(JI)+1 )* ZVEC2(JI) &
+ - XGAMINC_RIM2( IVEC2(JI) )*(ZVEC2(JI) - 1.0)
!
! 4. riming
!
+!++cb++
! Cloud droplets collected
- P_RC_RIM(JI) = - XCRIMSS * PRCT(JI) * PCST(JI)*(1+(XFVELOS/PLBDS(JI))**XALPHAS)**(-XNUS+XEXCRIMSS/XALPHAS) &
+! P_RC_RIM(JI) = - XCRIMSS * PRCT(JI) * PCST(JI)*(1+(XFVELOS/PLBDS(JI))**XALPHAS)**(-XNUS+XEXCRIMSS/XALPHAS) &
+! * PRHODREF(JI)**(-XCEXVT+1) * PLBDS(JI)**XEXCRIMSS
+! P_CC_RIM(JI) = P_RC_RIM(JI) * PCCT(JI)/PRCT(JI) ! Lambda_c**3
+! total mass loss of cloud droplets, < 0
+ Z_RC_RIM(JI) = - XCRIMSS * PRCT(JI) * PCST(JI)*(1+(XFVELOS/PLBDS(JI))**XALPHAS)**(-XNUS+XEXCRIMSS/XALPHAS) &
* PRHODREF(JI)**(-XCEXVT+1) * PLBDS(JI)**XEXCRIMSS
- P_CC_RIM(JI) = P_RC_RIM(JI) * PCCT(JI)/PRCT(JI) ! Lambda_c**3
- !
- ! Cloud droplets collected on small aggregates add to snow
- P_RS_RIM(JI) = - P_RC_RIM(JI) * ZZW1(JI)
- !
- ! Cloud droplets collected on large aggregates add to graupel
- P_RG_RIM(JI) = - P_RC_RIM(JI) - P_RS_RIM(JI)
- !
- IF (LMURAKAMI) THEN
- ! Graupel formation based on Murakami
- ZVEC1(JI) = XGAMINC_RIM4( IVEC2(JI)+1 )* ZVEC2(JI) &
- - XGAMINC_RIM4( IVEC2(JI) )*(ZVEC2(JI) - 1.0)
- ZZW5(JI) = ZVEC1(JI)
- ZZW3(JI) = XSRIMCG * PRHODREF(JI) * PCST(JI) * PLBDS(JI)**XEXSRIMCG * (1.0 - ZZW2(JI))!/(PTSTEP*PRHODREF(JI))
- ZZW3(JI) = P_RG_RIM(JI)*ZZW3(JI)/ &
- MAX(1.E-10, & !-20
- XSRIMCG3*XSRIMCG2*PCST(JI)*PRHODREF(JI)*PLBDS(JI)**(XEXSRIMCG2)*(1.-ZZW5(JI))- &
- XSRIMCG3*ZZW3(JI))
- ELSE
- ! Large aggregates collecting droplets add to graupel (instant process ???)
- ZZW3(JI) = PRST(JI)*(1.0 - ZZW2(JI))/PTSTEP
- END IF
- P_RS_RIM(JI) = P_RS_RIM(JI) - ZZW3(JI)
- P_CS_RIM(JI) = -ZZW3(JI) * PCST(JI)/PRST(JI)
- P_RG_RIM(JI) = P_RG_RIM(JI) + ZZW3(JI)
- !
- P_TH_RIM(JI) = - P_RC_RIM(JI)*(PLSFACT(JI)-PLVFACT(JI))
- ELSE
- P_TH_RIM(JI) = 0.
- P_RC_RIM(JI) = 0.
- P_CC_RIM(JI) = 0.
- P_RS_RIM(JI) = 0.
- P_CS_RIM(JI) = 0.
- P_RG_RIM(JI) = 0.
- END IF
+ P_CC_RIM(JI) = Z_RC_RIM(JI) * (PCCT(JI) / PRCT(JI)) ! Lambda_c**3
+ !
+ ! Cloud droplets collected on small aggregates add to snow
+! P_RS_RIM(JI) = - P_RC_RIM(JI) * ZZW1(JI)
+ Z_RS_RIM(JI) = -Z_RC_RIM(JI) * ZZW1(JI)
+ P_RC_RIMSS(JI) = Z_RC_RIM(JI) * ZZW1(JI) ! < 0, loss of mass for rc
+ !
+ ! Cloud droplets collected on large aggregates add to graupel
+! P_RG_RIM(JI) = - P_RC_RIM(JI) - P_RS_RIM(JI)
+ Z_RG_RIM(JI) = -Z_RC_RIM(JI) - Z_RS_RIM(JI)
+ P_RC_RIMSG(JI) = Z_RC_RIM(JI) - P_RC_RIMSS(JI) ! < 0, loss of mass for rc
+ !
+ IF (LMURAKAMI) THEN
+ ! Graupel formation based on Murakami
+ ZVEC1(JI) = XGAMINC_RIM4( IVEC2(JI)+1 )* ZVEC2(JI) &
+ - XGAMINC_RIM4( IVEC2(JI) )*(ZVEC2(JI) - 1.0)
+ ZZW5(JI) = ZVEC1(JI)
+ ZZW3(JI) = XSRIMCG * PRHODREF(JI) * PCST(JI) * PLBDS(JI)**XEXSRIMCG * (1.0 - ZZW2(JI))!/(PTSTEP*PRHODREF(JI))
+ ZZW3(JI) = Z_RG_RIM(JI)*ZZW3(JI)/ &
+ MAX(1.E-10, & !-20
+ XSRIMCG3*XSRIMCG2*PCST(JI)*PRHODREF(JI)*PLBDS(JI)**(XEXSRIMCG2)*(1.-ZZW5(JI))- &
+ XSRIMCG3*ZZW3(JI))
+ ELSE
+ ! Large aggregates collecting droplets add to graupel (instant process ???)
+ ZZW3(JI) = PRST(JI)*(1.0 - ZZW2(JI))/PTSTEP
+ END IF
+ !
+ P_RS_RIMCG(JI) = ZZW3(JI)
+ P_CS_RIM(JI) = -ZZW3(JI) * PCST(JI)/PRST(JI)
+! P_RS_RIM(JI) = P_RS_RIM(JI) - ZZW3(JI)
+! P_RG_RIM(JI) = P_RG_RIM(JI) + ZZW3(JI)
+ !
+! P_TH_RIM(JI) = - P_RC_RIM(JI)*(PLSFACT(JI)-PLVFACT(JI))
+ P_TH_RIM(JI) = - Z_RC_RIM(JI)*(PLSFACT(JI)-PLVFACT(JI))
+!--cb--
+ ELSE
+ P_TH_RIM(JI) = 0.
+ P_RC_RIMSS(JI) = 0.
+ P_RC_RIMSG(JI) = 0.
+ P_RS_RIMCG(JI) = 0.
+ Z_RC_RIM(JI) = 0.
+ P_CC_RIM(JI) = 0.
+ Z_RS_RIM(JI) = 0.
+ P_CS_RIM(JI) = 0.
+ Z_RG_RIM(JI) = 0.
+ END IF
!
!* Hallett-Mossop ice production (HMS)
! -----------------------------------
!
- IF ( PRST(JI)>XRTMIN(5) .AND. PRCT(JI)>XRTMIN(2) .AND. PT(JI)<XHMTMAX .AND. PT(JI)>XHMTMIN .AND. &
- PCST(JI)>XCTMIN(5) .AND. PCCT(JI)>XCTMIN(2) .AND. LDCOMPUTE(JI) ) THEN
-!
- ZVEC1(JI) = PLBDC(JI)
- ZVEC2(JI) = MAX( 1.0001, MIN( REAL(NGAMINC)-0.0001, &
- XHMLINTP1 * LOG( ZVEC1(JI) ) + XHMLINTP2 ) )
- IVEC2(JI) = INT( ZVEC2(JI) )
- ZVEC2(JI) = ZVEC2(JI) - REAL( IVEC2(JI) )
- ZVEC1(JI) = XGAMINC_HMC( IVEC2(JI)+1 )* ZVEC2(JI) &
- - XGAMINC_HMC( IVEC2(JI) )*(ZVEC2(JI) - 1.0)
- ZZW4(JI) = ZVEC1(JI) ! Large droplets
-!
- IF ( ZZW4(JI)<0.99 ) THEN
- P_CI_HMS(JI) = - P_RC_RIM(JI) * (PCCT(JI)/PRCT(JI)) * (1.0-ZZW4(JI)) * XHM_FACTS * &
- MAX( 0.0, MIN( (PT(JI)-XHMTMIN)/3.0,(XHMTMAX-PT(JI))/2.0 ) ) ! CCHMSI
-!
- P_RI_HMS(JI) = P_CI_HMS(JI) * XMNU0 ! RCHMSI
- P_RS_HMS(JI) = - P_RI_HMS(JI)
- ELSE
- P_RI_HMS(JI) = 0.
- P_CI_HMS(JI) = 0.
- P_RS_HMS(JI) = 0.
- END IF
- ELSE
+ IF ( PRST(JI)>XRTMIN(5) .AND. PRCT(JI)>XRTMIN(2) .AND. PT(JI)<XHMTMAX .AND. PT(JI)>XHMTMIN .AND. &
+ PCST(JI)>XCTMIN(5) .AND. PCCT(JI)>XCTMIN(2) .AND. LDCOMPUTE(JI) ) THEN
+!
+ ZVEC1(JI) = PLBDC(JI)
+ ZVEC2(JI) = MAX( 1.0001, MIN( REAL(NGAMINC)-0.0001, &
+ XHMLINTP1 * LOG( ZVEC1(JI) ) + XHMLINTP2 ) )
+ IVEC2(JI) = INT( ZVEC2(JI) )
+ ZVEC2(JI) = ZVEC2(JI) - REAL( IVEC2(JI) )
+ ZVEC1(JI) = XGAMINC_HMC( IVEC2(JI)+1 )* ZVEC2(JI) &
+ - XGAMINC_HMC( IVEC2(JI) )*(ZVEC2(JI) - 1.0)
+ ZZW4(JI) = ZVEC1(JI) ! Large droplets
+!
+ IF ( ZZW4(JI)<0.99 ) THEN
+ P_CI_HMS(JI) = - Z_RC_RIM(JI) * (PCCT(JI)/PRCT(JI)) * (1.0-ZZW4(JI)) * XHM_FACTS * &
+ MAX( 0.0, MIN( (PT(JI)-XHMTMIN)/3.0,(XHMTMAX-PT(JI))/2.0 ) ) ! CCHMSI
+!
+ P_RI_HMS(JI) = P_CI_HMS(JI) * XMNU0 ! RCHMSI
+ P_RS_HMS(JI) = - P_RI_HMS(JI)
+ ELSE
P_RI_HMS(JI) = 0.
P_CI_HMS(JI) = 0.
P_RS_HMS(JI) = 0.
- END IF
+ END IF
+ ELSE
+ P_RI_HMS(JI) = 0.
+ P_CI_HMS(JI) = 0.
+ P_RS_HMS(JI) = 0.
+ END IF
END DO
!
!-------------------------------------------------------------------------------
diff --git a/src/PHYEX/micro/mode_lima_ice_aggregation_snow.f90 b/src/PHYEX/micro/mode_lima_ice_aggregation_snow.f90
index c442ab8b02965cbbf95a0a20709632085783b02b..6097a688e663a38d0d722fd828ef85e9972a4d3f 100644
--- a/src/PHYEX/micro/mode_lima_ice_aggregation_snow.f90
+++ b/src/PHYEX/micro/mode_lima_ice_aggregation_snow.f90
@@ -10,6 +10,7 @@ CONTAINS
SUBROUTINE LIMA_ICE_AGGREGATION_SNOW (LDCOMPUTE, &
PT, PRHODREF, &
PRIT, PRST, PCIT, PCST, PLBDI, PLBDS, &
+ PLATHAM_IAGGS, &
P_RI_AGGS, P_CI_AGGS )
! #######################################################################
!
@@ -30,6 +31,7 @@ CONTAINS
! J. Wurtz 03/2022: new snow characteristics
! B. Vie 03/2022: Add option for 1-moment pristine ice
! M. Taufour 07/2022: add concentration for snow, graupel, hail
+! C. Barthe 06/2023: add Latham effect (Efield) for IAGGS
!
!-------------------------------------------------------------------------------
!
@@ -56,6 +58,7 @@ REAL, DIMENSION(:), INTENT(IN) :: PCIT
REAL, DIMENSION(:), INTENT(IN) :: PCST
REAL, DIMENSION(:), INTENT(IN) :: PLBDI
REAL, DIMENSION(:), INTENT(IN) :: PLBDS
+REAL, DIMENSION(:), INTENT(IN) :: PLATHAM_IAGGS
!
REAL, DIMENSION(:), INTENT(OUT) :: P_RI_AGGS
REAL, DIMENSION(:), INTENT(OUT) :: P_CI_AGGS
@@ -81,6 +84,7 @@ P_CI_AGGS(:) = 0.
IF (NMOM_I.EQ.1) THEN
WHERE ( PRIT(:)>XRTMIN(4) .AND. PRST(:)>XRTMIN(5) .AND. LDCOMPUTE(:) )
ZZW1(:) = XFIAGGS * EXP( XCOLEXIS*(PT(:)-XTT) ) &
+ * PLATHAM_IAGGS(:) &
* PRIT(:) &
* PCST(:) * (1+(XFVELOS/PLBDS(:))**XALPHAS)**(-XNUS+XEXIAGGS/XALPHAS) &
* PRHODREF(:)**(-XCEXVT+1.) &
diff --git a/src/PHYEX/micro/mode_lima_nucleation_procs.f90 b/src/PHYEX/micro/mode_lima_nucleation_procs.f90
index 58f9212cc92f27eeca5fb93952f8a5e476357ba9..7a70adf55443ad065d97e46b04548f0416f840d4 100644
--- a/src/PHYEX/micro/mode_lima_nucleation_procs.f90
+++ b/src/PHYEX/micro/mode_lima_nucleation_procs.f90
@@ -6,15 +6,17 @@
MODULE MODE_LIMA_NUCLEATION_PROCS
IMPLICIT NONE
CONTAINS
-! #############################################################################
+! ###############################################################################
SUBROUTINE LIMA_NUCLEATION_PROCS (D, CST, BUCONF, TBUDGETS, KBUDGETS, &
PTSTEP, PRHODJ, &
PRHODREF, PEXNREF, PPABST, PT, PDTHRAD, PW_NU, &
PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, PRHT, &
PCCT, PCRT, PCIT, &
PNFT, PNAT, PIFT, PINT, PNIT, PNHT, &
- PCLDFR, PICEFR, PPRCFR )
-! #############################################################################
+ PCLDFR, PICEFR, PPRCFR, &
+ PTOT_RV_HENU, PTOT_RC_HINC, PTOT_RI_HIND, &
+ PTOT_RV_HONH )
+! ###############################################################################
!
!! PURPOSE
!! -------
@@ -33,6 +35,7 @@ CONTAINS
! P. Wautelet 02/2020: use the new data structures and subroutines for budgets
! B. Vie 03/03/2020: use DTHRAD instead of dT/dt in Smax diagnostic computation
! B. Vie 03/2022: Add option for 1-moment pristine ice
+! C. Barthe 06/2022: add dummy arguments (mass transfer rates) for cloud electrication
!-------------------------------------------------------------------------------
!
USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
@@ -100,10 +103,16 @@ REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCLDFR ! Cloud fraction
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PICEFR ! Ice fraction
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PPRCFR ! Precipitation fraction
!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTOT_RV_HENU ! Mixing ratio change due to HENU
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTOT_RC_HINC ! Mixing ratio change due to HINC
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTOT_RI_HIND ! Mixing ratio change due to HIND
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTOT_RV_HONH ! Mixing ratio change due to HONH
+!
!-------------------------------------------------------------------------------
!
-REAL, DIMENSION(SIZE(PT,1),SIZE(PT,2),SIZE(PT,3)) :: Z_TH_HIND, Z_RI_HIND, Z_CI_HIND, Z_TH_HINC, Z_RC_HINC, Z_CC_HINC
-REAL, DIMENSION(SIZE(PT,1),SIZE(PT,2),SIZE(PT,3)) :: ZLSFACT, ZRVHENIMR
+!REAL, DIMENSION(SIZE(PT,1),SIZE(PT,2),SIZE(PT,3)) :: Z_TH_HIND, Z_RI_HIND, Z_CI_HIND, Z_TH_HINC, Z_RC_HINC, Z_CC_HINC
+REAL, DIMENSION(SIZE(PT,1),SIZE(PT,2),SIZE(PT,3)) :: Z_TH_HIND, Z_CI_HIND, Z_TH_HINC, Z_CC_HINC
+REAL, DIMENSION(SIZE(PT,1),SIZE(PT,2),SIZE(PT,3)) :: ZLSFACT, ZRVHENIMR
!
integer :: idx, jl
INTEGER :: JI,JJ
@@ -132,9 +141,11 @@ IF ( LACTI .AND. NMOD_CCN >=1 .AND. NMOM_C.GE.2) THEN
end if
end if
- CALL LIMA_CCN_ACTIVATION( CST, &
+ CALL LIMA_CCN_ACTIVATION( CST, &
PRHODREF, PEXNREF, PPABST, PT, PDTHRAD, PW_NU, &
- PTHT, PRVT, PRCT, PCCT, PRRT, PNFT, PNAT, PCLDFR )
+ PTHT, PRVT, PRCT, PCCT, PRRT, PNFT, PNAT, PCLDFR, &
+ PTOT_RV_HENU )
+
if ( BUCONF%lbu_enable ) then
if ( BUCONF%lbudget_th ) &
call BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_TH), 'HENU', ptht(:, :, :) * prhodj(:, :, :) / ptstep )
@@ -186,18 +197,18 @@ IF ( LNUCL .AND. NMOM_I>=2 .AND. .NOT.LMEYERS .AND. NMOD_IFN >= 1 ) THEN
PRHODREF, PEXNREF, PPABST, &
PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
PCCT, PCIT, PNAT, PIFT, PINT, PNIT, &
- Z_TH_HIND, Z_RI_HIND, Z_CI_HIND, &
- Z_TH_HINC, Z_RC_HINC, Z_CC_HINC, &
+ Z_TH_HIND, PTOT_RI_HIND, Z_CI_HIND, &
+ Z_TH_HINC, PTOT_RC_HINC, Z_CC_HINC, &
PICEFR )
WHERE(PICEFR(:,:,:)<1.E-10 .AND. PRIT(:,:,:)>XRTMIN(4) .AND. PCIT(:,:,:)>XCTMIN(4)) PICEFR(:,:,:)=1.
!
if ( BUCONF%lbu_enable ) then
if ( BUCONF%lbudget_th ) &
- call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_TH), 'HIND', z_th_hind(:, :, :) * prhodj(:, :, :) / ptstep )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_TH), 'HIND', z_th_hind(:, :, :) * prhodj(:, :, :) / ptstep )
if ( BUCONF%lbudget_rv ) &
- call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RV), 'HIND', -z_ri_hind(:, :, :) * prhodj(:, :, :) / ptstep )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RV), 'HIND', -ptot_ri_hind(:, :, :) * prhodj(:, :, :) / ptstep )
if ( BUCONF%lbudget_ri ) &
- call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RI), 'HIND', z_ri_hind(:, :, :) * prhodj(:, :, :) / ptstep )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RI), 'HIND', ptot_ri_hind(:, :, :) * prhodj(:, :, :) / ptstep )
if ( BUCONF%lbudget_sv ) then
call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1-1+nsv_lima_ni), 'HIND', z_ci_hind(:, :, :) * prhodj(:, :, :) / ptstep )
do jl = 1, nmod_ifn
@@ -209,11 +220,11 @@ IF ( LNUCL .AND. NMOM_I>=2 .AND. .NOT.LMEYERS .AND. NMOD_IFN >= 1 ) THEN
end if
if ( BUCONF%lbudget_th ) &
- call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_TH), 'HINC', z_th_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_TH), 'HINC', z_th_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
if ( BUCONF%lbudget_rc ) &
- call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RC), 'HINC', z_rc_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RC), 'HINC', ptot_rc_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
if ( BUCONF%lbudget_ri ) &
- call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RI), 'HINC', -z_rc_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RI), 'HINC', -ptot_rc_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
if ( BUCONF%lbudget_sv ) then
if (nmom_c.ge.2) then
call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1-1+nsv_lima_nc), 'HINC', z_cc_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
@@ -238,18 +249,18 @@ IF (LNUCL .AND. NMOM_I>=2 .AND. LMEYERS) THEN
PRHODREF, PEXNREF, PPABST, &
PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
PCCT, PCIT, PINT, &
- Z_TH_HIND, Z_RI_HIND, Z_CI_HIND, &
- Z_TH_HINC, Z_RC_HINC, Z_CC_HINC, &
+ Z_TH_HIND, PTOT_RI_HIND, Z_CI_HIND, &
+ Z_TH_HINC, PTOT_RC_HINC, Z_CC_HINC, &
PICEFR )
WHERE(PICEFR(:,:,:)<1.E-10 .AND. PRIT(:,:,:)>XRTMIN(4) .AND. PCIT(:,:,:)>XCTMIN(4)) PICEFR(:,:,:)=1.
!
if ( BUCONF%lbu_enable ) then
if ( BUCONF%lbudget_th ) &
- call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_TH), 'HIND', z_th_hind(:, :, :) * prhodj(:, :, :) / ptstep )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_TH), 'HIND', z_th_hind(:, :, :) * prhodj(:, :, :) / ptstep )
if ( BUCONF%lbudget_rv ) &
- call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RV), 'HIND', -z_ri_hind(:, :, :) * prhodj(:, :, :) / ptstep )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RV), 'HIND', -ptot_ri_hind(:, :, :) * prhodj(:, :, :) / ptstep )
if ( BUCONF%lbudget_ri ) &
- call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RI), 'HIND', z_ri_hind(:, :, :) * prhodj(:, :, :) / ptstep )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RI), 'HIND', ptot_ri_hind(:, :, :) * prhodj(:, :, :) / ptstep )
if ( BUCONF%lbudget_sv ) then
call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1-1+nsv_lima_ni), 'HIND', z_ci_hind(:, :, :) * prhodj(:, :, :) / ptstep )
if (nmod_ifn > 0 ) &
@@ -258,11 +269,11 @@ IF (LNUCL .AND. NMOM_I>=2 .AND. LMEYERS) THEN
end if
if ( BUCONF%lbudget_th ) &
- call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_TH), 'HINC', z_th_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_TH), 'HINC', z_th_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
if ( BUCONF%lbudget_rc ) &
- call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RC), 'HINC', z_rc_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RC), 'HINC', ptot_rc_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
if ( BUCONF%lbudget_ri ) &
- call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RI), 'HINC', -z_rc_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RI), 'HINC', -ptot_rc_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
if ( BUCONF%lbudget_sv ) then
if (nmom_c.ge.2) then
call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1-1+nsv_lima_nc), 'HINC', z_cc_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
@@ -277,6 +288,8 @@ END IF
!
!-------------------------------------------------------------------------------
!
+!++cb-- pour l'instant, on ne recupere pas cette tendance
+! actuellement, les echanges vapeur-->glace/eau lies a la nucleation ne sont pas traites dans l'electrisation
IF (LNUCL .AND. NMOM_I.EQ.1) THEN
WHERE(PICEFR(:,:,:)<1.E-10 .AND. PRIT(:,:,:)>XRTMIN(4) .AND. PCIT(:,:,:)>XCTMIN(4)) PICEFR(:,:,:)=1.
!
@@ -357,7 +370,7 @@ IF ( LNUCL .AND. LHHONI .AND. NMOD_CCN >= 1 .AND. NMOM_I.GE.2) THEN
CALL LIMA_CCN_HOM_FREEZING (CST, PRHODREF, PEXNREF, PPABST, PW_NU, &
PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
PCCT, PCRT, PCIT, PNFT, PNHT, &
- PICEFR )
+ PICEFR, PTOT_RV_HONH )
WHERE(PICEFR(:,:,:)<1.E-10 .AND. PRIT(:,:,:)>XRTMIN(4) .AND. PCIT(:,:,:)>XCTMIN(4)) PICEFR(:,:,:)=1.
!
if ( BUCONF%lbu_enable ) then
diff --git a/src/PHYEX/micro/mode_lima_rain_accr_snow.f90 b/src/PHYEX/micro/mode_lima_rain_accr_snow.f90
index 6c83bf6cd49554c08f21caed8d9d6258be9d5fd5..e7ee26f7e5bccf8d571eae3b7639011b2fe16042 100644
--- a/src/PHYEX/micro/mode_lima_rain_accr_snow.f90
+++ b/src/PHYEX/micro/mode_lima_rain_accr_snow.f90
@@ -6,12 +6,16 @@
MODULE MODE_LIMA_RAIN_ACCR_SNOW
IMPLICIT NONE
CONTAINS
-! ###################################################################################
- SUBROUTINE LIMA_RAIN_ACCR_SNOW (PTSTEP, LDCOMPUTE, &
- PRHODREF, PT, &
- PRRT, PCRT, PRST, PCST, PLBDR, PLBDS, PLVFACT, PLSFACT, &
- P_TH_ACC, P_RR_ACC, P_CR_ACC, P_RS_ACC, P_CS_ACC, P_RG_ACC )
-! ###################################################################################
+! ######################################################################################
+ SUBROUTINE LIMA_RAIN_ACCR_SNOW (PTSTEP, LDCOMPUTE, &
+ PRHODREF, PT, &
+ PRRT, PCRT, PRST, PCST, PLBDR, PLBDS, PLVFACT, PLSFACT, &
+!++cb++
+! P_TH_ACC, P_RR_ACC, P_CR_ACC, P_RS_ACC, P_CS_ACC, P_RG_ACC )
+ P_TH_ACC, P_CR_ACC, P_CS_ACC, &
+ P_RR_ACCSS, P_RR_ACCSG, P_RS_ACCRG )
+!--cb--
+! ######################################################################################
!
!! PURPOSE
!! -------
@@ -30,6 +34,9 @@ CONTAINS
!! Original 15/03/2018
! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
! J. Wurtz 03/2022: new snow characteristics
+! C. Barthe 04/07/2022: modify the microphysics terms to save to simplify the merging
+! with the electrification scheme
+! QUESTION : ne fonctionne pas si NMOM_R=1 ???
!
!-------------------------------------------------------------------------------
!
@@ -68,12 +75,17 @@ REAL, DIMENSION(:), INTENT(IN) :: PLBDS !
REAL, DIMENSION(:), INTENT(IN) :: PLVFACT !
REAL, DIMENSION(:), INTENT(IN) :: PLSFACT !
!
+!++cb++
REAL, DIMENSION(:), INTENT(OUT) :: P_TH_ACC
-REAL, DIMENSION(:), INTENT(OUT) :: P_RR_ACC
+!REAL, DIMENSION(:), INTENT(OUT) :: P_RR_ACC
REAL, DIMENSION(:), INTENT(OUT) :: P_CR_ACC
-REAL, DIMENSION(:), INTENT(OUT) :: P_RS_ACC
+!REAL, DIMENSION(:), INTENT(OUT) :: P_RS_ACC
REAL, DIMENSION(:), INTENT(OUT) :: P_CS_ACC
-REAL, DIMENSION(:), INTENT(OUT) :: P_RG_ACC
+!REAL, DIMENSION(:), INTENT(OUT) :: P_RG_ACC
+REAL, DIMENSION(:), INTENT(OUT) :: P_RR_ACCSS
+REAL, DIMENSION(:), INTENT(OUT) :: P_RR_ACCSG
+REAL, DIMENSION(:), INTENT(OUT) :: P_RS_ACCRG
+!--cb--
!
!* 0.2 Declarations of local variables :
!
@@ -85,15 +97,22 @@ REAL, DIMENSION(SIZE(PRRT)) :: ZZWC1, ZZWC2, ZZWC3, ZZWC4, ZZWC5
!
INTEGER, DIMENSION(SIZE(PRRT)) :: IVEC1,IVEC2 ! Vectors of indices
REAL, DIMENSION(SIZE(PRRT)) :: ZVEC1,ZVEC2,ZVEC3 ! Work vectors
+REAL, DIMENSION(SIZE(PRRT)) :: Z_RR_ACC ! ++cb-- for elec
!
!-------------------------------------------------------------------------------
!
-!
+!++cb++
P_TH_ACC(:) = 0.
-P_RR_ACC(:) = 0.
+!P_RR_ACC(:) = 0.
P_CR_ACC(:) = 0.
-P_RS_ACC(:) = 0.
-P_RG_ACC(:) = 0.
+P_CS_ACC(:) = 0.
+!P_RS_ACC(:) = 0.
+!P_RG_ACC(:) = 0.
+P_RR_ACCSS(:) = 0.
+P_RR_ACCSG(:) = 0.
+P_RS_ACCRG(:) = 0.
+Z_RR_ACC(:) = 0.
+!--cb--
!
ZZW1(:) = 0.
ZZW2(:) = 0.
@@ -268,12 +287,19 @@ WHERE( GACC )
XLBNSACCR2/( PLBDR(:) * PLBDS(:) ) + &
XLBNSACCR3/( PLBDS(:)**2 ) )
!
- P_RR_ACC(:) = - ZZW4(:) * ZZW2(:)
+!++cb++
+ Z_RR_ACC(:) = - ZZW4(:) * ZZW2(:) ! < 0
+! P_RR_ACC(:) = - ZZW4(:) * ZZW2(:)
P_CR_ACC(:) = - ZZWC4(:) * ZZWC2(:)
- P_RS_ACC(:) = ZZW4(:) * ZZW1(:) - ZZW5(:)
+! P_RS_ACC(:) = ZZW4(:) * ZZW1(:) - ZZW5(:)
P_CS_ACC(:) = - ZZWC5(:)
- P_RG_ACC(:) = ZZW4(:) * ( ZZW2(:) - ZZW1(:) ) + ZZW5(:)
- P_TH_ACC(:) = - P_RR_ACC(:) * (PLSFACT(:)-PLVFACT(:))
+! P_RG_ACC(:) = ZZW4(:) * ( ZZW2(:) - ZZW1(:) ) + ZZW5(:)
+ P_RR_ACCSS(:) = ZZW4(:) * ZZW1(:) ! perte pour rr, > 0
+ P_RR_ACCSG(:) = ZZW4(:) * ( ZZW2(:) - ZZW1(:) ) ! rraccsg = rraccs - rraccss
+ P_RS_ACCRG(:) = ZZW5(:) ! perte pour rs, > 0
+! P_TH_ACC(:) = - P_RR_ACC(:) * (PLSFACT(:)-PLVFACT(:))
+ P_TH_ACC(:) = - Z_RR_ACC(:) * (PLSFACT(:)-PLVFACT(:))
+!--cb--
!
END WHERE
!
diff --git a/src/PHYEX/micro/mode_lima_sedimentation.f90 b/src/PHYEX/micro/mode_lima_sedimentation.f90
index 1efeb31919684052c0a3fe5ba224450e668fb0e9..9c59f23d3b7e454a9081897e019db570bacff274 100644
--- a/src/PHYEX/micro/mode_lima_sedimentation.f90
+++ b/src/PHYEX/micro/mode_lima_sedimentation.f90
@@ -8,8 +8,10 @@ MODULE MODE_LIMA_SEDIMENTATION
CONTAINS
! ######################################################################
SUBROUTINE LIMA_SEDIMENTATION (D, CST, &
- HPHASE, KMOMENTS, KID, KSPLITG, PTSTEP, PDZZ, PRHODREF, &
- PPABST, PT, PRT_SUM, PCPT, PRS, PCS, PINPR, PFPR )
+ HPHASE, KMOMENTS, KID, KSPLITG, PTSTEP, OELEC, &
+ PDZZ, PRHODREF, &
+ PPABST, PT, PRT_SUM, PCPT, PRS, PCS, PINPR, PFPR, &
+ PEFIELDW, PQS)
! ######################################################################
!
!! PURPOSE
@@ -40,6 +42,8 @@ CONTAINS
! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90
! B. Vie 03/2020: disable temperature change of droplets by air temperature
! J. Wurtz 03/2022: new snow characteristics
+! C. Barthe 03/06/2022: add sedimentation for electric charges
+! C. Barthe 02/06/2023: add the Beard effect (electric field)
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -47,16 +51,22 @@ CONTAINS
!
USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
USE MODD_CST, ONLY: CST_t
+USE MODD_ELEC_DESCR, ONLY: LSEDIM_BEARD
+USE MODD_ELEC_PARAM, ONLY: XFQSED, XDQ
USE MODD_PARAM_LIMA, ONLY: XCEXVT, XRTMIN, XCTMIN, NSPLITSED, &
XLB, XLBEX, XD, XFSEDR, XFSEDC, &
XALPHAC, XNUC, XALPHAS, XNUS, LSNOW_T, &
NMOM_S
-USE MODD_PARAM_LIMA_COLD, ONLY: XLBDAS_MAX, XBS, &
- XLBDAS_MIN, XTRANS_MP_GAMMAS, XFVELOS
+USE MODD_PARAM_LIMA_COLD, ONLY: XLBEXI, XLBI, XDI, XLBDAS_MAX, XBS, XEXSEDS, &
+ XLBDAS_MIN, XTRANS_MP_GAMMAS, XFVELOS, &
+ XCCS, XCXS
+USE MODD_PARAM_LIMA_MIXED, ONLY: XCCG, XCXG, XCCH, XCXH
use mode_tools, only: Countjv
USE MODI_GAMMA, ONLY: GAMMA_X0D
+USE MODI_ELEC_COMPUTE_EX
+USE MODE_ELEC_BEARD_EFFECT, ONLY: ELEC_BEARD_EFFECT
!
IMPLICIT NONE
!
@@ -68,7 +78,8 @@ CHARACTER(1), INTENT(IN) :: HPHASE ! Liquid or solid hydromete
INTEGER, INTENT(IN) :: KMOMENTS ! Number of moments
INTEGER, INTENT(IN) :: KID ! Hydrometeor ID
INTEGER, INTENT(IN) :: KSPLITG !
-REAL, INTENT(IN) :: PTSTEP ! Time step
+REAL, INTENT(IN) :: PTSTEP ! Time step
+LOGICAL, INTENT(IN) :: OELEC ! if true, cloud electrification is activated
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! Height (z)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Reference density
REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! abs. pressure at time t
@@ -79,6 +90,8 @@ REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRS ! m.r. source
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCS ! C. source
REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPR ! Instant precip rate
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PFPR ! Precip. fluxes in altitude
+REAL, DIMENSION(:,:,:), INTENT(IN), OPTIONAL :: PEFIELDW ! Vertical component of the electric field
+REAL, DIMENSION(:,:,:), INTENT(INOUT), OPTIONAL :: PQS ! Elec. charge density source
!
!* 0.2 Declarations of local variables :
!
@@ -110,12 +123,21 @@ INTEGER , DIMENSION(SIZE(PRHODREF)) :: I1,I2,I3 ! Indexes for PACK replacement
!
REAL :: ZTSPLITG ! Small time step for rain sedimentation
REAL :: ZC ! Cpl or Cpi
-INTEGER :: ZMOMENTS
+INTEGER :: IMOMENTS
!
+! Variables for cloud electricity
+REAL :: ZCX, ZXX ! C and x parameters for N-lambda relationship
+REAL, DIMENSION(:), ALLOCATABLE :: ZQS, & ! Electric charge density source
+ ZZQ, & ! Work array
+ ZES ! e in q-D relationship
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZWSEDQ ! Sedimentation of electric charge density
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZLBDA3
+REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) :: ZBEARDCOEFF ! effect of
+ ! electrical forces on terminal fall speed
!
!-------------------------------------------------------------------------------
!
-ZMOMENTS=KMOMENTS
+IMOMENTS=KMOMENTS
!
! Time splitting
!
@@ -128,6 +150,7 @@ ZWSEDC(:,:,:) = 0.
!
PRS(:,:,:) = PRS(:,:,:) * PTSTEP
IF (KMOMENTS==2) PCS(:,:,:) = PCS(:,:,:) * PTSTEP
+IF (OELEC) PQS(:,:,:) = PQS(:,:,:) * PTSTEP
DO JK = D%NKTB , D%NKTE
ZW(:,:,JK)=ZTSPLITG/PDZZ(:,:,JK)
END DO
@@ -135,8 +158,10 @@ END DO
IF (HPHASE=='L') ZC=CST%XCL
IF (HPHASE=='I') ZC=CST%XCI
!
-IF (KID==4 .AND. ZMOMENTS==1) THEN
- ZMOMENTS=2
+! When pristine ice is 1-moment, nb concentration is parameterized following
+! McFarquhar and Heymsfield (1997) for columns as in ICE3
+IF (KID==4 .AND. IMOMENTS==1) THEN
+ IMOMENTS=2
WHERE(PRS(:,:,:)>0) PCS(:,:,:)=1/(4*CST%XPI*900.) * PRS(:,:,:) * &
MAX(0.05E6,-0.15319E6-0.021454E6*ALOG(PRHODREF(:,:,:)*PRS(:,:,:)))**3
END IF
@@ -149,7 +174,7 @@ DO JN = 1 , NSPLITSED(KID)
! Computation only where enough ice, snow, graupel or hail
GSEDIM(:,:,:) = .FALSE.
GSEDIM(D%NIB:D%NIE,D%NJB:D%NJE,D%NKTB:D%NKTE) = PRS(D%NIB:D%NIE,D%NJB:D%NJE,D%NKTB:D%NKTE)>XRTMIN(KID)
- IF (ZMOMENTS==2) GSEDIM(:,:,:) = GSEDIM(:,:,:) .AND. PCS(:,:,:)>XCTMIN(KID)
+ IF (IMOMENTS==2) GSEDIM(:,:,:) = GSEDIM(:,:,:) .AND. PCS(:,:,:)>XCTMIN(KID)
ISEDIM = COUNTJV( GSEDIM(:,:,:),I1(:),I2(:),I3(:))
!
IF( ISEDIM >= 1 ) THEN
@@ -164,15 +189,24 @@ DO JN = 1 , NSPLITSED(KID)
ALLOCATE(ZZW(ISEDIM)) ; ZZW(:) = 0.0
ALLOCATE(ZZX(ISEDIM)) ; ZZX(:) = 0.0
ALLOCATE(ZZY(ISEDIM)) ; ZZY(:) = 0.0
+ !
+ IF (OELEC) THEN
+ ALLOCATE(ZWSEDQ(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3))) ; ZWSEDQ(:,:,:) = 0.
+ ALLOCATE(ZES(ISEDIM)) ; ZES(:) = 0.0
+ ALLOCATE(ZQS(ISEDIM)) ; ZQS(:) = 0.0
+ ALLOCATE(ZZQ(ISEDIM)) ; ZZQ(:) = 0.0
+ END IF
!
DO JL = 1,ISEDIM
ZRHODREF(JL) = PRHODREF(I1(JL),I2(JL),I3(JL))
ZPABST(JL) = PPABST(I1(JL),I2(JL),I3(JL))
ZT(JL) = PT(I1(JL),I2(JL),I3(JL))
ZRS(JL) = PRS(I1(JL),I2(JL),I3(JL))
- IF (ZMOMENTS==2) ZCS(JL) = PCS(I1(JL),I2(JL),I3(JL))
+ IF (IMOMENTS==2) ZCS(JL) = PCS(I1(JL),I2(JL),I3(JL))
+ IF (OELEC) ZQS(JL) = PQS(I1(JL),I2(JL),I3(JL))
END DO
!
+! Compute lambda
IF (KID == 5 .AND. NMOM_S.EQ.1 .AND. LSNOW_T) THEN
ZLBDA(:) = 1.E10
WHERE(ZT(:)>263.15 .AND. ZRS(:)>XRTMIN(5))
@@ -185,8 +219,8 @@ DO JN = 1 , NSPLITSED(KID)
ZZW(:) = XFSEDR(KID) * ZRHODREF(:)**(1.-XCEXVT)*ZRS(:)* &
(1 + (XFVELOS/ZLBDA(:))**XALPHAS)**(-XNUS-(XD(KID)+XBS)/XALPHAS) * ZLBDA(:)**(-XD(KID))
ELSE
- IF (ZMOMENTS==1) ZLBDA(:) = XLB(KID) * ( ZRHODREF(:) * ZRS(:) )**XLBEX(KID)
- IF (ZMOMENTS==2) ZLBDA(:) = ( XLB(KID)*ZCS(:) / ZRS(:) )**XLBEX(KID)
+ IF (IMOMENTS==1) ZLBDA(:) = XLB(KID) * ( ZRHODREF(:) * ZRS(:) )**XLBEX(KID)
+ IF (IMOMENTS==2) ZLBDA(:) = ( XLB(KID)*ZCS(:) / ZRS(:) )**XLBEX(KID)
ZZY(:) = ZRHODREF(:)**(-XCEXVT) * ZLBDA(:)**(-XD(KID))
IF (LSNOW_T .AND. KID==5) &
ZZY(:) = ZZY(:) * (1 + (XFVELOS/ZLBDA(:))**XALPHAS)**(-XNUS-(XD(KID)+XBS)/XALPHAS)
@@ -196,20 +230,73 @@ DO JN = 1 , NSPLITSED(KID)
IF (KMOMENTS==2) ZZX(:) = XFSEDC(KID) * ZCS(:) * ZZY(:) * ZRHODREF(:)
IF (KID==2) THEN
+ ! mean cloud droplet diameter
ZCC(:) = 0.5*GAMMA_X0D(XNUC+1./XALPHAC)/(GAMMA_X0D(XNUC)*ZLBDA(:))
+ ! correction factor for cloud droplet terminal fall speed
ZCC(:) = 1.+1.26*6.6E-8*(101325./ZPABST(:))*(ZT(:)/293.15)/ZCC(:)
ZZW(:) = ZCC(:) * ZZW(:)
ZZX(:) = ZCC(:) * ZZX(:)
END IF
-
+!
+! If the electrical scheme is activated, the electric field can impact the sedimentation
+ ZBEARDCOEFF(:,:,:) = 1.0
+ IF (OELEC .AND. LSEDIM_BEARD) THEN
+ ALLOCATE(ZLBDA3(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)))
+ ZLBDA3(:,:,:) = UNPACK( ZLBDA(:),MASK=GSEDIM(:,:,:),FIELD=0.0 )
+ CALL ELEC_BEARD_EFFECT(D, KID, GSEDIM, PT, PRHODREF, &
+ PRS, PQS, PEFIELDW, ZLBDA3, ZBEARDCOEFF)
+ DEALLOCATE(ZLBDA3)
+ END IF
+!
ZWSEDR(:,:,1:D%NKT) = UNPACK( ZZW(:),MASK=GSEDIM(:,:,:),FIELD=0.0 )
- ZWSEDR(:,:,D%NKTB:D%NKTE) = MIN( ZWSEDR(:,:,D%NKTB:D%NKTE), PRS(:,:,D%NKTB:D%NKTE) &
- * PRHODREF(:,:,D%NKTB:D%NKTE) / ZW(:,:,D%NKTB:D%NKTE) )
+ ZWSEDR(:,:,D%NKTB:D%NKTE) = MIN( ZWSEDR(:,:,D%NKTB:D%NKTE) * ZBEARDCOEFF(:,:,D%NKTB:D%NKTE), &
+ PRS(:,:,D%NKTB:D%NKTE) * PRHODREF(:,:,D%NKTB:D%NKTE) / &
+ ZW(:,:,D%NKTB:D%NKTE) )
IF (KMOMENTS==2) THEN
ZWSEDC(:,:,1:D%NKT) = UNPACK( ZZX(:),MASK=GSEDIM(:,:,:),FIELD=0.0 )
- ZWSEDC(:,:,D%NKTB:D%NKTE) = MIN( ZWSEDC(:,:,D%NKTB:D%NKTE), PCS(:,:,D%NKTB:D%NKTE) &
- * PRHODREF(:,:,D%NKTB:D%NKTE) / ZW(:,:,D%NKTB:D%NKTE) )
+ ZWSEDC(:,:,D%NKTB:D%NKTE) = MIN( ZWSEDC(:,:,D%NKTB:D%NKTE) * ZBEARDCOEFF(:,:,D%NKTB:D%NKTE), &
+ PCS(:,:,D%NKTB:D%NKTE) * PRHODREF(:,:,D%NKTB:D%NKTE) / &
+ ZW(:,:,D%NKTB:D%NKTE) )
END IF
+!
+! Sedimentation of electric charges
+ IF (OELEC) THEN
+ ! compute e of the q-D relationship
+ IF (IMOMENTS == 2) THEN ! 2-moment species
+ CALL ELEC_COMPUTE_EX (KID, IMOMENTS, ISEDIM, PTSTEP, ZRHODREF, XRTMIN(KID), &
+ ZRS, ZQS, ZES, PLBDX=ZLBDA, PCX=ZCS)
+ ELSE ! 1-moment species
+ CALL ELEC_COMPUTE_EX (KID, IMOMENTS, ISEDIM, PTSTEP, ZRHODREF, XRTMIN(KID), &
+ ZRS, ZQS, ZES, PLBDX=ZLBDA)
+ END IF
+ !
+ ! number concentration for 1-moment species
+ ! for precipitating hydrometeors, N=C\lambda^x, except for snow if lsnow_t=t
+ IF (IMOMENTS == 1) THEN
+ IF (KID == 5) THEN
+ ZCX = XCCS
+ ZXX = XCXS
+ ELSE IF (KID == 6) THEN
+ ZCX = XCCG
+ ZXX = XCXG
+ ELSE IF (KID == 7) THEN
+ ZCX = XCCH
+ ZXX = XCXH
+ END IF
+ ZCS(:) = ZCX * ZLBDA(:)**ZXX
+ END IF
+ !
+ ZZQ(:) = ZRHODREF(:)**(1.-XCEXVT) * ZES(:) * ZCS(:) * XFQSED(KID) * ZLBDA(:)**(-XDQ(KID))
+ !
+ ! correction for cloud droplet terminal fall speed
+ IF (KID == 2) ZZQ(:) = ZZQ(:) * ZCC(:)
+ !
+ ZWSEDQ(:,:,1:D%NKT) = UNPACK( ZZQ(:),MASK=GSEDIM(:,:,:),FIELD=0.0 )
+ ZWSEDQ(:,:,1:D%NKT) = ZWSEDQ(:,:,1:D%NKT) * ZBEARDCOEFF(:,:,1:D%NKT)
+ ZWSEDQ(:,:,D%NKTB:D%NKTE) = SIGN(MIN(ABS(ZWSEDQ(:,:,D%NKTB:D%NKTE)), &
+ ABS(PQS(:,:,D%NKTB:D%NKTE)*PRHODREF(:,:,D%NKTB:D%NKTE)/ZW(:,:,D%NKTB:D%NKTE))), &
+ ZWSEDQ(:,:,D%NKTB:D%NKTE))
+ END IF
DO JK = D%NKTB , D%NKTE
PRS(:,:,JK) = PRS(:,:,JK) + ZW(:,:,JK)* &
@@ -226,7 +313,11 @@ DO JN = 1 , NSPLITSED(KID)
! ZW(:,:,JK)*ZWSEDR(:,:,JK+1)*ZC*PT(:,:,JK+D%NKL)) / &
! (PRHODREF(:,:,JK+D%NKL)*(1.+PRT_SUM(:,:,JK))*PCPT(:,:,JK) + ZW(:,:,JK)*ZWSEDR(:,:,JK+D%NKL)*ZC)
!ZWDT(:,:,JK) = ZWDT(:,:,JK) - PT(:,:,JK)
+ IF (OELEC) PQS(:,:,JK) = PQS(:,:,JK) + ZW(:,:,JK) * &
+ (ZWSEDQ(:,:,JK+D%NKL) - ZWSEDQ(:,:,JK)) / PRHODREF(:,:,JK)
+
END DO
+ !
DEALLOCATE(ZRHODREF)
DEALLOCATE(ZPABST)
DEALLOCATE(ZT)
@@ -237,6 +328,10 @@ DO JN = 1 , NSPLITSED(KID)
DEALLOCATE(ZZW)
DEALLOCATE(ZZX)
DEALLOCATE(ZZY)
+ IF (ALLOCATED(ZWSEDQ)) DEALLOCATE(ZWSEDQ)
+ IF (ALLOCATED(ZQS)) DEALLOCATE(ZQS)
+ IF (ALLOCATED(ZZQ)) DEALLOCATE(ZZQ)
+ IF (ALLOCATED(ZES)) DEALLOCATE(ZES)
!
PINPR(:,:) = PINPR(:,:) + ZWSEDR(:,:,D%NKB)/CST%XRHOLW/NSPLITSED(KID) ! in m/s
!PT(:,:,:) = PT(:,:,:) + ZWDT(:,:,:)
@@ -246,6 +341,7 @@ END DO
!
PRS(:,:,:) = PRS(:,:,:) / PTSTEP
IF (KMOMENTS==2) PCS(:,:,:) = PCS(:,:,:) / PTSTEP
+IF (OELEC) PQS(:,:,:) = PQS(:,:,:) / PTSTEP
!
END SUBROUTINE LIMA_SEDIMENTATION
END MODULE MODE_LIMA_SEDIMENTATION
diff --git a/src/PHYEX/micro/mode_lima_tendencies.f90 b/src/PHYEX/micro/mode_lima_tendencies.f90
index cbfde662f9a2a3c67c487e313b5199da0dd7ebc1..eb06801c43352dac5bb1388e4b719bc6c9d31e41 100644
--- a/src/PHYEX/micro/mode_lima_tendencies.f90
+++ b/src/PHYEX/micro/mode_lima_tendencies.f90
@@ -25,9 +25,13 @@ CONTAINS
P_RI_AGGS, P_CI_AGGS, &
P_TH_DEPG, P_RG_DEPG, &
P_TH_BERFI, P_RC_BERFI, &
- P_TH_RIM, P_RC_RIM, P_CC_RIM, P_RS_RIM, P_CS_RIM, P_RG_RIM, &
+!++cb++
+! P_TH_RIM, P_RC_RIM, P_CC_RIM, P_RS_RIM, P_CS_RIM, P_RG_RIM, &
+ P_TH_RIM, P_CC_RIM, P_CS_RIM, P_RC_RIMSS, P_RC_RIMSG, P_RS_RIMCG, &
P_RI_HMS, P_CI_HMS, P_RS_HMS, &
- P_TH_ACC, P_RR_ACC, P_CR_ACC, P_RS_ACC, P_CS_ACC, P_RG_ACC, &
+! P_TH_ACC, P_RR_ACC, P_CR_ACC, P_RS_ACC, P_CS_ACC, P_RG_ACC, &
+ P_TH_ACC, P_CR_ACC, P_CS_ACC, P_RR_ACCSS, P_RR_ACCSG, P_RS_ACCRG, &
+!--cb--
P_RS_CMEL, P_CS_CMEL, &
P_TH_CFRZ, P_RR_CFRZ, P_CR_CFRZ, P_RI_CFRZ, P_CI_CFRZ, &
P_RI_CIBU, P_CI_CIBU, &
@@ -46,7 +50,8 @@ CONTAINS
PA_TH, PA_RV, PA_RC, PA_CC, PA_RR, PA_CR, &
PA_RI, PA_CI, PA_RS, PA_CS, PA_RG, PA_CG, PA_RH, PA_CH, &
PEVAP3D, &
- PCF1D, PIF1D, PPF1D )
+ PCF1D, PIF1D, PPF1D, &
+ PLATHAM_IAGGS )
! ######################################################################
!!
!! PURPOSE
@@ -65,6 +70,8 @@ CONTAINS
! Delbeke/Vie 03/2022 : KHKO option
! J. Wurtz 03/2022 : new snow characteristics
! B. Vie 03/2022: Add option for 1-moment pristine ice
+! C. Barthe 06/2022: change some mass transfer rates to be consistent with ICE3, for cloud electrification
+! C. Barthe 06/2023: add Latham effet for IAGGS
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -171,23 +178,33 @@ REAL, DIMENSION(:), INTENT(INOUT) :: P_RG_DEPG ! deposition of vapor on graup
REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_BERFI
REAL, DIMENSION(:), INTENT(INOUT) :: P_RC_BERFI ! Bergeron (BERFI) : rc, ri=-rc, th
!
+!++cb++
REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_RIM
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RC_RIM
+!REAL, DIMENSION(:), INTENT(INOUT) :: P_RC_RIM
REAL, DIMENSION(:), INTENT(INOUT) :: P_CC_RIM
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RS_RIM
+!REAL, DIMENSION(:), INTENT(INOUT) :: P_RS_RIM
REAL, DIMENSION(:), INTENT(INOUT) :: P_CS_RIM
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RG_RIM ! cloud droplet riming (RIM) : rc, Nc, rs, rg, th
+!REAL, DIMENSION(:), INTENT(INOUT) :: P_RG_RIM ! cloud droplet riming (RIM) : rc, Nc, rs, rg, th
+REAL, DIMENSION(:), INTENT(INOUT) :: P_RC_RIMSS
+REAL, DIMENSION(:), INTENT(INOUT) :: P_RC_RIMSG
+REAL, DIMENSION(:), INTENT(INOUT) :: P_RS_RIMCG ! cloud droplet riming (RIM) : rc, Nc, rs, rg, th
+!--cb--
!
REAL, DIMENSION(:), INTENT(INOUT) :: P_RI_HMS
REAL, DIMENSION(:), INTENT(INOUT) :: P_CI_HMS
REAL, DIMENSION(:), INTENT(INOUT) :: P_RS_HMS ! hallett mossop snow (HMS) : ri, Ni, rs
!
+!++cb++
REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_ACC
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RR_ACC
+!REAL, DIMENSION(:), INTENT(INOUT) :: P_RR_ACC
REAL, DIMENSION(:), INTENT(INOUT) :: P_CR_ACC
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RS_ACC
+!REAL, DIMENSION(:), INTENT(INOUT) :: P_RS_ACC
REAL, DIMENSION(:), INTENT(INOUT) :: P_CS_ACC
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RG_ACC ! rain accretion on aggregates (ACC) : rr, Nr, rs, Ns, rg, Ng=-Ns, th
+!REAL, DIMENSION(:), INTENT(INOUT) :: P_RG_ACC ! rain accretion on aggregates (ACC) : rr, Nr, rs, Ns, rg, Ng=-Ns, th
+REAL, DIMENSION(:), INTENT(INOUT) :: P_RR_ACCSS
+REAL, DIMENSION(:), INTENT(INOUT) :: P_RR_ACCSG
+REAL, DIMENSION(:), INTENT(INOUT) :: P_RS_ACCRG ! rain accretion on aggregates (ACC) : rr, Nr, rs, rg, th
+!--cb--
!
REAL, DIMENSION(:), INTENT(INOUT) :: P_RS_CMEL
REAL, DIMENSION(:), INTENT(INOUT) :: P_CS_CMEL ! conversion-melting (CMEL) : rs, Ns, rg=-rs, Ng=-Ns
@@ -282,6 +299,8 @@ REAL, DIMENSION(:), INTENT(IN) :: PCF1D
REAL, DIMENSION(:), INTENT(IN) :: PIF1D
REAL, DIMENSION(:), INTENT(IN) :: PPF1D
!
+REAL, DIMENSION(:), INTENT(IN) :: PLATHAM_IAGGS ! factor to account for the effect of Efield on IAGGS
+!
!* 0.2 Declarations of local variables :
!
REAL, DIMENSION(SIZE(PRCT)) :: ZT
@@ -647,6 +666,7 @@ IF (NMOM_I.GE.1 .AND. NMOM_S.GE.1) THEN
CALL LIMA_ICE_AGGREGATION_SNOW (LDCOMPUTE, & ! depends on IF, PF
ZT, PRHODREF, &
ZRIT/ZIF1D, ZRST/ZPF1D, PCIT/ZIF1D, PCST/ZPF1D, ZLBDI, ZLBDS, &
+ PLATHAM_IAGGS, &
P_RI_AGGS, P_CI_AGGS )
P_CI_AGGS(:) = P_CI_AGGS(:) * ZIF1D(:)
P_RI_AGGS(:) = P_RI_AGGS(:) * ZIF1D(:)
@@ -686,53 +706,71 @@ IF (NMOM_C.GE.1 .AND. NMOM_S.GE.1) THEN
! Graupel production as tendency (or should be tendency + instant to stick to the previous version ?)
! Includes the Hallett Mossop process for riming of droplets by snow (HMS)
!
+!++cb++
CALL LIMA_DROPLETS_RIMING_SNOW (PTSTEP, LDCOMPUTE, & ! depends on CF
PRHODREF, ZT, &
ZRCT/ZCF1D, PCCT/ZCF1D, ZRST/ZPF1D, PCST/ZPF1D, ZLBDC, ZLBDS, ZLVFACT, ZLSFACT, &
- P_TH_RIM, P_RC_RIM, P_CC_RIM, P_RS_RIM, P_CS_RIM, P_RG_RIM, &
+! P_TH_RIM, P_RC_RIM, P_CC_RIM, P_RS_RIM, P_CS_RIM, P_RG_RIM, &
+ P_TH_RIM, P_CC_RIM, P_CS_RIM, P_RC_RIMSS, P_RC_RIMSG, P_RS_RIMCG, &
P_RI_HMS, P_CI_HMS, P_RS_HMS )
- P_RC_RIM(:) = P_RC_RIM(:) * ZCF1D(:)
+! P_RC_RIM(:) = P_RC_RIM(:) * ZCF1D(:)
P_CC_RIM(:) = P_CC_RIM(:) * ZCF1D(:)
- P_RS_RIM(:) = P_RS_RIM(:) * ZCF1D(:)
+! P_RS_RIM(:) = P_RS_RIM(:) * ZCF1D(:)
P_CS_RIM(:) = P_CS_RIM(:) * ZCF1D(:)
- P_RG_RIM(:) = P_RG_RIM(:) * ZCF1D(:)
- P_TH_RIM(:) = - P_RC_RIM(:) * (ZLSFACT(:)-ZLVFACT(:))
+! P_RG_RIM(:) = P_RG_RIM(:) * ZCF1D(:)
+ P_RC_RIMSS(:) = P_RC_RIMSS(:) * ZCF1D(:)
+ P_RC_RIMSG(:) = P_RC_RIMSG(:) * ZCF1D(:)
+ P_RS_RIMCG(:) = P_RS_RIMCG(:) * ZCF1D(:)
+! P_TH_RIM(:) = - P_RC_RIM(:) * (ZLSFACT(:)-ZLVFACT(:))
+ P_TH_RIM(:) = - (P_RC_RIMSS(:) + P_RC_RIMSG(:)) * (ZLSFACT(:)-ZLVFACT(:))
P_RI_HMS(:) = P_RI_HMS(:) * ZCF1D(:)
P_CI_HMS(:) = P_CI_HMS(:) * ZCF1D(:)
P_RS_HMS(:) = P_RS_HMS(:) * ZCF1D(:)
!
- PA_RC(:) = PA_RC(:) + P_RC_RIM(:)
+! PA_RC(:) = PA_RC(:) + P_RC_RIM(:)
+ PA_RC(:) = PA_RC(:) + P_RC_RIMSS(:) + P_RC_RIMSG(:) ! RCRIMSS < 0 and RCRIMSG < 0 (both loss for rc)
IF (NMOM_C.GE.2) PA_CC(:) = PA_CC(:) + P_CC_RIM(:)
PA_RI(:) = PA_RI(:) + P_RI_HMS(:)
IF (NMOM_I.GE.2) PA_CI(:) = PA_CI(:) + P_CI_HMS(:)
- PA_RS(:) = PA_RS(:) + P_RS_RIM(:) + P_RS_HMS(:)
+! PA_RS(:) = PA_RS(:) + P_RS_RIM(:) + P_RS_HMS(:)
+ PA_RS(:) = PA_RS(:) - P_RC_RIMSS(:) - P_RS_RIMCG(:) ! RCRIMSS < 0 (gain for rs), RSRIMCG > 0 (loss for rs)
IF (NMOM_S.GE.2) PA_CS(:) = PA_CS(:) + P_CS_RIM(:)
- PA_RG(:) = PA_RG(:) + P_RG_RIM(:)
+! PA_RG(:) = PA_RG(:) + P_RG_RIM(:)
+ PA_RG(:) = PA_RG(:) - P_RC_RIMSG(:) + P_RS_RIMCG(:) ! RCRIMSG < 0 (gain for rg), RSRIMCG > 0 (gain for rg)
IF (NMOM_G.GE.2) PA_CG(:) = PA_CG(:) - P_CS_RIM(:)
PA_TH(:) = PA_TH(:) + P_TH_RIM(:)
-
+!--cb--
END IF
!
IF (NMOM_R.GE.1 .AND. NMOM_S.GE.1) THEN
+!++cb++
CALL LIMA_RAIN_ACCR_SNOW (PTSTEP, LDCOMPUTE, & ! depends on PF
PRHODREF, ZT, &
ZRRT/ZPF1D, PCRT/ZPF1D, ZRST/ZPF1D, PCST/ZPF1D, ZLBDR, ZLBDS, ZLVFACT, ZLSFACT, &
- P_TH_ACC, P_RR_ACC, P_CR_ACC, P_RS_ACC, P_CS_ACC, P_RG_ACC )
- P_RR_ACC(:) = P_RR_ACC(:) * ZPF1D(:)
+! P_TH_ACC, P_RR_ACC, P_CR_ACC, P_RS_ACC, P_CS_ACC, P_RG_ACC )
+ P_TH_ACC, P_CR_ACC, P_CS_ACC, P_RR_ACCSS, P_RR_ACCSG, P_RS_ACCRG )
+! P_RR_ACC(:) = P_RR_ACC(:) * ZPF1D(:)
P_CR_ACC(:) = P_CR_ACC(:) * ZPF1D(:)
- P_RS_ACC(:) = P_RS_ACC(:) * ZPF1D(:)
+! P_RS_ACC(:) = P_RS_ACC(:) * ZPF1D(:)
P_CS_ACC(:) = P_CS_ACC(:) * ZPF1D(:)
- P_RG_ACC(:) = P_RG_ACC(:) * ZPF1D(:)
- P_TH_ACC(:) = - P_RR_ACC(:) * (ZLSFACT(:)-ZLVFACT(:))
- !
- PA_RR(:) = PA_RR(:) + P_RR_ACC(:)
+! P_RG_ACC(:) = P_RG_ACC(:) * ZPF1D(:)
+! P_TH_ACC(:) = - P_RR_ACC(:) * (ZLSFACT(:)-ZLVFACT(:))
+ P_RR_ACCSS(:) = P_RR_ACCSS(:) * ZPF1D(:)
+ P_RR_ACCSG(:) = P_RR_ACCSG(:) * ZPF1D(:)
+ P_RS_ACCRG(:) = P_RS_ACCRG(:) * ZPF1D(:)
+ P_TH_ACC(:) = (P_RR_ACCSS(:) + P_RR_ACCSG(:)) * (ZLSFACT(:)-ZLVFACT(:))
+ !
+! PA_RR(:) = PA_RR(:) + P_RR_ACC(:)
+ PA_RR(:) = PA_RR(:) - P_RR_ACCSS(:) - P_RR_ACCSG(:)
IF (NMOM_R.GE.2) PA_CR(:) = PA_CR(:) + P_CR_ACC(:)
- PA_RS(:) = PA_RS(:) + P_RS_ACC(:)
+! PA_RS(:) = PA_RS(:) + P_RS_ACC(:)
+ PA_RS(:) = PA_RS(:) + P_RR_ACCSS(:) - P_RS_ACCRG(:)
IF (NMOM_S.GE.2) PA_CS(:) = PA_CS(:) + P_CS_ACC(:)
- PA_RG(:) = PA_RG(:) + P_RG_ACC(:)
+! PA_RG(:) = PA_RG(:) + P_RG_ACC(:)
+ PA_RG(:) = PA_RG(:) + P_RR_ACCSG(:) + P_RS_ACCRG(:)
IF (NMOM_G.GE.2) PA_CG(:) = PA_CG(:) - P_CS_ACC(:)
PA_TH(:) = PA_TH(:) + P_TH_ACC(:)
-
+!--cb--
END IF
!
IF (NMOM_S.GE.1) THEN
diff --git a/src/PHYEX/micro/modi_lima.f90 b/src/PHYEX/micro/modi_lima.f90
index 383df6c4d7fcad487defdff132df7cca37bb3b74..a2c536238d29c46a42143be62a9c9d360cf90309 100644
--- a/src/PHYEX/micro/modi_lima.f90
+++ b/src/PHYEX/micro/modi_lima.f90
@@ -4,14 +4,15 @@ IMPLICIT NONE
INTERFACE
!
SUBROUTINE LIMA ( D, CST, BUCONF, TBUDGETS, KBUDGETS, &
- PTSTEP, &
+ PTSTEP, OELEC, &
PRHODREF, PEXNREF, PDZZ, &
PRHODJ, PPABST, &
NCCN, NIFN, NIMM, &
PDTHRAD, PTHT, PRT, PSVT, PW_NU, &
PTHS, PRS, PSVS, &
PINPRC, PINDEP, PINPRR, PINPRI, PINPRS, PINPRG, PINPRH, &
- PEVAP3D, PCLDFR, PICEFR, PPRCFR, PFPR )
+ PEVAP3D, PCLDFR, PICEFR, PPRCFR, PFPR, &
+ PLATHAM_IAGGS, PEFIELDW, PSV_ELEC_T, PSV_ELEC_S )
!
USE MODD_IO, ONLY: TFILEDATA
USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
@@ -27,6 +28,8 @@ INTEGER, INTENT(IN) :: KBUDGETS
!
REAL, INTENT(IN) :: PTSTEP ! Time step
!
+LOGICAL, INTENT(IN) :: OELEC ! if true, cloud electrification is activated
+!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Reference density
REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! Layer thikness (m)
@@ -62,6 +65,11 @@ REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PICEFR ! Cloud fraction
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PPRCFR ! Cloud fraction
REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PFPR ! Precipitation fluxes in altitude
!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLATHAM_IAGGS ! Factor for IAGGS modification due to Efield
+REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(IN) :: PEFIELDW ! Vertical component of the electric field
+REAL, DIMENSION(:,:,:,:), OPTIONAL, INTENT(IN) :: PSV_ELEC_T ! Charge density at time t
+REAL, DIMENSION(:,:,:,:), OPTIONAL, INTENT(INOUT) :: PSV_ELEC_S ! Charge density sources
+!
END SUBROUTINE LIMA
END INTERFACE
END MODULE MODI_LIMA
diff --git a/src/PHYEX/micro/modi_rain_ice.f90 b/src/PHYEX/micro/modi_rain_ice.f90
index abb7ff6b5430b32c0da9cda82f0fe64b99c91c96..17f83cbc4916f6a6e55f2fc1edd6e6d3bfb1112a 100644
--- a/src/PHYEX/micro/modi_rain_ice.f90
+++ b/src/PHYEX/micro/modi_rain_ice.f90
@@ -4,7 +4,8 @@
!
IMPLICIT NONE
INTERFACE
- SUBROUTINE RAIN_ICE ( D, CST, PARAMI, ICEP, ICED, BUCONF, &
+ SUBROUTINE RAIN_ICE ( D, CST, PARAMI, ICEP, ICED, ELECP, ELECD, BUCONF, &
+ KPROMA, OCND2, OELEC, OSEDIM_BEARD, &
PTSTEP, KRR, PEXN, &
PDZZ, PRHODJ, PRHODREF, PEXNREF, PPABST, PCIT, PCLDFR,&
PHLC_HRC, PHLC_HCF, PHLI_HRI, PHLI_HCF, &
@@ -13,15 +14,19 @@ INTERFACE
PINPRC, PINPRR, PEVAP3D, &
PINPRS, PINPRG, PINDEP, PRAINFR, PSIGS, &
TBUDGETS, KBUDGETS, &
+ PQPIT, PQCT, PQRT, PQIT, PQST, PQGT, PQNIT, &
+ PQPIS, PQCS, PQRS, PQIS, PQSS, PQGS, PQNIS, &
+ PEFIELDW, PLATHAM_IAGGS, &
PSEA, PTOWN, &
- PRHT, PRHS, PINPRH, PFPR )
+ PRHT, PRHS, PINPRH, PFPR, PQHT, PQHS )
!
USE MODD_BUDGET, ONLY: TBUDGETDATA, TBUDGETCONF_t
USE MODD_CST, ONLY: CST_t
USE MODD_PARAM_ICE_n, ONLY: PARAM_ICE_t
USE MODD_RAIN_ICE_PARAM_n, ONLY: RAIN_ICE_PARAM_t
USE MODD_RAIN_ICE_DESCR_n, ONLY: RAIN_ICE_DESCR_t
-USE MODD_TURB_n, ONLY: TURB_t
+USE MODD_ELEC_DESCR, ONLY: ELEC_DESCR_t
+USE MODD_ELEC_PARAM, ONLY: ELEC_PARAM_t
USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
!
IMPLICIT NONE
@@ -31,7 +36,13 @@ TYPE(CST_t), INTENT(IN) :: CST
TYPE(PARAM_ICE_t), INTENT(IN) :: PARAMI
TYPE(RAIN_ICE_PARAM_t), INTENT(IN) :: ICEP
TYPE(RAIN_ICE_DESCR_t), INTENT(IN) :: ICED
+TYPE(ELEC_PARAM_t), INTENT(IN) :: ELECP ! electrical parameters
+TYPE(ELEC_DESCR_t), INTENT(IN) :: ELECD ! electrical descriptive csts
TYPE(TBUDGETCONF_t), INTENT(IN) :: BUCONF
+INTEGER, INTENT(IN) :: KPROMA ! cache-blocking factor for microphysic loop
+LOGICAL :: OCND2 ! Logical switch to separate liquid and ice
+LOGICAL, INTENT(IN) :: OELEC ! Switch for cloud electricity
+LOGICAL, INTENT(IN) :: OSEDIM_BEARD ! Switch for effect of electrical forces on sedim.
REAL, INTENT(IN) :: PTSTEP ! Double Time step (single if cold start)
INTEGER, INTENT(IN) :: KRR ! Number of moist variable
!
@@ -76,12 +87,36 @@ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PSIGS ! Sigma_s at t
!
TYPE(TBUDGETDATA), DIMENSION(KBUDGETS), INTENT(INOUT) :: TBUDGETS
INTEGER, INTENT(IN) :: KBUDGETS
+!
+! scalar variables for cloud electricity
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), INTENT(IN) :: PQPIT ! Positive ion -
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), INTENT(INOUT) :: PQCT ! Cloud droplet |
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), INTENT(INOUT) :: PQRT ! Rain | electric
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), INTENT(INOUT) :: PQIT ! Ice crystals | charge
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), INTENT(INOUT) :: PQST ! Snow | at t
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), INTENT(INOUT) :: PQGT ! Graupel |
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), INTENT(IN) :: PQNIT ! Negative ion -
+!
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), INTENT(INOUT) :: PQPIS ! Positive ion -
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), INTENT(INOUT) :: PQCS ! Cloud droplet |
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), INTENT(INOUT) :: PQRS ! Rain | electric
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), INTENT(INOUT) :: PQIS ! Ice crystals | charge
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), INTENT(INOUT) :: PQSS ! Snow | source
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), INTENT(INOUT) :: PQGS ! Graupel |
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), INTENT(INOUT) :: PQNIS ! Negative ion -
+!
+REAL, DIMENSION(MERGE(D%NIJT,0,OSEDIM_BEARD),MERGE(D%NKT,0,OSEDIM_BEARD)), INTENT(IN) :: PEFIELDW ! vertical electric field
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), INTENT(IN) :: PLATHAM_IAGGS ! E Function to simulate
+ ! enhancement of IAGGS
+!
REAL, DIMENSION(D%NIJT), OPTIONAL, INTENT(IN) :: PSEA ! Sea Mask
REAL, DIMENSION(D%NIJT), OPTIONAL, INTENT(IN) :: PTOWN! Fraction that is town
REAL, DIMENSION(D%NIJT,D%NKT), OPTIONAL, INTENT(IN) :: PRHT ! Hail m.r. at t
REAL, DIMENSION(D%NIJT,D%NKT), OPTIONAL, INTENT(INOUT) :: PRHS ! Hail m.r. source
REAL, DIMENSION(D%NIJT), OPTIONAL, INTENT(OUT) :: PINPRH! Hail instant precip
REAL, DIMENSION(D%NIJT,D%NKT,KRR), OPTIONAL, INTENT(OUT) :: PFPR ! upper-air precipitation fluxes
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), OPTIONAL, INTENT(INOUT) :: PQHT ! Hail electric charge at t
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), OPTIONAL, INTENT(INOUT) :: PQHS ! Hail electric charge source
!
END SUBROUTINE RAIN_ICE
END INTERFACE
diff --git a/src/PHYEX/micro/rain_ice.f90 b/src/PHYEX/micro/rain_ice.f90
index 18b10bb3de19c5c346847d2688fd77479c0c4a74..1bbd44d1053ed5f3962e006c8b51bce22b35dcd6 100644
--- a/src/PHYEX/micro/rain_ice.f90
+++ b/src/PHYEX/micro/rain_ice.f90
@@ -4,7 +4,8 @@
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! ######spl
- SUBROUTINE RAIN_ICE ( D, CST, PARAMI, ICEP, ICED, BUCONF, &
+ SUBROUTINE RAIN_ICE ( D, CST, PARAMI, ICEP, ICED, ELECP, ELECD, BUCONF, &
+ KPROMA, OCND2, OELEC, OSEDIM_BEARD, &
PTSTEP, KRR, PEXN, &
PDZZ, PRHODJ, PRHODREF, PEXNREF, PPABST, PCIT, PCLDFR,&
PHLC_HRC, PHLC_HCF, PHLI_HRI, PHLI_HCF, &
@@ -13,9 +14,12 @@
PINPRC, PINPRR, PEVAP3D, &
PINPRS, PINPRG, PINDEP, PRAINFR, PSIGS, &
TBUDGETS, KBUDGETS, &
+ PQPIT, PQCT, PQRT, PQIT, PQST, PQGT, PQNIT, &
+ PQPIS, PQCS, PQRS, PQIS, PQSS, PQGS, PQNIS, &
+ PEFIELDW, PLATHAM_IAGGS, &
PSEA, PTOWN, &
- PRHT, PRHS, PINPRH, PFPR )
-! ######################################################################
+ PRHT, PRHS, PINPRH, PFPR, PQHT, PQHS )
+! #############################################################################
!
!!**** * - compute the explicit microphysical sources
!!
@@ -171,6 +175,9 @@
! P. Wautelet 25/02/2020: bugfix: add missing budget: WETH_BU_RRG
!! R. El Khatib 24-Aug-2021 Optimizations
! J. Wurtz 03/2022: New snow characteristics with LSNOW_T
+! C. Barthe 03/2023: Add call to cloud electrification
+! C. Barthe 06/2023: Add retroaction of electric field on IAGGS
+! C. Barthe 07/2023: use new data structures for electricity
!-----------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -185,15 +192,47 @@ USE MODD_CST, ONLY: CST_t
USE MODD_PARAM_ICE_n, ONLY: PARAM_ICE_t
USE MODD_RAIN_ICE_DESCR_n, ONLY: RAIN_ICE_DESCR_t
USE MODD_RAIN_ICE_PARAM_n, ONLY: RAIN_ICE_PARAM_t
-USE MODD_FIELDS_ADDRESS, ONLY : & ! common fields adress
- & ITH, & ! Potential temperature
- & IRV, & ! Water vapor
- & IRC, & ! Cloud water
- & IRR, & ! Rain water
- & IRI, & ! Pristine ice
- & IRS, & ! Snow/aggregate
- & IRG, & ! Graupel
- & IRH ! Hail
+USE MODD_ELEC_PARAM, ONLY: ELEC_PARAM_t
+USE MODD_ELEC_DESCR, ONLY: ELEC_DESCR_t
+USE MODD_FIELDS_ADDRESS
+!USE MODD_FIELDS_ADDRESS, ONLY : & ! common fields adress
+! & ITH, & ! Potential temperature
+! & IRV, & ! Water vapor
+! & IRC, & ! Cloud water
+! & IRR, & ! Rain water
+! & IRI, & ! Pristine ice
+! & IRS, & ! Snow/aggregate
+! & IRG, & ! Graupel
+! & IRH, & ! Hail
+! & IBUNUM, & ! Number of tendency terms
+! & IBUNUM_EXTRA, & ! Number of extra tendency terms
+! & IRCHONI, & ! Homogeneous nucleation
+! & IRVDEPS, & ! Deposition on r_s,
+! & IRIAGGS, & ! Aggregation on r_s
+! & IRIAUTS, & ! Autoconversion of r_i for r_s production
+! & IRVDEPG, & ! Deposition on r_g
+! & IRCAUTR, & ! Autoconversion of r_c for r_r production
+! & IRCACCR, & ! Accretion of r_c for r_r production
+! & IRREVAV, & ! Evaporation of r_r
+! & IRCBERI, & ! Bergeron-Findeisen effect
+! & IRHMLTR, & ! Melting of the hailstones
+! & IRSMLTG, & ! Conversion-Melting of the aggregates
+! & IRCMLTSR, & ! Cloud droplet collection onto aggregates by positive temperature
+! & IRRACCSS, IRRACCSG, IRSACCRG, & ! Rain accretion onto the aggregates
+! & IRCRIMSS, IRCRIMSG, IRSRIMCG, & ! Cloud droplet riming of the aggregates
+! & IRICFRRG, IRRCFRIG, IRICFRR, & ! Rain contact freezing
+! & IRCWETG, IRIWETG, IRRWETG, IRSWETG, & ! Graupel wet growth
+! & IRCDRYG, IRIDRYG, IRRDRYG, IRSDRYG, & ! Graupel dry growth
+! & IRWETGH, & ! Conversion of graupel into hail
+! & IRGMLTR, & ! Melting of the graupel
+! & IRCWETH, IRIWETH, IRSWETH, IRGWETH, IRRWETH, & ! Dry growth of hailstone
+! & IRCDRYH, IRIDRYH, IRSDRYH, IRRDRYH, IRGDRYH, & ! Wet growth of hailstone
+! & IRDRYHG, &
+! & IRVHENI_MR, & ! heterogeneous nucleation mixing ratio change
+! & IRRHONG_MR, & ! Spontaneous freezing mixing ratio change
+! & IRIMLTC_MR, & ! Cloud ice melting mixing ratio change
+! & IRSRIMCG_MR,& ! Cloud droplet riming of the aggregates
+! & IRWETGH_MR
USE MODE_BUDGET_PHY, ONLY: BUDGET_STORE_INIT_PHY, BUDGET_STORE_END_PHY
USE MODE_MSG, ONLY: PRINT_MSG, NVERB_FATAL
@@ -204,6 +243,8 @@ USE MODE_ICE4_PACK, ONLY: ICE4_PACK
USE MODE_ICE4_NUCLEATION, ONLY: ICE4_NUCLEATION
USE MODE_ICE4_CORRECT_NEGATIVITIES, ONLY: ICE4_CORRECT_NEGATIVITIES
!
+USE MODI_ELEC_TENDENCIES
+!
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
@@ -215,7 +256,13 @@ TYPE(CST_t), INTENT(IN) :: CST
TYPE(PARAM_ICE_t), INTENT(IN) :: PARAMI
TYPE(RAIN_ICE_PARAM_t), INTENT(IN) :: ICEP
TYPE(RAIN_ICE_DESCR_t), INTENT(IN) :: ICED
+TYPE(ELEC_PARAM_t), INTENT(IN) :: ELECP ! electrical parameters
+TYPE(ELEC_DESCR_t), INTENT(IN) :: ELECD ! electrical descriptive csts
TYPE(TBUDGETCONF_t), INTENT(IN) :: BUCONF
+INTEGER, INTENT(IN) :: KPROMA ! cache-blocking factor for microphysic loop
+LOGICAL :: OCND2 ! Logical switch to separate liquid and ice
+LOGICAL, INTENT(IN) :: OELEC ! Switch for cloud electricity
+LOGICAL, INTENT(IN) :: OSEDIM_BEARD ! Switch for effect of electrical forces on sedim.
REAL, INTENT(IN) :: PTSTEP ! Double Time step (single if cold start)
INTEGER, INTENT(IN) :: KRR ! Number of moist variable
!
@@ -260,12 +307,37 @@ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PSIGS ! Sigma_s at t
!
TYPE(TBUDGETDATA), DIMENSION(KBUDGETS), INTENT(INOUT) :: TBUDGETS
INTEGER, INTENT(IN) :: KBUDGETS
-REAL, DIMENSION(D%NIJT), OPTIONAL, INTENT(IN) :: PSEA ! Sea Mask
-REAL, DIMENSION(D%NIJT), OPTIONAL, INTENT(IN) :: PTOWN! Fraction that is town
-REAL, DIMENSION(D%NIJT,D%NKT), OPTIONAL, INTENT(IN) :: PRHT ! Hail m.r. at t
-REAL, DIMENSION(D%NIJT,D%NKT), OPTIONAL, INTENT(INOUT) :: PRHS ! Hail m.r. source
-REAL, DIMENSION(D%NIJT), OPTIONAL, INTENT(OUT) :: PINPRH! Hail instant precip
-REAL, DIMENSION(D%NIJT,D%NKT,KRR), OPTIONAL, INTENT(OUT) :: PFPR ! upper-air precipitation fluxes
+!
+! scalar variables for cloud electricity
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), INTENT(IN) :: PQPIT ! Positive ion -
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), INTENT(INOUT) :: PQCT ! Cloud droplet |
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), INTENT(INOUT) :: PQRT ! Rain | electric
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), INTENT(INOUT) :: PQIT ! Ice crystals | charge
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), INTENT(INOUT) :: PQST ! Snow | at t
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), INTENT(INOUT) :: PQGT ! Graupel |
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), INTENT(IN) :: PQNIT ! Negative ion -
+!
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), INTENT(INOUT) :: PQPIS ! Positive ion -
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), INTENT(INOUT) :: PQCS ! Cloud droplet |
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), INTENT(INOUT) :: PQRS ! Rain | electric
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), INTENT(INOUT) :: PQIS ! Ice crystals | charge
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), INTENT(INOUT) :: PQSS ! Snow | source
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), INTENT(INOUT) :: PQGS ! Graupel |
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), INTENT(INOUT) :: PQNIS ! Negative ion -
+!
+REAL, DIMENSION(MERGE(D%NIJT,0,OSEDIM_BEARD),MERGE(D%NKT,0,OSEDIM_BEARD)), INTENT(IN) :: PEFIELDW ! vertical electric field
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), INTENT(IN) :: PLATHAM_IAGGS ! E Function to simulate
+ ! enhancement of IAGGS
+!
+! optional variables
+REAL, DIMENSION(D%NIJT), OPTIONAL, INTENT(IN) :: PSEA ! Sea Mask
+REAL, DIMENSION(D%NIJT), OPTIONAL, INTENT(IN) :: PTOWN ! Fraction that is town
+REAL, DIMENSION(D%NIJT,D%NKT), OPTIONAL, INTENT(IN) :: PRHT ! Hail m.r. at t
+REAL, DIMENSION(D%NIJT,D%NKT), OPTIONAL, INTENT(INOUT) :: PRHS ! Hail m.r. source
+REAL, DIMENSION(D%NIJT), OPTIONAL, INTENT(OUT) :: PINPRH ! Hail instant precip
+REAL, DIMENSION(D%NIJT,D%NKT,KRR), OPTIONAL, INTENT(OUT) :: PFPR ! upper-air precipitation fluxes
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), OPTIONAL, INTENT(INOUT) :: PQHT ! Hail electric charge at t
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), OPTIONAL, INTENT(INOUT) :: PQHS ! Hail electric charge source
!
!
!* 0.2 Declarations of local variables :
@@ -292,6 +364,13 @@ LOGICAL, DIMENSION(D%NIJT,D%NKT) :: LLW3D
REAL, DIMENSION(KRR) :: ZRSMIN
INTEGER :: ISIZE, IPROMA, IGPBLKS, ISIZE2
!
+LOGICAL :: LSAVE_MICRO ! if true, microphysical tendencies are saved for cloud electricity
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC),MERGE(IBUNUM-IBUNUM_EXTRA,0,OELEC)) :: &
+ ZMICRO_TEND ! Total mixing ratio change, used for electric charge tendencies
+LOGICAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)) :: GMASK_ELEC
+INTEGER :: IELEC ! nb of points where microphysical tendencies are not null
+INTEGER :: JI ! loop index
+!
!-------------------------------------------------------------------------------
IF (LHOOK) CALL DR_HOOK('RAIN_ICE', 0, ZHOOK_HANDLE)
!
@@ -352,14 +431,16 @@ ENDDO
! -------------------------------------
!
IF(.NOT. PARAMI%LSEDIM_AFTER) THEN
- CALL ICE4_SEDIMENTATION(D, CST, ICEP, ICED, PARAMI, BUCONF, &
- &PTSTEP, KRR, PDZZ, &
+ CALL ICE4_SEDIMENTATION(D, CST, ICEP, ICED, PARAMI, ELECP, ELECD, BUCONF, &
+ &OELEC, OSEDIM_BEARD, PTSTEP, KRR, PDZZ, &
&ZZ_LVFACT, ZZ_LSFACT, PRHODREF, PPABST, PTHT, ZT, PRHODJ, &
&PTHS, PRVS, PRCS, PRCT, PRRS, PRRT, PRIS, PRIT, PRSS, PRST, PRGS, PRGT,&
&PINPRC, PINPRR, PINPRS, PINPRG, &
+ &PQCT, PQRT, PQIT, PQST, PQGT, PQCS, PQRS, PQIS, PQSS, PQGS, PEFIELDW, &
&TBUDGETS, KBUDGETS, &
&PSEA=PSEA, PTOWN=PTOWN, &
- &PINPRH=PINPRH, PRHT=PRHT, PRHS=PRHS, PFPR=PFPR)
+ &PINPRH=PINPRH, PRHT=PRHT, PRHS=PRHS, PFPR=PFPR, &
+ &PQHT=PQHT, PQHS=PQHS)
ENDIF
!
!
@@ -395,7 +476,7 @@ ENDDO
!* 4. COMPUTES THE SLOW COLD PROCESS SOURCES OUTSIDE OF LLMICRO POINTS
! -----------------------------------------------------------------
!
-!The nucelation must be call everywhere
+!The nucleation must be called everywhere
!This call is for points outside of the LLMICR mask, another call is coded in ice4_tendencies
LLW3D(:,:)=.FALSE.
DO JK=IKTB,IKTE
@@ -444,10 +525,17 @@ ELSE
IPROMA=0
ISIZE2=ISIZE
ENDIF
+!
+!Microphysical tendencies must be saved for some physical parameterizations
+IF (OELEC) THEN
+ LSAVE_MICRO = .TRUE.
+ ZMICRO_TEND(:,:,:) = 0.
+END IF
+!
!This part is put in another routine to separate pack/unpack operations from computations
CALL ICE4_PACK(D, CST, PARAMI, ICEP, ICED, BUCONF, &
IPROMA, ISIZE, ISIZE2, &
- PTSTEP, KRR, LLMICRO, PEXN, &
+ PTSTEP, KRR, LSAVE_MICRO, LLMICRO, OELEC, PEXN, &
PRHODJ, PRHODREF, PEXNREF, PPABST, PCIT, PCLDFR, &
PHLC_HRC, PHLC_HCF, PHLI_HRI, PHLI_HCF, &
PTHS, PRVS, PRCS, PRRS, PRIS, PRSS, PRGS, &
@@ -456,15 +544,105 @@ CALL ICE4_PACK(D, CST, PARAMI, ICEP, ICED, BUCONF, &
ZZ_RVHENI, ZZ_LVFACT, ZZ_LSFACT, &
ZWR, &
TBUDGETS, KBUDGETS, &
- PRHS )
+ ZMICRO_TEND, PLATHAM_IAGGS, PRHS )
+!
!
!-------------------------------------------------------------------------------
!
-!* 6. TOTAL TENDENCIES
+!* 7. CALL TO PHYSICAL PARAMETERIZATIONS CLOSELY LINKED TO MICROPHYSICS
+! -----------------------------------------------------------------
+!
+! Cloud electrification, water isotopes and aqueous chemistry need the mixing ratio tendencies
+! to compute the evolution of electric charges, water isotopes and ...
+!
+!* 7.1 Cloud electrification
+!
+IF (OELEC) THEN
+ DO JK = IKTB, IKTE
+ DO JIJ = IIJB, IIJE
+ DO JI = 1, IBUNUM-IBUNUM_EXTRA
+ ZMICRO_TEND(JIJ,JK,JI) = ZMICRO_TEND(JIJ,JK,JI) * ZINV_TSTEP
+ !
+ ! transfer of electric charges occurs only where transfer of mass is non null
+ GMASK_ELEC(JIJ,JK) = GMASK_ELEC(JIJ,JK) .OR. (ZMICRO_TEND(JIJ,JK,JI) .NE. 0.)
+ END DO
+ END DO
+ END DO
+ !
+ IELEC = COUNT(GMASK_ELEC)
+ !
+ ! RVHENI : ajout de prvheni ?
+ ! traitement des deux termes extra ? irwetgh_mr et irsrimcg_mr ?
+ IF (KRR == 7) THEN
+ CALL ELEC_TENDENCIES(D, KRR, IELEC, PTSTEP, GMASK_ELEC, &
+ PRHODREF, PRHODJ, ZT, PCIT, &
+ PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
+ PQPIT, PQCT, PQRT, PQIT, PQST, PQGT, PQNIT, &
+ PQPIS, PQCS, PQRS, PQIS, PQSS, PQGS, PQNIS, &
+ ZMICRO_TEND(:,:,IRVHENI_MR), ZMICRO_TEND(:,:,IRRHONG_MR), &
+ ZMICRO_TEND(:,:,IRIMLTC_MR), ZMICRO_TEND(:,:,IRCHONI), &
+ ZMICRO_TEND(:,:,IRVDEPS), ZMICRO_TEND(:,:,IRIAGGS), &
+ ZMICRO_TEND(:,:,IRIAUTS), ZMICRO_TEND(:,:,IRVDEPG), &
+ ZMICRO_TEND(:,:,IRCAUTR), ZMICRO_TEND(:,:,IRCACCR), &
+ ZMICRO_TEND(:,:,IRREVAV), ZMICRO_TEND(:,:,IRCRIMSS), &
+ ZMICRO_TEND(:,:,IRCRIMSG), ZMICRO_TEND(:,:,IRSRIMCG), &
+ ZMICRO_TEND(:,:,IRRACCSS), ZMICRO_TEND(:,:,IRRACCSG), &
+ ZMICRO_TEND(:,:,IRSACCRG), ZMICRO_TEND(:,:,IRSMLTG), &
+ ZMICRO_TEND(:,:,IRICFRRG), ZMICRO_TEND(:,:,IRRCFRIG), &
+ ZMICRO_TEND(:,:,IRCWETG), ZMICRO_TEND(:,:,IRIWETG), &
+ ZMICRO_TEND(:,:,IRRWETG), ZMICRO_TEND(:,:,IRSWETG), &
+ ZMICRO_TEND(:,:,IRCDRYG), ZMICRO_TEND(:,:,IRIDRYG), &
+ ZMICRO_TEND(:,:,IRRDRYG), ZMICRO_TEND(:,:,IRSDRYG), &
+ ZMICRO_TEND(:,:,IRGMLTR), ZMICRO_TEND(:,:,IRCBERI), &
+ PRCMLTSR=ZMICRO_TEND(:,:,IRCMLTSR), PRICFRR=ZMICRO_TEND(:,:,IRICFRR),&
+ PRWETGH=ZMICRO_TEND(:,:,IRWETGH), &
+ PRCWETH=ZMICRO_TEND(:,:,IRCWETH), PRIWETH=ZMICRO_TEND(:,:,IRIWETH), &
+ PRSWETH=ZMICRO_TEND(:,:,IRSWETH), &
+ PRGWETH=ZMICRO_TEND(:,:,IRGWETH), PRRWETH=ZMICRO_TEND(:,:,IRRWETH), &
+ PRCDRYH=ZMICRO_TEND(:,:,IRCDRYH), PRIDRYH=ZMICRO_TEND(:,:,IRIDRYH), &
+ PRSDRYH=ZMICRO_TEND(:,:,IRSDRYH), &
+ PRRDRYH=ZMICRO_TEND(:,:,IRRDRYH), PRGDRYH=ZMICRO_TEND(:,:,IRGDRYH), &
+ PRDRYHG=ZMICRO_TEND(:,:,IRDRYHG), PRHMLTR=ZMICRO_TEND(:,:,IRHMLTR), &
+ PRHT=PRHT, PRHS=PRHS, PQHT=PQHT, PQHS=PQHS )
+ ELSE
+ CALL ELEC_TENDENCIES(D, KRR, ISIZE, PTSTEP, LLMICRO, &
+ PRHODREF, PRHODJ, ZT, PCIT, &
+ PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
+ PQPIT, PQCT, PQRT, PQIT, PQST, PQGT, PQNIT, &
+ PQPIS, PQCS, PQRS, PQIS, PQSS, PQGS, PQNIS, &
+ ZMICRO_TEND(:,:,IRVHENI_MR), ZMICRO_TEND(:,:,IRRHONG_MR), &
+ ZMICRO_TEND(:,:,IRIMLTC_MR), ZMICRO_TEND(:,:,IRCHONI), &
+ ZMICRO_TEND(:,:,IRVDEPS), ZMICRO_TEND(:,:,IRIAGGS), &
+ ZMICRO_TEND(:,:,IRIAUTS), ZMICRO_TEND(:,:,IRVDEPG), &
+ ZMICRO_TEND(:,:,IRCAUTR), ZMICRO_TEND(:,:,IRCACCR), &
+ ZMICRO_TEND(:,:,IRREVAV), ZMICRO_TEND(:,:,IRCRIMSS), &
+ ZMICRO_TEND(:,:,IRCRIMSG), ZMICRO_TEND(:,:,IRSRIMCG), &
+ ZMICRO_TEND(:,:,IRRACCSS), ZMICRO_TEND(:,:,IRRACCSG), &
+ ZMICRO_TEND(:,:,IRSACCRG), ZMICRO_TEND(:,:,IRSMLTG), &
+ ZMICRO_TEND(:,:,IRICFRRG), ZMICRO_TEND(:,:,IRRCFRIG), &
+ ZMICRO_TEND(:,:,IRCWETG), ZMICRO_TEND(:,:,IRIWETG), &
+ ZMICRO_TEND(:,:,IRRWETG), ZMICRO_TEND(:,:,IRSWETG), &
+ ZMICRO_TEND(:,:,IRCDRYG), ZMICRO_TEND(:,:,IRIDRYG), &
+ ZMICRO_TEND(:,:,IRRDRYG), ZMICRO_TEND(:,:,IRSDRYG), &
+ ZMICRO_TEND(:,:,IRGMLTR), ZMICRO_TEND(:,:,IRCBERI), &
+ PRCMLTSR=ZMICRO_TEND(:,:,IRCMLTSR), PRICFRR=ZMICRO_TEND(:,:,IRICFRR))
+ END IF
+END IF
+!
+!
+!* 7.2 Water isotopologues
+!
+!
+!* 7.3 Aqueous chemistry
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 8. TOTAL TENDENCIES
! ----------------
!
!
-!*** 6.1 total tendencies limited by available species
+!*** 8.1 total tendencies limited by available species
!
DO JK = IKTB, IKTE
DO JIJ=IIJB, IIJE
@@ -504,7 +682,7 @@ DO JK = IKTB, IKTE
ENDDO
!-------------------------------------------------------------------------------
!
-!*** 6.2 Negative corrections
+!*** 8.2 Negative corrections
!
!NOTE:
! This call cannot be moved before the preeceding budget calls because,
@@ -525,11 +703,16 @@ IF(BUCONF%LBU_ENABLE) THEN
IF (BUCONF%LBUDGET_RG) CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RG), 'CORR', PRGS(:, :)*PRHODJ(:, :))
IF (BUCONF%LBUDGET_RH .AND. KRR==7) CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RH), 'CORR', PRHS(:, :)*PRHODJ(:, :))
END IF
+!++cb-- ajouter les bilans pour l'elec !!!
!We correct negativities with conservation
CALL ICE4_CORRECT_NEGATIVITIES(D, ICED, KRR, PRVS, PRCS, PRRS, &
&PRIS, PRSS, PRGS, &
&PTHS, ZZ_LVFACT, ZZ_LSFACT, PRHS)
+!CALL ICE4_CORRECT_NEGATIVITIES(D, ICED, KRR, OELEC, PRVS, PRCS, PRRS, &
+! &PRIS, PRSS, PRGS, &
+! &PQPIS, PQCS, PQRS, PQIS, PQSS, PQGS, PQNIS, &
+! &PTHS, ZZ_LVFACT, ZZ_LSFACT, PRHS, PQHS)
IF (BUCONF%LBU_ENABLE) THEN
IF (BUCONF%LBUDGET_TH) CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_TH), 'CORR', PTHS(:, :)*PRHODJ(:, :))
@@ -544,19 +727,21 @@ END IF
!
!-------------------------------------------------------------------------------
!
-!* 7. COMPUTE THE SEDIMENTATION (RS) SOURCE
+!* 9. COMPUTE THE SEDIMENTATION (RS) SOURCE
! -------------------------------------
!
IF(PARAMI%LSEDIM_AFTER) THEN
- CALL ICE4_SEDIMENTATION(D, CST, ICEP, ICED, PARAMI, BUCONF, &
- &PTSTEP, KRR, PDZZ, &
+ CALL ICE4_SEDIMENTATION(D, CST, ICEP, ICED, PARAMI, ELECP, ELECD, BUCONF, &
+ &OELEC, OSEDIM_BEARD, PTSTEP, KRR, PDZZ, &
&ZZ_LVFACT, ZZ_LSFACT, PRHODREF, PPABST, PTHT, ZT, PRHODJ, &
&PTHS, PRVS, PRCS, PRCT, PRRS, PRRT, PRIS, PRIT, PRSS, PRST, PRGS, PRGT,&
&PINPRC, PINPRR, PINPRS, PINPRG, &
+ &PQCT, PQRT, PQIT, PQST, PQGT, PQCS, PQRS, PQIS, PQSS, PQGS, PEFIELDW, &
&TBUDGETS, KBUDGETS, &
&PSEA=PSEA, PTOWN=PTOWN, &
- &PINPRH=PINPRH, PRHT=PRHT, PRHS=PRHS, PFPR=PFPR)
-
+ &PINPRH=PINPRH, PRHT=PRHT, PRHS=PRHS, PFPR=PFPR, &
+ &PQHT=PQHT, PQHS=PQHS)
+
!"sedimentation" of rain fraction
DO JK = IKTB, IKTE
DO JIJ=IIJB,IIJE
@@ -579,7 +764,7 @@ ENDIF
!
!-------------------------------------------------------------------------------
!
-!* 8. COMPUTE THE FOG DEPOSITION TERM
+!* 10. COMPUTE THE FOG DEPOSITION TERM
! -------------------------------------
!
IF (PARAMI%LDEPOSC) THEN !cloud water deposition on vegetation
diff --git a/src/PHYEX/turb/modi_turb.f90 b/src/PHYEX/turb/modi_turb.f90
index f7141ca30fca10492d45724fba9bc77b5e8ec1fb..302d34ae89dbb7fc4ff5b39440d9495b3da70b78 100644
--- a/src/PHYEX/turb/modi_turb.f90
+++ b/src/PHYEX/turb/modi_turb.f90
@@ -12,7 +12,7 @@ INTERFACE
& O2D,ONOMIXLG,OFLAT,OCOUPLES,OBLOWSNOW,OIBM,OFLYER, &
& OCOMPUTE_SRC, PRSNOW, &
& OOCEAN,ODEEPOC,ODIAG_IN_RUN, &
- & HTURBLEN_CL,HCLOUD, &
+ & HTURBLEN_CL,HCLOUD,HELEC, &
& PTSTEP,TPFILE, &
& PDXX,PDYY,PDZZ,PDZX,PDZY,PZZ, &
& PDIRCOSXW,PDIRCOSYW,PDIRCOSZW,PCOSSLOPE,PSINSLOPE, &
@@ -72,6 +72,7 @@ LOGICAL, INTENT(IN) :: ODIAG_IN_RUN ! switch to activate onlin
LOGICAL, INTENT(IN) :: OIBM ! switch to modity mixing length near building with IBM
CHARACTER(LEN=4), INTENT(IN) :: HTURBLEN_CL ! kind of cloud mixing length
CHARACTER (LEN=4), INTENT(IN) :: HCLOUD ! Kind of microphysical scheme
+CHARACTER (LEN=4), INTENT(IN) :: HELEC ! Kind of cloud electricity scheme
REAL, INTENT(IN) :: PRSNOW ! Ratio for diffusion coeff. scalar (blowing snow)
REAL, INTENT(IN) :: PTSTEP ! timestep
TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
diff --git a/src/PHYEX/turb/turb.f90 b/src/PHYEX/turb/turb.f90
index 5549a0c826674351524f2707876a10a87816e827..42b1d1cb8485d0e037f5b0264d79ffc8c090e022 100644
--- a/src/PHYEX/turb/turb.f90
+++ b/src/PHYEX/turb/turb.f90
@@ -10,7 +10,7 @@
& O2D,ONOMIXLG,OFLAT,OCOUPLES,OBLOWSNOW,OIBM,OFLYER, &
& OCOMPUTE_SRC, PRSNOW, &
& OOCEAN,ODEEPOC,ODIAG_IN_RUN, &
- & HTURBLEN_CL,HCLOUD, &
+ & HTURBLEN_CL,HCLOUD,HELEC, &
& PTSTEP,TPFILE, &
& PDXX,PDYY,PDZZ,PDZX,PDZY,PZZ, &
& PDIRCOSXW,PDIRCOSYW,PDIRCOSZW,PCOSSLOPE,PSINSLOPE, &
@@ -234,6 +234,7 @@
! P. Wautelet 30/06/2020: move removal of negative scalar variables to Sources_neg_correct
! R. Honnert/V. Masson 02/2021: new mixing length in the grey zone
! J.L. Redelsperger 03/2021: add Ocean LES case
+! C. Barthe 08/02/2022: add helec in arguments of Sources_neg_correct
! --------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -313,6 +314,8 @@ LOGICAL, INTENT(IN) :: ODIAG_IN_RUN ! switch to activate onlin
LOGICAL, INTENT(IN) :: OIBM ! switch to modity mixing length near building with IBM
CHARACTER(LEN=4), INTENT(IN) :: HTURBLEN_CL ! kind of cloud mixing length
CHARACTER (LEN=4), INTENT(IN) :: HCLOUD ! Kind of microphysical scheme
+CHARACTER (LEN=4), INTENT(IN) :: HELEC ! Kind of cloud electricity scheme
+
REAL, INTENT(IN) :: PRSNOW ! Ratio for diffusion coeff. scalar (blowing snow)
REAL, INTENT(IN) :: PTSTEP ! timestep
TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
@@ -1314,7 +1317,7 @@ IF ( KRRL >= 1 ) THEN
END IF
! Remove non-physical negative values (unnecessary in a perfect world) + corresponding budgets
-CALL SOURCES_NEG_CORRECT_PHY(D,KSV,HCLOUD, 'NETUR',KRR,PTSTEP,PPABST,PTHLT,PRT,PRTHLS,PRRS,PRSVS)
+CALL SOURCES_NEG_CORRECT_PHY(D,KSV,HCLOUD,HELEC,'NETUR',KRR,PTSTEP,PPABST,PTHLT,PRT,PRTHLS,PRRS,PRSVS)
!----------------------------------------------------------------------------
!
!* 9. LES averaged surface fluxes