diff --git a/src/arome/aux/modd_misc.F90 b/src/arome/aux/modd_misc.F90
index 42af5c7481910ac498777db35703d1d0b0598f71..02bafe45acd289c59d7be28e0a6e8243d7802305 100644
--- a/src/arome/aux/modd_misc.F90
+++ b/src/arome/aux/modd_misc.F90
@@ -28,7 +28,9 @@ TYPE MISC_t
LOGICAL :: OFLYER=.FALSE. !< MesoNH flyer diagnostic
LOGICAL :: ODIAG_IN_RUN=.FALSE. !< LES diagnostics
LOGICAL :: O2D=.FALSE. !< 2D version of the turbulence
-
+ CHARACTER(LEN=4) :: CELEC='NONE' !< Name of the electricity scheme
+ LOGICAL :: OELEC=.FALSE. !< Lightning prognostic scheme
+ LOGICAL :: OSEDIM_BEARD=.FALSE. !< Switch for effect of electrical forces on sedim.
!These values are computed from the model setup
LOGICAL :: OFLAT !< Flat configuration
diff --git a/src/arome/aux/mode_posnam_phy.F90 b/src/arome/aux/mode_posnam_phy.F90
index 54e63bdc4b2b84e503c720c0e50fa68dd31b8243..8fe3dae2a3e898c57a1995a7433ccb7ee8a65449 100644
--- a/src/arome/aux/mode_posnam_phy.F90
+++ b/src/arome/aux/mode_posnam_phy.F90
@@ -1,19 +1,20 @@
MODULE MODE_POSNAM_PHY
IMPLICIT NONE
CONTAINS
-SUBROUTINE POSNAM_PHY(KUNITNML, CDNAML, LDNEEDNAM, LDFOUND, KLUOUT)
+SUBROUTINE POSNAM_PHY(TFILENAM, CDNAML, LDNEEDNAM, LDFOUND)
!Wrapper to call the AROME version of posnam
+USE MODD_IO, ONLY: TFILEDATA
+
IMPLICIT NONE
-INTEGER, INTENT(IN) :: KUNITNML !< Logical unit to access the namelist
+TYPE(TFILEDATA), INTENT(IN) :: TFILENAM !< Namelist file
CHARACTER(LEN=*), INTENT(IN) :: CDNAML !< Namelist name
LOGICAL, INTENT(IN) :: LDNEEDNAM !< True to abort if namelist is absent
LOGICAL, INTENT(OUT) :: LDFOUND !< True if namelist has been found
-INTEGER, INTENT(IN) :: KLUOUT !< Logical unit for output
#include "posnam.intfb.h"
-CALL POSNAM(KUNITNML, CDNAML)
+CALL POSNAM(TFILENAM%NLU, CDNAML)
LDFOUND=.TRUE. !Posnam aborts if not found
END SUBROUTINE POSNAM_PHY
diff --git a/src/arome/ext/aro_lima.F90 b/src/arome/ext/aro_lima.F90
index 60d4874ebbaec2eab7b22fd007600f78b42ae841..11bae1db68ebc14e480fe320fc62de2f8a0be10c 100644
--- a/src/arome/ext/aro_lima.F90
+++ b/src/arome/ext/aro_lima.F90
@@ -132,7 +132,7 @@ REAL :: ZMASSTOT ! total mass for one water category
REAL :: ZMASSPOS ! total mass for one water category
! after removing the negative values
REAL :: ZRATIO ! ZMASSTOT / ZMASSCOR
-
+REAL :: ZTHVREFZIKB
LOGICAL :: LL_RRR_BUDGET
!
TYPE(TBUDGETDATA), DIMENSION(NBUDGET_SV1+NSV_LIMA-1) :: YLBUDGET
@@ -156,7 +156,12 @@ ZDUM3DS=0.
ZDUM3DG=0.
ZDUM3DH=0.
PINPRH=0.
-
+IF (PHYEX%MISC%CELEC /='NONE') THEN
+CALL ABOR1('ARO_LIMA : CELEC ELECTRICITY SCHEME NOT YET CORRECLY PLUGGED HERE')
+! The following value of ZTHVREFZIKB must be removed from the electricity scheme or computed correctly here
+ELSE
+ ZTHVREFZIKB = 0. ! for electricity use only
+END IF
!
!* 2. TRANSFORMATION INTO PHYSICAL TENDENCIES
@@ -287,9 +292,11 @@ ENDDO
!
!
!
-CALL LIMA (D=YLDIMPHYEX, CST=PHYEX%CST, BUCONF=TBUCONF, TBUDGETS=YLBUDGET, KBUDGETS=SIZE(YLBUDGET), &
- PTSTEP=2*PTSTEP, &
- PRHODREF=PRHODREF, PEXNREF=PEXNREF, PDZZ=PDZZ, &
+CALL LIMA (D=YLDIMPHYEX, CST=PHYEX%CST, ICED=PHYEX%RAIN_ICE_DESCRN, ICEP=PHYEX%RAIN_ICE_PARAMN, &
+ ELECD=PHYEX%ELEC_DESCR, ELECP=PHYEX%ELEC_PARAM, &
+ BUCONF=TBUCONF, TBUDGETS=YLBUDGET, KBUDGETS=SIZE(YLBUDGET), &
+ PTSTEP=2*PTSTEP, OELEC=PHYEX%MISC%OELEC, HCLOUD= 'LIMA', &
+ PRHODREF=PRHODREF, PEXNREF=PEXNREF, PDZZ=PDZZ, PTHVREFZIKB=ZTHVREFZIKB, &
PRHODJ=PRHODJ, PPABST=PPABSM, &
NCCN=NMOD_CCN, NIFN=NMOD_IFN, NIMM=NMOD_IMM, &
PDTHRAD=PDTHRAD, PTHT=PTHT, PRT=PRT, PSVT=PSVT, PW_NU=PW_NU, &
diff --git a/src/arome/ext/aro_rain_ice.F90 b/src/arome/ext/aro_rain_ice.F90
index 8bf8635c2d56e99ccd09f1345643abe6c4649b91..634e842a2dd9b136a479b69cbcb1dacc1035fd6b 100644
--- a/src/arome/ext/aro_rain_ice.F90
+++ b/src/arome/ext/aro_rain_ice.F90
@@ -193,7 +193,7 @@ REAL :: ZMASSPOS ! total mass for one water category
! after removing the negative values
REAL :: ZRATIO ! ZMASSTOT / ZMASSCOR
REAL :: ZTWOTSTEP
-
+REAL :: ZTHVREFZIKB ! for electricity use only
TYPE(TBUDGETDATA), DIMENSION(NBUDGET_RH) :: YLBUDGET !NBUDGET_RH is the one with the highest number
TYPE(DIMPHYEX_t) :: YLDIMPHYEX
LOGICAL, DIMENSION(KLON,1,KLEV) :: LLMICRO
@@ -220,6 +220,12 @@ TLES%LLES_CALL=.FALSE.
ZTWOTSTEP=2*PTSTEP
ZINPRC=0.
PINPRH=0.
+IF (PHYEX%MISC%CELEC /='NONE') THEN
+CALL ABOR1('ARO_RAIN_ICE : CELEC ELECTRICITY SCHEME NOT YET CORRECLY PLUGGED HERE')
+! The following value of ZTHVREFZIKB must be removed from the electricity scheme or computed correctly here
+ELSE
+ ZTHVREFZIKB = 0. ! for electricity use only
+END IF
!Mask to limit computation
IF ( KRR == 7 ) THEN
@@ -358,8 +364,9 @@ ENDDO
!
IF (CMICRO=='ICE4' .AND. PHYEX%PARAM_ICEN%LRED) THEN
CALL RAIN_ICE( YLDIMPHYEX, PHYEX%CST, PHYEX%PARAM_ICEN, PHYEX%RAIN_ICE_PARAMN, &
- & PHYEX%RAIN_ICE_DESCRN, PHYEX%MISC%TBUCONF, &
- & PTSTEP=ZTWOTSTEP, &
+ & PHYEX%RAIN_ICE_DESCRN, PHYEX%ELEC_PARAM, PHYEX%ELEC_DESCR, &
+ & PHYEX%MISC%TBUCONF, OELEC=PHYEX%MISC%OELEC, OSEDIM_BEARD=PHYEX%MISC%OSEDIM_BEARD, &
+ & PTHVREFZIKB=ZTHVREFZIKB, HCLOUD=CMICRO, PTSTEP=ZTWOTSTEP, &
& KRR=KRR, PEXN=PEXNREF, &
& PDZZ=PDZZ, PRHODJ=PRHODJ, PRHODREF=PRHODREF, PEXNREF=PEXNREF,&
& PPABST=PPABSM, PCIT=PCIT, PCLDFR=PCLDFR, &
@@ -380,8 +387,9 @@ IF (CMICRO=='ICE4' .AND. PHYEX%PARAM_ICEN%LRED) THEN
& PRHT=PRT(:,:,:,7), PRHS=PRS(:,:,:,7), PINPRH=PINPRH, PFPR=PFPR)
ELSEIF (CMICRO=='ICE3' .AND. PHYEX%PARAM_ICEN%LRED) THEN
CALL RAIN_ICE( YLDIMPHYEX, PHYEX%CST, PHYEX%PARAM_ICEN, PHYEX%RAIN_ICE_PARAMN, &
- & PHYEX%RAIN_ICE_DESCRN, PHYEX%MISC%TBUCONF, &
- & PTSTEP=ZTWOTSTEP, &
+ & PHYEX%RAIN_ICE_DESCRN, PHYEX%ELEC_PARAM, PHYEX%ELEC_DESCR, &
+ & PHYEX%MISC%TBUCONF, OELEC=PHYEX%MISC%OELEC, OSEDIM_BEARD=PHYEX%MISC%OSEDIM_BEARD, &
+ & PTHVREFZIKB=ZTHVREFZIKB, HCLOUD=CMICRO, PTSTEP=ZTWOTSTEP, &
& KRR=KRR, PEXN=PEXNREF, &
& PDZZ=PDZZ, PRHODJ=PRHODJ, PRHODREF=PRHODREF,PEXNREF=PEXNREF,&
& PPABST=PPABSM, PCIT=PCIT, PCLDFR=PCLDFR, &
diff --git a/src/arome/ext/aro_turb_mnh.F90 b/src/arome/ext/aro_turb_mnh.F90
index 18dd0e0f50a38b42664123c7a8f583383628bcc3..f7dbb2a89ebdf830f646abc42e1465be340e2e2e 100644
--- a/src/arome/ext/aro_turb_mnh.F90
+++ b/src/arome/ext/aro_turb_mnh.F90
@@ -368,7 +368,7 @@ CALL TURB (PHYEX%CST,PHYEX%CSTURB,TBUCONF,PHYEX%TURBN, PHYEX%NEBN, YLDIMPHYEX,YL
& PHYEX%MISC%O2D, PHYEX%MISC%ONOMIXLG, PHYEX%MISC%OFLAT, PHYEX%MISC%OCOUPLES, PHYEX%MISC%OBLOWSNOW,&
& PHYEX%MISC%OIBM, PHYEX%MISC%OFLYER, PHYEX%MISC%OCOMPUTE_SRC, PHYEX%MISC%XRSNOW, &
& PHYEX%MISC%OOCEAN,PHYEX%MISC%ODEEPOC, PHYEX%MISC%ODIAG_IN_RUN, &
- & PHYEX%TURBN%CTURBLEN_CLOUD, CMICRO, &
+ & PHYEX%TURBN%CTURBLEN_CLOUD, CMICRO, PHYEX%MISC%CELEC, &
& ZTWOTSTEP,ZTFILE, &
& ZDXX,ZDYY,ZDZZ,ZDZX,ZDZY,ZZZ, &
& ZDIRCOSXW,ZDIRCOSYW,ZDIRCOSZW,ZCOSSLOPE,ZSINSLOPE, &
diff --git a/src/arome/ext/suphmpa.F90 b/src/arome/ext/suphmpa.F90
index 35ceb6164e74523771d371c78cd12f7b161a24ab..faa7f789ee30b123bd4f47f561019da94a75be9f 100644
--- a/src/arome/ext/suphmpa.F90
+++ b/src/arome/ext/suphmpa.F90
@@ -61,7 +61,7 @@ USE YOMCT0 ,ONLY : LELAM
USE MODD_BUDGET, ONLY : TBUCONF_ASSOCIATE, TBUCONF
USE MODI_INI_PHYEX, ONLY: INI_PHYEX
-
+USE MODD_IO, ONLY : TFILEDATA
! ------------------------------------------------------------------
IMPLICIT NONE
@@ -72,7 +72,7 @@ TYPE(MODEL_GENERAL_CONF_TYPE),INTENT(INOUT):: YDML_GCONF
TYPE(TDYNA), INTENT(IN) :: YDDYNA
TYPE(MODEL_PHYSICS_MF_TYPE),INTENT(INOUT):: YDML_PHY_MF
INTEGER(KIND=JPIM),INTENT(IN) :: KULOUT
-
+TYPE(TFILEDATA) :: TPFILE
! ------------------------------------------------------------------
@@ -115,7 +115,8 @@ IF(LMFSHAL.OR.LEDKF) THEN
ELSE
CSCONV='NONE'
ENDIF
-CALL INI_PHYEX(PHYEX%MISC%CPROGRAM, NULNAM, .TRUE., KULOUT, 0, 1, &
+TPFILE%NLU = NULNAM
+CALL INI_PHYEX(PHYEX%MISC%CPROGRAM, TPFILE, .TRUE., KULOUT, 0, 1, &
ZTSTEP, ZDZMIN, &
CMICRO, CSCONV, CTURB, &
KPRINT=2, &
diff --git a/src/common/aux/ini_phyex.F90 b/src/common/aux/ini_phyex.F90
index 95c371288483251224cb7bc880762ee57bac965f..67f3626d061a61be34ef35514c7d107aa4ba61d5 100644
--- a/src/common/aux/ini_phyex.F90
+++ b/src/common/aux/ini_phyex.F90
@@ -1,4 +1,4 @@
-SUBROUTINE INI_PHYEX(HPROGRAM, KUNITNML, LDNEEDNAM, KLUOUT, KFROM, KTO, &
+SUBROUTINE INI_PHYEX(HPROGRAM, TPFILE, LDNEEDNAM, KLUOUT, KFROM, KTO, &
&PTSTEP, PDZMIN, &
&CMICRO, CSCONV, CTURB, &
&LDCHANGEMODEL, LDDEFAULTVAL, LDREADNAM, LDCHECK, KPRINT, LDINIT, &
@@ -48,6 +48,7 @@ USE MODD_PARAM_LIMA_WARM, ONLY: PARAM_LIMA_WARM
USE MODD_PARAM_LIMA_COLD, ONLY: PARAM_LIMA_COLD
USE MODD_PARAM_LIMA_MIXED, ONLY: PARAM_LIMA_MIXED
USE MODD_NSV, ONLY: TNSV, NSV_ASSOCIATE
+USE MODD_IO, ONLY: TFILEDATA
!
USE MODE_INI_CST, ONLY: INI_CST
USE MODE_INI_RAIN_ICE, ONLY: INI_RAIN_ICE
@@ -86,7 +87,7 @@ USE MODE_MSG, ONLY: PRINT_MSG, NVERB_FATAL
IMPLICIT NONE
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM !< Current program
-INTEGER, INTENT(IN) :: KUNITNML !< Logical unit to access the namelist
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE !< Namelist file
LOGICAL, INTENT(IN) :: LDNEEDNAM !< True to abort if namelist is absent
INTEGER, INTENT(IN) :: KLUOUT !< Logical unit for outputs
INTEGER, INTENT(IN) :: KFROM !< Old model number
@@ -163,10 +164,10 @@ IF(CMICRO=='ICE3' .OR. CMICRO=='ICE4' .OR. CMICRO=='LIMA') THEN
ENDIF
ENDIF
- CALL PARAM_ICEN_INIT(HPROGRAM, KUNITNML, LDNEEDNAM, KLUOUT, &
+ CALL PARAM_ICEN_INIT(HPROGRAM, TPFILE, LDNEEDNAM, KLUOUT, &
&LDDEFAULTVAL, LDREADNAM, LDCHECK, KPRINT)
IF(CMICRO=='LIMA') THEN
- CALL PARAM_LIMA_INIT(HPROGRAM, KUNITNML, LDNEEDNAM, KLUOUT, &
+ CALL PARAM_LIMA_INIT(HPROGRAM, TPFILE, LDNEEDNAM, KLUOUT, &
&LDDEFAULTVAL, LDREADNAM, LDCHECK, KPRINT)
ENDIF
@@ -217,7 +218,7 @@ IF(CSCONV=='EDKF') THEN
IF(LLCHANGEMODEL) CALL PARAM_MFSHALL_GOTO_MODEL(KFROM, KTO)
IF(PRESENT(PHYEX_IN)) PARAM_MFSHALLN=PHYEX_IN%PARAM_MFSHALLN
- CALL PARAM_MFSHALLN_INIT(HPROGRAM, KUNITNML, LDNEEDNAM, KLUOUT, &
+ CALL PARAM_MFSHALLN_INIT(HPROGRAM, TPFILE, LDNEEDNAM, KLUOUT, &
&LDDEFAULTVAL, LDREADNAM, LDCHECK, KPRINT)
IF(LLINIT) THEN
CALL INI_MFSHALL()
@@ -233,7 +234,7 @@ IF(.TRUE.) THEN !Placeholder for configuration without cloud scheme or a differe
IF(LLCHANGEMODEL) CALL NEB_GOTO_MODEL(KFROM, KTO)
IF(PRESENT(PHYEX_IN)) NEBN=PHYEX_IN%NEBN
- CALL NEBN_INIT(HPROGRAM, KUNITNML, LDNEEDNAM, KLUOUT, &
+ CALL NEBN_INIT(HPROGRAM, TPFILE, LDNEEDNAM, KLUOUT, &
&LDDEFAULTVAL, LDREADNAM, LDCHECK, KPRINT)
IF(LLINIT) THEN
!Nothing to do, everything is read from namelist
@@ -255,7 +256,7 @@ IF(CTURB=='TKEL') THEN
CSTURB=PHYEX_IN%CSTURB
ENDIF
- CALL TURBN_INIT(HPROGRAM, KUNITNML, LDNEEDNAM, KLUOUT, &
+ CALL TURBN_INIT(HPROGRAM, TPFILE, LDNEEDNAM, KLUOUT, &
&LDDEFAULTVAL, LDREADNAM, LDCHECK, KPRINT)
IF(LLINIT) THEN
CALL INI_TURB(HPROGRAM)
diff --git a/src/common/aux/modd_dimphyexn.F90 b/src/common/aux/modd_dimphyexn.F90
index cac698c823aa8e03727ee9d744341830f5e9ef9a..f9b5cf5f0a39d20e5345ececc6006b5dc983e5b0 100644
--- a/src/common/aux/modd_dimphyexn.F90
+++ b/src/common/aux/modd_dimphyexn.F90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1995-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2022-2023 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.
@@ -53,7 +53,7 @@ TYPE DIMPHYEX_t
! 1: as for Méso-NH, levels are numbered from ground to space
! -1: as for AROME, levels are numbered from space to ground
INTEGER :: NKT ! Array total dimension
- INTEGER :: NKLES ! Total physical k dimension (for LES diag)
+ INTEGER :: NKLES ! Number of vertical levels for LES diagnostics
INTEGER :: NKA ! Near ground array index (is an unphysical level if JPVEXT!=0)
INTEGER :: NKU ! Uppest atmosphere array index (is an unphysical level if JPVEXT!=0)
INTEGER :: NKB ! Near ground physical array index (e.g. equal to 1+JPVEXT if NKL==1)
diff --git a/src/common/aux/modd_io.F90 b/src/common/aux/modd_io.F90
index 56ae6db2b0feebb2decd74b3d29fafaa44a9d1e0..e66f61a044db4a5772afbd09b68ada9a24079613 100644
--- a/src/common/aux/modd_io.F90
+++ b/src/common/aux/modd_io.F90
@@ -30,5 +30,6 @@ TYPE TFILEDATA
INTEGER :: NMODEL = 0 !Model number corresponding to the file (field not always set)
INTEGER,DIMENSION(3) :: NMNHVERSION = (/0,0,0/) !MesoNH version used to create the file
!
+ INTEGER :: NLU = -1 ! logical unit number
END TYPE TFILEDATA
ENDMODULE MODD_IO
diff --git a/src/common/aux/modd_phyex.F90 b/src/common/aux/modd_phyex.F90
index 6b8ddb985f6e7736b12ae3c805788d684e4c377a..493013dda18d51d9f5b16389f2aea34fb9cddaef 100644
--- a/src/common/aux/modd_phyex.F90
+++ b/src/common/aux/modd_phyex.F90
@@ -32,6 +32,8 @@ USE MODD_PARAM_LIMA, ONLY: PARAM_LIMA_t
USE MODD_PARAM_LIMA_WARM, ONLY: PARAM_LIMA_WARM_t
USE MODD_PARAM_LIMA_COLD, ONLY: PARAM_LIMA_COLD_t
USE MODD_PARAM_LIMA_MIXED, ONLY: PARAM_LIMA_MIXED_t
+USE MODD_ELEC_DESCR, ONLY: ELEC_DESCR_t
+USE MODD_ELEC_PARAM, ONLY: ELEC_PARAM_t
USE MODD_NSV, ONLY: NSV_t
USE MODD_MISC, ONLY: MISC_t
!
@@ -52,6 +54,8 @@ TYPE PHYEX_t
TYPE(PARAM_LIMA_WARM_t):: PARAM_LIMA_WARM !< Microphysical factors for LIMA (warm processes)
TYPE(PARAM_LIMA_COLD_t):: PARAM_LIMA_COLD !< Microphysical factors for LIMA (cold processes)
TYPE(PARAM_LIMA_MIXED_t):: PARAM_LIMA_MIXED !< Microphysical factors for LIMA (mixed processes)
+ TYPE(ELEC_DESCR_t) :: ELEC_DESCR ! Electricity descriptive constants
+ TYPE(ELEC_PARAM_t) :: ELEC_PARAM ! Electricity parameters
TYPE(NSV_t) :: TNSV !< NSV indexes
!
! Supplementary strucuture to hold model specific values
diff --git a/src/common/aux/mode_posnam_phy.F90 b/src/common/aux/mode_posnam_phy.F90
index 06a6d49bc62b4bba3487b87af125848b8d868b6e..1b7abf128aff3e0e0be1c41611a196a584b8a51c 100644
--- a/src/common/aux/mode_posnam_phy.F90
+++ b/src/common/aux/mode_posnam_phy.F90
@@ -3,33 +3,33 @@ IMPLICIT NONE
PRIVATE
PUBLIC :: POSNAM_PHY
CONTAINS
-SUBROUTINE POSNAM_PHY(KULNAM, CDNAML, LDNEEDNAM, LDFOUND, KLUOUT)
+SUBROUTINE POSNAM_PHY(TFILENAM, CDNAML, LDNEEDNAM, LDFOUND)
!To position namelist file at correct place for reading namelists
!Code adapted from different sources (ECMWF, ARPIFS, MESO-NH)
USE MODE_MSG, ONLY: NVERB_FATAL, NVERB_WARNING, PRINT_MSG
+USE MODD_IO, ONLY: TFILEDATA
IMPLICIT NONE
-INTEGER, INTENT(IN) :: KULNAM !< Logical unit to access the namelist
+TYPE(TFILEDATA), INTENT(IN) :: TFILENAM !< Namelist file
CHARACTER(LEN=*), INTENT(IN) :: CDNAML !< Namelist name
LOGICAL, INTENT(IN) :: LDNEEDNAM !< True to abort if namelist is absent
LOGICAL, INTENT(OUT) :: LDFOUND !< True if namelist has been found
-INTEGER, INTENT(IN) :: KLUOUT !< Logical unit for output
INTEGER :: IVERB, ILEN, ISTATUS, ISCAN, IND
CHARACTER(LEN=120) :: CLINE
CHARACTER(LEN=1) :: CLTEST
-REWIND(KULNAM)
+REWIND(TFILENAM%NLU)
ILEN=LEN(CDNAML)
LDFOUND=.TRUE.
ISTATUS=0
ISCAN=0
CLINE=' '
DO WHILE(ISTATUS==0 .AND. ISCAN==0)
- READ(KULNAM,'(A)',IOSTAT=ISTATUS) CLINE
+ READ(TFILENAM%NLU,'(A)',IOSTAT=ISTATUS) CLINE
IF(ISTATUS<=-1) THEN
!End of file
LDFOUND=.FALSE.
@@ -54,7 +54,7 @@ DO WHILE(ISTATUS==0 .AND. ISCAN==0)
ENDIF
ENDIF
ENDDO
-BACKSPACE(KULNAM)
+BACKSPACE(TFILENAM%NLU)
END SUBROUTINE POSNAM_PHY
diff --git a/src/common/aux/mode_sources_neg_correct.F90 b/src/common/aux/mode_sources_neg_correct.F90
index 49bf5f75ddcb4a854bb3ddde0bd2c3c37c47be4c..daf1fceaad5bc2765b7f3d106644726714aebf4f 100644
--- a/src/common/aux/mode_sources_neg_correct.F90
+++ b/src/common/aux/mode_sources_neg_correct.F90
@@ -1,12 +1,13 @@
MODULE MODE_SOURCES_NEG_CORRECT
IMPLICIT NONE
CONTAINS
-SUBROUTINE SOURCES_NEG_CORRECT_PHY(D, KSV, HCLOUD, HBUDNAME, KRR, PTSTEP, PPABST, &
+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
IMPLICIT NONE
TYPE(DIMPHYEX_t), INTENT(IN) :: D
INTEGER, INTENT(IN) :: KSV ! Number of SV variables
+CHARACTER(lEN=*), INTENT(IN) :: HELEC ! Kind of cloud electricity parameterization
CHARACTER(LEN=*), INTENT(IN) :: HCLOUD ! Kind of cloud parameterization
CHARACTER(LEN=*), INTENT(IN) :: HBUDNAME ! Budget name
INTEGER, INTENT(IN) :: KRR ! Number of moist variables
diff --git a/src/common/aux/modi_ini_phyex.F90 b/src/common/aux/modi_ini_phyex.F90
index 70e2c41ff8bb9941c8439ec64b1d7768d7ad7e4c..99055d15ef654d9e799488b0bdb154732149c461 100644
--- a/src/common/aux/modi_ini_phyex.F90
+++ b/src/common/aux/modi_ini_phyex.F90
@@ -1,7 +1,7 @@
MODULE MODI_INI_PHYEX
IMPLICIT NONE
INTERFACE
-SUBROUTINE INI_PHYEX(HPROGRAM, KUNITNML, LDNEEDNAM, KLUOUT, KFROM, KTO, &
+SUBROUTINE INI_PHYEX(HPROGRAM, TPFILE, LDNEEDNAM, KLUOUT, KFROM, KTO, &
&PTSTEP, PDZMIN, &
&CMICRO, CSCONV, CTURB, &
&LDCHANGEMODEL, LDDEFAULTVAL, LDREADNAM, LDCHECK, KPRINT, LDINIT, &
@@ -17,11 +17,12 @@ USE MODD_PARAM_MFSHALL_N,ONLY: PARAM_MFSHALL_t
USE MODD_TURB_N, ONLY: TURB_t
USE MODD_CTURB, ONLY: CSTURB_t
USE MODD_NEB_N, ONLY: NEB_t
+USE MODD_IO, ONLY: TFILEDATA
!
IMPLICIT NONE
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM !< Current program
-INTEGER, INTENT(IN) :: KUNITNML !< Logical unit to access the namelist
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE !< Logical unit to access the namelist
LOGICAL, INTENT(IN) :: LDNEEDNAM !< True to abort if namelist is absent
INTEGER, INTENT(IN) :: KLUOUT !< Logical unit for outputs
INTEGER, INTENT(IN) :: KFROM !< Old model number
diff --git a/src/common/micro/lima.F90 b/src/common/micro/lima.F90
index 6665319bc5689b249629c1cf42b6ce5ded85919b..db3144ccbaae83a7cd38ee222b43e21fabd6dc8c 100644
--- a/src/common/micro/lima.F90
+++ b/src/common/micro/lima.F90
@@ -4,15 +4,16 @@
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! #####################################################################
-SUBROUTINE LIMA ( D, CST, BUCONF, TBUDGETS, KBUDGETS, &
- PTSTEP, &
- PRHODREF, PEXNREF, PDZZ, &
+SUBROUTINE LIMA ( D, CST, ICED, ICEP, ELECD, ELECP,BUCONF, TBUDGETS, KBUDGETS,&
+ PTSTEP, OELEC, HCLOUD, &
+ PRHODREF, PEXNREF, PDZZ,PTHVREFZIKB, &
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,18 +42,25 @@ 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
! ------------
USE MODD_DIMPHYEX, ONLY: DIMPHYEX_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_ELEC_PARAM, ONLY: ELEC_PARAM_t
+USE MODD_ELEC_DESCR, ONLY: ELEC_DESCR_t
USE MODD_BUDGET, ONLY: TBUDGETDATA, TBUDGETCONF_t, NBUDGET_TH, NBUDGET_RV, NBUDGET_RC, &
NBUDGET_RI, NBUDGET_RR, NBUDGET_RS, NBUDGET_RG, NBUDGET_RH, NBUDGET_SV1
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,18 +76,27 @@ USE MODE_LIMA_NUCLEATION_PROCS, ONLY: LIMA_NUCLEATION_PROCS
USE MODE_LIMA_SEDIMENTATION, ONLY: LIMA_SEDIMENTATION
USE MODE_LIMA_TENDENCIES, ONLY: LIMA_TENDENCIES
!
+USE MODE_ELEC_TENDENCIES, ONLY : ELEC_TENDENCIES
+!
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
!
TYPE(DIMPHYEX_t), INTENT(IN) :: D
TYPE(CST_t), INTENT(IN) :: CST
+TYPE(RAIN_ICE_DESCR_t), INTENT(IN) :: ICED
+TYPE(RAIN_ICE_PARAM_t), INTENT(IN) :: ICEP
+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
TYPE(TBUDGETDATA), DIMENSION(KBUDGETS), INTENT(INOUT) :: TBUDGETS
+CHARACTER (LEN=4), INTENT(IN) :: HCLOUD ! Kind of microphysical scheme
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 +132,12 @@ 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
+!
+REAL, INTENT(IN) :: PTHVREFZIKB ! Reference thv at IKB for electricity
!* 0.2 Declarations of local variables :
!
!
@@ -169,9 +192,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 +217,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 +256,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 +282,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 +335,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 +405,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 +448,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 +545,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 +612,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 +758,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 +785,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, ICED, HCLOUD, &
+ 'L', 2, 2, 1, PTSTEP, OELEC, PDZZ, PRHODREF, PTHVREFZIKB, PPABST, ZT, ZRT_SUM, ZCPT, &
+ ZRCS, ZCCS, PINPRC, PFPR(:,:,:,2), PEFIELDW, ZQCS)
+ ELSE
+ CALL LIMA_SEDIMENTATION(D, CST, ICED, HCLOUD, &
+ 'L', 2, 2, 1, PTSTEP, OELEC, PDZZ, PRHODREF, PTHVREFZIKB, 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, ICED, HCLOUD, &
+ 'L', NMOM_R, 3, 1, PTSTEP, OELEC, PDZZ, PRHODREF, PTHVREFZIKB,PPABST, ZT, ZRT_SUM, ZCPT, &
+ ZRRS, ZCRS, PINPRR, PFPR(:,:,:,3), PEFIELDW, ZQRS)
+ ELSE
+ CALL LIMA_SEDIMENTATION(D, CST, ICED, HCLOUD, &
+ 'L', NMOM_R, 3, 1, PTSTEP, OELEC, PDZZ, PRHODREF,PTHVREFZIKB, 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, ICED, HCLOUD, &
+ 'I', NMOM_I, 4, 1, PTSTEP, OELEC, PDZZ, PRHODREF,PTHVREFZIKB, PPABST, ZT, ZRT_SUM, ZCPT, &
+ ZRIS, ZCIS, ZW2D, PFPR(:,:,:,4), PEFIELDW, ZQIS)
+ ELSE
+ CALL LIMA_SEDIMENTATION(D, CST, ICED, HCLOUD, &
+ 'I', NMOM_I, 4, 1, PTSTEP, OELEC, PDZZ, PRHODREF,PTHVREFZIKB, 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, ICED, HCLOUD, &
+ 'I', NMOM_S, 5, 1, PTSTEP, OELEC, PDZZ, PRHODREF, PTHVREFZIKB, PPABST, ZT, ZRT_SUM, ZCPT, &
+ ZRSS, ZCSS, PINPRS, PFPR(:,:,:,5), PEFIELDW, ZQSS)
+ ELSE
+ CALL LIMA_SEDIMENTATION(D, CST, ICED, HCLOUD, &
+ 'I', NMOM_S, 5, 1, PTSTEP, OELEC, PDZZ, PRHODREF, PTHVREFZIKB, 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, ICED, HCLOUD, &
+ 'I', NMOM_G, 6, 1, PTSTEP, OELEC, PDZZ, PRHODREF, PTHVREFZIKB, PPABST, ZT, ZRT_SUM, ZCPT, &
+ ZRGS, ZCGS, PINPRG, PFPR(:,:,:,6), PEFIELDW, ZQGS)
+ ELSE
+ CALL LIMA_SEDIMENTATION(D, CST, ICED, HCLOUD, &
+ 'I', NMOM_G, 6, 1, PTSTEP, OELEC, PDZZ, PRHODREF, PTHVREFZIKB, 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, ICED, HCLOUD, &
+ 'I', NMOM_H, 7, 1, PTSTEP, OELEC, PDZZ, PRHODREF, PTHVREFZIKB, PPABST, ZT, ZRT_SUM, ZCPT, &
+ ZRHS, ZCHS, PINPRH, PFPR(:,:,:,7), PEFIELDW, ZQHS)
+ ELSE
+ CALL LIMA_SEDIMENTATION(D, CST, ICED, HCLOUD, &
+ 'I', NMOM_H, 7, 1, PTSTEP, OELEC, PDZZ, PRHODREF, PTHVREFZIKB, 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.1 ) &
+ 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 +924,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 +1010,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 +1034,7 @@ CALL LIMA_COMPUTE_CLOUD_FRACTIONS (D, &
ZCHT, ZRHT, &
PCLDFR, PICEFR, PPRCFR )
!
+!
!-------------------------------------------------------------------------------
!
!* 2. Nucleation processes
@@ -812,7 +1046,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 +1076,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 +1182,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 +1219,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 +1304,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 +1398,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 +1431,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 +1458,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 +1692,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 +1741,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 +1816,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 +1866,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 +1938,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 +2026,188 @@ 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, CST, ICED, ICEP, ELECD, ELECP, &
+ KRR, IELEC, PTSTEP, GMASK_ELEC, &
+ BUCONF, TBUDGETS, KBUDGETS, &
+ HCLOUD, PTHVREFZIKB, &
+ 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, CST, ICED, ICEP, ELECD, ELECP, &
+ KRR, IELEC, PTSTEP, GMASK_ELEC, &
+ BUCONF, TBUDGETS, KBUDGETS, &
+ HCLOUD, PTHVREFZIKB, &
+ 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 +2281,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 +2296,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 +2333,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 +2350,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/mesonh/micro/modd_elec_descr.f90 b/src/common/micro/modd_elec_descr.F90
similarity index 86%
rename from src/mesonh/micro/modd_elec_descr.f90
rename to src/common/micro/modd_elec_descr.F90
index 82d346588cb8f8c435011290facd2b8c667f311f..db6aaa9587502e2c80bc9f6eb9be30cad41dade3 100644
--- a/src/mesonh/micro/modd_elec_descr.f90
+++ b/src/common/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,11 @@ 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 +158,37 @@ 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
+ REAL :: XECHARGE ! Elementary charge (C)
+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(), &
+ XECHARGE => 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
+ XECHARGE=> ELEC_DESCR%XECHARGE
+END SUBROUTINE ELEC_DESCR_ASSOCIATE
+!
END MODULE MODD_ELEC_DESCR
diff --git a/src/common/micro/modd_elec_param.F90 b/src/common/micro/modd_elec_param.F90
new file mode 100644
index 0000000000000000000000000000000000000000..128c292e931d918d3e805371a080dfad70fbfe3f
--- /dev/null
+++ b/src/common/micro/modd_elec_param.F90
@@ -0,0 +1,261 @@
+!MNH_LIC Copyright 2002-2023 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 MODD_ELEC_PARAM
+! #######################
+!
+!!**** *MODD_ELEC_PARAM* - declaration of some electrical factors
+!! extensively used in the electrical scheme.
+!!
+!! PURPOSE
+!! -------
+! The purpose of this declarative module is to declare some precomputed
+! electrical parameters directly used in routines related to cloud electricity
+!!
+!!** IMPLICIT ARGUMENTS
+!! ------------------
+!! None
+!!
+!! REFERENCE
+!! ---------
+!!
+!! AUTHOR
+!! ------
+!! Gilles Molinie * Laboratoire d'Aerologie *
+!!
+!!
+!! 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
+! ------------
+!
+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(:,:), ALLOCATABLE & ! Normalized kernel for
+ :: XKER_Q_RACCS, XKER_Q_RACCSS, XKER_Q_SACCRG ! RACCS, RACCSS, SACCRG
+!
+REAL :: XFQSDRYG, XFQSDRYGB, XFQRDRYG ! Constant in SDRYG and RDRYG
+!
+! charge separation
+!
+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 :: XLBQSDRYGB4H, XLBQSDRYGB5H, XLBQSDRYGB6H ! Constants in QIDRYGB
+REAL :: XFQSDRYGBH !
+!
+! Gardiner
+!
+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 :: 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 :: 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 :: XFQIDRYGBT1, XFQIDRYGBT2, XFQIDRYGBT3, & ! IDRYGB
+ XFQSDRYGBT1, XFQSDRYGBT2, XFQSDRYGBT3, & ! SDRYGB
+ XFQSDRYGBT4, XFQSDRYGBT5, XFQSDRYGBT6, & ! SDRYGB
+ XFQSDRYGBT7, XFQSDRYGBT8, XFQSDRYGBT9, & ! SDRYGB
+ XFQSDRYGBT10, XFQSDRYGBT11, XFQSDRYGBT12 ! SDRYGB
+!
+REAL :: XLBQRDRYG1, XLBQRDRYG2, XLBQRDRYG3 ! Integral of normalization in
+REAL :: XLBQSDRYG1, XLBQSDRYG2, XLBQSDRYG3 ! the accretion of graupel on
+ ! raindrop and snow process
+!
+REAL, DIMENSION(:,:), ALLOCATABLE &
+ :: XKER_Q_SDRYG, XKER_Q_RDRYG ! Normalized kernel for SDRYG and RDRYG
+!
+REAL :: XQREVAV1, XQREVAV2 ! Raindrops evaporation
+!
+! Add variables to limit the exchanged charge
+!
+REAL :: XAUX_LIM
+REAL :: XAUX_LIM1, XAUX_LIM2, XAUX_LIM3
+!
+!
+! Inductive charging process
+!
+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
+!
+REAL :: XFQLIGHTC, XFQLIGHTR, XFQLIGHTI, &
+ XFQLIGHTS, XFQLIGHTG, XFQLIGHTH ! Constant for charge redistribution
+REAL :: XEXQLIGHTR, XEXQLIGHTI, &
+ XEXQLIGHTS, XEXQLIGHTG, XEXQLIGHTH ! Exponent for charge redistribution
+!
+! 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/common/micro/modd_elecn.F90 b/src/common/micro/modd_elecn.F90
new file mode 100644
index 0000000000000000000000000000000000000000..3147dcb1853b7358926b28a094be68ae125de6a2
--- /dev/null
+++ b/src/common/micro/modd_elecn.F90
@@ -0,0 +1,122 @@
+!MNH_LIC Copyright 1994-2018 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 MODD_ELEC_n
+! ####################
+!
+!!**** *MODD_ELEC$n* - declaration of electric fields
+!!
+!! PURPOSE
+!! -------
+!!
+!!** IMPLICIT ARGUMENTS
+!! ------------------
+!! None
+!!
+!! REFERENCE
+!! ---------
+!!
+!! AUTHOR
+!! ------
+!!
+!! MODIFICATIONS
+!! -------------
+!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_PARAMETERS, ONLY: JPMODELMAX
+IMPLICIT NONE
+
+TYPE ELEC_t
+!
+! REAL, DIMENSION(:,:,:), POINTER :: XNI_SDRYG=>NULL(), XNI_IDRYG=>NULL(), &
+! XNI_IAGGS=>NULL(), &
+! XEFIELDU=>NULL(), & ! The 3 components of the electric field
+! XEFIELDV=>NULL(), XEFIELDW=>NULL(), &
+ REAL, DIMENSION(:,:,:), POINTER :: XESOURCEFW=>NULL(), & ! Fair weather electric charge (C m^-3)
+! XIND_RATE=>NULL(), XEW=>NULL(), &
+ XEW=>NULL(), &
+ XIONSOURCEFW =>NULL(), & ! Fair weather ionic source
+ ! (ion pairs m-3 s-1) hold constant in time
+ XCION_POS_FW =>NULL(), XCION_NEG_FW =>NULL(), & !Positive and Negative ion mixing ratio
+ XMOBIL_POS =>NULL(), XMOBIL_NEG=>NULL() ! m2/V/s
+!
+! Parameters for flat lapalcian operator to solve the electric field
+! (see MODD_DYN_n)
+ REAL, DIMENSION(:), POINTER :: XRHOM_E =>NULL(), XAF_E =>NULL(), XCF_E =>NULL()
+ REAL, DIMENSION(:,:,:), POINTER :: XBFY_E =>NULL(), &
+ XBFB_E =>NULL(), XBF_SXP2_YP1_Z_E =>NULL()
+ ! Z_Splitting
+
+!
+END TYPE ELEC_t
+
+TYPE(ELEC_t), DIMENSION(JPMODELMAX), TARGET, SAVE :: ELEC_MODEL
+
+REAL, DIMENSION(:,:,:), POINTER :: XNI_SDRYG=>NULL(), XNI_IDRYG=>NULL(), &
+ XNI_IAGGS=>NULL(), XEFIELDU=>NULL(), &
+ XESOURCEFW=>NULL(), XEFIELDV=>NULL(), XEFIELDW=>NULL(), &
+ XIND_RATE=>NULL(), XIONSOURCEFW =>NULL(), XEW=>NULL(), &
+ XCION_POS_FW =>NULL(), XCION_NEG_FW =>NULL(), &
+ XMOBIL_POS =>NULL(), XMOBIL_NEG=>NULL(), XBFY_E =>NULL(), &
+ XBFB_E =>NULL(), XBF_SXP2_YP1_Z_E =>NULL()
+REAL, DIMENSION(:), POINTER :: XRHOM_E =>NULL(), XAF_E =>NULL(), XCF_E =>NULL()
+
+CONTAINS
+
+SUBROUTINE ELEC_GOTO_MODEL(KFROM, KTO)
+INTEGER, INTENT(IN) :: KFROM, KTO
+!
+! Save current state for allocated arrays
+!ELEC_MODEL(KFROM)%XNI_SDRYG=>XNI_SDRYG !Done in FIELDLIST_GOTO_MODEL
+!ELEC_MODEL(KFROM)%XNI_IDRYG=>XNI_IDRYG !Done in FIELDLIST_GOTO_MODEL
+!ELEC_MODEL(KFROM)%XNI_IAGGS=>XNI_IAGGS !Done in FIELDLIST_GOTO_MODEL
+!ELEC_MODEL(KFROM)%XIND_RATE=>XIND_RATE !Done in FIELDLIST_GOTO_MODEL
+ELEC_MODEL(KFROM)%XEW=>XEW
+!ELEC_MODEL(KFROM)%XEFIELDU=>XEFIELDU !Done in FIELDLIST_GOTO_MODEL
+!ELEC_MODEL(KFROM)%XEFIELDV=>XEFIELDV !Done in FIELDLIST_GOTO_MODEL
+!ELEC_MODEL(KFROM)%XEFIELDW=>XEFIELDW !Done in FIELDLIST_GOTO_MODEL
+ELEC_MODEL(KFROM)%XESOURCEFW=>XESOURCEFW
+ELEC_MODEL(KFROM)%XIONSOURCEFW=>XIONSOURCEFW
+ELEC_MODEL(KFROM)%XCION_POS_FW=>XCION_POS_FW
+ELEC_MODEL(KFROM)%XCION_NEG_FW=>XCION_NEG_FW
+ELEC_MODEL(KFROM)%XMOBIL_POS=>XMOBIL_POS
+ELEC_MODEL(KFROM)%XMOBIL_NEG=>XMOBIL_NEG
+ELEC_MODEL(KFROM)%XBFY_E=>XBFY_E
+ELEC_MODEL(KFROM)%XBFB_E=>XBFB_E
+ELEC_MODEL(KFROM)%XBF_SXP2_YP1_Z_E=>XBF_SXP2_YP1_Z_E
+ELEC_MODEL(KFROM)%XRHOM_E=>XRHOM_E
+ELEC_MODEL(KFROM)%XAF_E=>XAF_E
+ELEC_MODEL(KFROM)%XCF_E=>XCF_E
+!
+! Current model is set to model KTO
+!XNI_SDRYG=>ELEC_MODEL(KTO)%XNI_SDRYG !Done in FIELDLIST_GOTO_MODEL
+!XNI_IDRYG=>ELEC_MODEL(KTO)%XNI_IDRYG !Done in FIELDLIST_GOTO_MODEL
+!XNI_IAGGS=>ELEC_MODEL(KTO)%XNI_IAGGS !Done in FIELDLIST_GOTO_MODEL
+!XIND_RATE=>ELEC_MODEL(KTO)%XIND_RATE !Done in FIELDLIST_GOTO_MODEL
+XEW=>ELEC_MODEL(KTO)%XEW
+!XEFIELDU=>ELEC_MODEL(KTO)%XEFIELDU !Done in FIELDLIST_GOTO_MODEL
+!XEFIELDV=>ELEC_MODEL(KTO)%XEFIELDV !Done in FIELDLIST_GOTO_MODEL
+!XEFIELDW=>ELEC_MODEL(KTO)%XEFIELDW !Done in FIELDLIST_GOTO_MODEL
+XESOURCEFW=>ELEC_MODEL(KTO)%XESOURCEFW
+XIONSOURCEFW=>ELEC_MODEL(KTO)%XIONSOURCEFW
+XCION_POS_FW=>ELEC_MODEL(KTO)%XCION_POS_FW
+XCION_NEG_FW=>ELEC_MODEL(KTO)%XCION_NEG_FW
+XMOBIL_POS=>ELEC_MODEL(KTO)%XMOBIL_POS
+XMOBIL_NEG=>ELEC_MODEL(KTO)%XMOBIL_NEG
+XBFY_E=>ELEC_MODEL(KTO)%XBFY_E
+XBFB_E=>ELEC_MODEL(KTO)%XBFB_E
+XBF_SXP2_YP1_Z_E=>ELEC_MODEL(KTO)%XBF_SXP2_YP1_Z_E
+XRHOM_E=>ELEC_MODEL(KTO)%XRHOM_E
+XAF_E=>ELEC_MODEL(KTO)%XAF_E
+XCF_E=>ELEC_MODEL(KTO)%XCF_E
+END SUBROUTINE ELEC_GOTO_MODEL
+
+END MODULE MODD_ELEC_n
diff --git a/src/common/micro/modd_nebn.F90 b/src/common/micro/modd_nebn.F90
index dce8f1d9aab9b16e9728812d8fbd01d52c26e5a3..fdc47f6a310a216583360260815a32b34149c86f 100644
--- a/src/common/micro/modd_nebn.F90
+++ b/src/common/micro/modd_nebn.F90
@@ -98,7 +98,7 @@ IF(.NOT. ASSOCIATED(NEBN, NEB_MODEL(KTO))) THEN
ENDIF
END SUBROUTINE NEB_GOTO_MODEL
!
-SUBROUTINE NEBN_INIT(HPROGRAM, KUNITNML, LDNEEDNAM, KLUOUT, &
+SUBROUTINE NEBN_INIT(HPROGRAM, TFILENAM, LDNEEDNAM, KLUOUT, &
&LDDEFAULTVAL, LDREADNAM, LDCHECK, KPRINT)
!!*** *NEBN_INIT* - Code needed to initialize the MODD_NEB_n module
!!
@@ -130,6 +130,7 @@ SUBROUTINE NEBN_INIT(HPROGRAM, KUNITNML, LDNEEDNAM, KLUOUT, &
!
USE MODE_POSNAM_PHY, ONLY: POSNAM_PHY
USE MODE_CHECK_NAM_VAL, ONLY: CHECK_NAM_VAL_CHAR
+USE MODD_IO, ONLY: TFILEDATA
!
IMPLICIT NONE
!
@@ -137,7 +138,7 @@ IMPLICIT NONE
! ------------------------
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM !< Name of the calling program
-INTEGER, INTENT(IN) :: KUNITNML !< Logical unit to access the namelist
+TYPE(TFILEDATA), INTENT(IN) :: TFILENAM !< Namelist file
LOGICAL, INTENT(IN) :: LDNEEDNAM !< True to abort if namelist is absent
INTEGER, INTENT(IN) :: KLUOUT !< Logical unit for outputs
LOGICAL, OPTIONAL, INTENT(IN) :: LDDEFAULTVAL !< Must we initialize variables with default values (defaults to .TRUE.)
@@ -197,8 +198,8 @@ ENDIF
! -----------
!
IF(LLREADNAM) THEN
- CALL POSNAM_PHY(KUNITNML, 'NAM_NEBN', LDNEEDNAM, LLFOUND, KLUOUT)
- IF(LLFOUND) READ(UNIT=KUNITNML, NML=NAM_NEBn)
+ CALL POSNAM_PHY(TFILENAM, 'NAM_NEBN', LDNEEDNAM, LLFOUND)
+ IF(LLFOUND) READ(UNIT=TFILENAM%NLU, NML=NAM_NEBn)
ENDIF
!
!* 3. CHECKS
diff --git a/src/common/micro/modd_param_icen.F90 b/src/common/micro/modd_param_icen.F90
index 9ea39306b764f20e53c5046b9341022d8d150e7b..1113a1d47a056e65f6d3f4efaae8bf5438c71813 100644
--- a/src/common/micro/modd_param_icen.F90
+++ b/src/common/micro/modd_param_icen.F90
@@ -229,7 +229,7 @@ IF(.NOT. ASSOCIATED(PARAM_ICEN, PARAM_ICE_MODEL(KTO))) THEN
ENDIF
END SUBROUTINE PARAM_ICE_GOTO_MODEL
!
-SUBROUTINE PARAM_ICEN_INIT(HPROGRAM, KUNITNML, LDNEEDNAM, KLUOUT, &
+SUBROUTINE PARAM_ICEN_INIT(HPROGRAM, TFILENAM, LDNEEDNAM, KLUOUT, &
&LDDEFAULTVAL, LDREADNAM, LDCHECK, KPRINT)
!!*** *PARAM_ICEN_INIT* - Code needed to initialize the MODD_PARAM_ICE_n module
!!
@@ -262,6 +262,7 @@ SUBROUTINE PARAM_ICEN_INIT(HPROGRAM, KUNITNML, LDNEEDNAM, KLUOUT, &
USE MODE_POSNAM_PHY, ONLY: POSNAM_PHY
USE MODE_MSG, ONLY: PRINT_MSG, NVERB_FATAL
USE MODE_CHECK_NAM_VAL, ONLY: CHECK_NAM_VAL_CHAR, CHECK_NAM_VAL_REAL, CHECK_NAM_VAL_INT
+USE MODD_IO, ONLY: TFILEDATA
!
IMPLICIT NONE
!
@@ -269,7 +270,7 @@ IMPLICIT NONE
! ------------------------
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM !< Name of the calling program
-INTEGER, INTENT(IN) :: KUNITNML !< Logical unit to access the namelist
+TYPE(TFILEDATA), INTENT(IN) :: TFILENAM !< Namelist file
LOGICAL, INTENT(IN) :: LDNEEDNAM !< True to abort if namelist is absent
INTEGER, INTENT(IN) :: KLUOUT !< Logical unit for outputs
LOGICAL, OPTIONAL, INTENT(IN) :: LDDEFAULTVAL !< Must we initialize variables with default values (defaults to .TRUE.)
@@ -392,8 +393,8 @@ ENDIF
! -----------
!
IF(LLREADNAM) THEN
- CALL POSNAM_PHY(KUNITNML, 'NAM_PARAM_ICEN', LDNEEDNAM, LLFOUND, KLUOUT)
- IF(LLFOUND) READ(UNIT=KUNITNML, NML=NAM_PARAM_ICEn)
+ CALL POSNAM_PHY(TFILENAM, 'NAM_PARAM_ICEN', LDNEEDNAM, LLFOUND)
+ IF(LLFOUND) READ(UNIT=TFILENAM%NLU, NML=NAM_PARAM_ICEn)
ENDIF
!
!* 3. CHECKS
diff --git a/src/common/micro/modd_param_lima.F90 b/src/common/micro/modd_param_lima.F90
index 3565e1d9a705310dd2c37f73b2768b296fa88c53..3b8b56a4a5cb1476f0875babf18fcd80d250a40a 100644
--- a/src/common/micro/modd_param_lima.F90
+++ b/src/common/micro/modd_param_lima.F90
@@ -557,7 +557,7 @@ SUBROUTINE PARAM_LIMA_ALLOCATE(HNAME, KDIM1, KDIM2, KDIM3)
END SELECT
END SUBROUTINE PARAM_LIMA_ALLOCATE
!
-SUBROUTINE PARAM_LIMA_INIT(HPROGRAM, KUNITNML, LDNEEDNAM, KLUOUT, &
+SUBROUTINE PARAM_LIMA_INIT(HPROGRAM, TFILENAM, LDNEEDNAM, KLUOUT, &
&LDDEFAULTVAL, LDREADNAM, LDCHECK, KPRINT)
!!*** *PARAM_ICEN_INIT* - Code needed to initialize the MODD_PARAM_LIMA module
!!
@@ -590,6 +590,7 @@ SUBROUTINE PARAM_LIMA_INIT(HPROGRAM, KUNITNML, LDNEEDNAM, KLUOUT, &
USE MODE_POSNAM_PHY, ONLY: POSNAM_PHY
USE MODE_MSG, ONLY: PRINT_MSG, NVERB_FATAL
USE MODE_CHECK_NAM_VAL, ONLY: CHECK_NAM_VAL_CHAR
+USE MODD_IO, ONLY: TFILEDATA
!
IMPLICIT NONE
!
@@ -597,7 +598,7 @@ IMPLICIT NONE
! ------------------------
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM !< Name of the calling program
-INTEGER, INTENT(IN) :: KUNITNML !< Logical unit to access the namelist
+TYPE(TFILEDATA), INTENT(IN) :: TFILENAM !< Namelist file
LOGICAL, INTENT(IN) :: LDNEEDNAM !< True to abort if namelist is absent
INTEGER, INTENT(IN) :: KLUOUT !< Logical unit for outputs
LOGICAL, OPTIONAL, INTENT(IN) :: LDDEFAULTVAL !< Must we initialize variables with default values (defaults to .TRUE.)
@@ -700,8 +701,8 @@ ENDIF
! -----------
!
IF(LLREADNAM) THEN
- CALL POSNAM_PHY(KUNITNML, 'NAM_PARAM_LIMA', LDNEEDNAM, LLFOUND, KLUOUT)
- IF(LLFOUND) READ(UNIT=KUNITNML, NML=NAM_PARAM_LIMA)
+ CALL POSNAM_PHY(TFILENAM, 'NAM_PARAM_LIMA', LDNEEDNAM, LLFOUND)
+ IF(LLFOUND) READ(UNIT=TFILENAM%NLU, NML=NAM_PARAM_LIMA)
ENDIF
!
!* 3. CHECKS
@@ -727,7 +728,7 @@ IF(LLCHECK) THEN
&"VALUE OF NMOD_CCN IN ORDER TO USE LIMA WARM ACTIVATION SCHEME.")
END IF
- IF(LNUCL .AND. NMOD_IFN == 0 .AND. (.NOT.LMEYERS)) THEN
+ IF(LNUCL .AND. NMOD_IFN == 0 .AND. (.NOT.LMEYERS) .AND. NMOM_I >= 2) THEN
CALL PRINT_MSG(NVERB_FATAL, 'GEN', 'MODD_PARAM_LIMA', &
&"NUCLEATION BY DEPOSITION AND CONTACT IS NOT " // &
&"POSSIBLE IF NMOD_IFN HAS VALUE ZERO. YOU HAVE TO SET AN UPPER" // &
diff --git a/src/common/micro/mode_compute_lambda.F90 b/src/common/micro/mode_compute_lambda.F90
new file mode 100644
index 0000000000000000000000000000000000000000..ba45978ba3a82791b61a1f6449a501372d1eca5c
--- /dev/null
+++ b/src/common/micro/mode_compute_lambda.F90
@@ -0,0 +1,214 @@
+!MNH_LIC Copyright 2022-2023 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 MODE_COMPUTE_LAMBDA
+! ##########################
+IMPLICIT NONE
+CONTAINS
+!
+! #########################################################
+ SUBROUTINE COMPUTE_LAMBDA (KID, KMOMENT, KSIZE, HCLOUD, &
+ 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_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
+CHARACTER (LEN=4), INTENT(IN) :: HCLOUD ! Kind of microphysical scheme
+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 (HCLOUD == '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 (HCLOUD == 'LIMA') THEN
+ ZLBX = XLBR_L
+ ZLBEX = XLBEXR_L
+ IF (KMOMENT == 1) THEN
+ ZCCX = XCCR_L
+ ZCXX = XCXR_L
+ END IF
+ ELSE IF (HCLOUD(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 (HCLOUD == 'LIMA') THEN
+ ZLBX = XLBI_L
+ ZLBEX = XLBEXI_L
+ ELSE IF (HCLOUD(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 (HCLOUD == '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 (HCLOUD(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 (HCLOUD == '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 (HCLOUD(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 (HCLOUD == '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 (HCLOUD(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
+END MODULE MODE_COMPUTE_LAMBDA
diff --git a/src/common/micro/mode_elec_beard_effect.F90 b/src/common/micro/mode_elec_beard_effect.F90
new file mode 100644
index 0000000000000000000000000000000000000000..b7f8f94fc75236c9da3c572e50a0036946801a87
--- /dev/null
+++ b/src/common/micro/mode_elec_beard_effect.F90
@@ -0,0 +1,281 @@
+!MNH_LIC Copyright 2013-2023 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 MODE_ELEC_BEARD_EFFECT
+!
+IMPLICIT NONE
+CONTAINS
+!
+! ###################################################################
+ SUBROUTINE ELEC_BEARD_EFFECT(D, CST, ICED, HCLOUD, KID, OSEDIM, PT, PRHODREF, PTHVREFZIKB, &
+ 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: CST_t
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+USE MODD_RAIN_ICE_DESCR_n, ONLY: RAIN_ICE_DESCR_t
+
+USE MODD_ELEC_DESCR, ONLY: XRTMIN_ELEC
+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 MODI_MOMG
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments
+!
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+TYPE(CST_t), INTENT(IN) :: CST
+TYPE(RAIN_ICE_DESCR_t), INTENT(IN) :: ICED
+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
+CHARACTER (LEN=4), INTENT(IN) :: HCLOUD ! Kind of microphysical scheme
+!
+REAL, INTENT(IN) :: PTHVREFZIKB ! Reference thv at IKB for electricity
+!* 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
+!
+!-------------------------------------------------------------------------------
+!
+
+ASSOCIATE(XALPHAC_I=>ICED%XALPHAC, XNUC_I=>ICED%XNUC, XALPHAR_I=>ICED%XALPHAR, XNUR_I=>ICED%XNUR, &
+ XALPHAI_I=>ICED%XALPHAI, XNUI_I=>ICED%XNUI, XALPHAS_I=>ICED%XALPHAS, XNUS_I=>ICED%XNUS, &
+ XALPHAG_I=>ICED%XALPHAG, XNUG_I=>ICED%XNUG, XALPHAH_I=>ICED%XALPHAH, XNUH_I=>ICED%XNUH, &
+ XBC_I=>ICED%XBC, XCC_I=>ICED%XCC, XDC_I=>ICED%XDC, &
+ XBR_I=>ICED%XBR, XCR_I=>ICED%XCR, XDR_I=>ICED%XDR, &
+ XBI_I=>ICED%XBI, XC_I_I=>ICED%XC_I, XDI_I=>ICED%XDI, &
+ XBS_I=>ICED%XBS, XCS_I=>ICED%XCS, XDS_I=>ICED%XDS, &
+ XBG_I=>ICED%XBG, XCG_I=>ICED%XCG, XDG_I=>ICED%XDG, &
+ XBH_I=>ICED%XBH, XCH_I=>ICED%XCH, XDH_I=>ICED%XDH, &
+ XCEXVT_I=>ICED%XCEXVT)
+
+
+!* 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 (HCLOUD(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 (HCLOUD == '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 * (PTHVREFZIKB - CST%XTT))
+!
+ZRHO00 = CST%XP00 / (CST%XRD * PTHVREFZIKB)
+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) - CST%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) * CST%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 ASSOCIATE
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE ELEC_BEARD_EFFECT
+END MODULE MODE_ELEC_BEARD_EFFECT
diff --git a/src/common/micro/mode_elec_compute_ex.F90 b/src/common/micro/mode_elec_compute_ex.F90
new file mode 100644
index 0000000000000000000000000000000000000000..7f0977cef7411fe7ba0b8c19ae470b1647e26bf7
--- /dev/null
+++ b/src/common/micro/mode_elec_compute_ex.F90
@@ -0,0 +1,206 @@
+!MNH_LIC Copyright 2022-2023 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 MODE_ELEC_COMPUTE_EX
+! ###########################
+IMPLICIT NONE
+CONTAINS
+!
+!
+! #######################################################
+ SUBROUTINE ELEC_COMPUTE_EX (KID, KMOMENT, KSIZE,HCLOUD, &
+ 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_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
+CHARACTER (LEN=4), INTENT(IN) :: HCLOUD ! Kind of microphysical scheme
+!
+!* 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 (HCLOUD(1:3) == 'ICE') ZFQUPDX = XFQUPDC
+ IF (HCLOUD == 'LIMA') THEN
+ ZALPHAX = XALPHAC
+ ZNUX = XNUC
+ END IF
+ELSE IF (KID == 3) THEN ! parameters for raindrops
+ ZFX = XFR
+ ZCX = XCXR
+ ZEXMAX = XERMAX
+ IF (HCLOUD(1:3) == 'ICE') ZFQUPDX = XFQUPDR
+ IF (HCLOUD == '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 (HCLOUD(1:3) == 'ICE') ZFQUPDX = XFQUPDI
+ IF (HCLOUD == '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 (HCLOUD == 'LIMA' .AND. KMOMENT == 2) THEN
+ ZALPHAX = XALPHAS
+ ZNUX = XNUS
+ ELSE IF (HCLOUD == 'LIMA' .AND. KMOMENT == 1) THEN
+ ZCX = XCXS_L
+ ELSE IF (HCLOUD(1:3) == 'ICE') THEN
+ ZCX = XCXS_I
+ END IF
+ELSE IF (KID == 6) THEN ! parameters for graupel
+ ZFX = XFG
+ ZEXMAX = XEGMAX
+ ZFQUPDX = XFQUPDG
+ IF (HCLOUD == 'LIMA' .AND. KMOMENT == 2) THEN
+ ZALPHAX = XALPHAG
+ ZNUX = XNUG
+ ELSE IF (HCLOUD == 'LIMA' .AND. KMOMENT == 1) THEN
+ ZCX = XCXG_L
+ ELSE IF (HCLOUD(1:3) == 'ICE') THEN
+ ZCX = XCXG_I
+ END IF
+ELSE IF (KID == 7) THEN ! parameters for hail
+ ZFX = XFH
+ ZEXMAX = XEHMAX
+ ZFQUPDX = XFQUPDH
+ IF (HCLOUD == 'LIMA' .AND. KMOMENT == 2) THEN
+ ZALPHAX = XALPHAH
+ ZNUX = XNUH
+ ELSE IF (HCLOUD == 'LIMA' .AND. KMOMENT == 1) THEN
+ ZCX = XCXH_L
+ ELSE IF (HCLOUD(1:3) == 'ICE') THEN
+ ZCX = XCXH_I
+ END IF
+END IF
+!
+IF (HCLOUD == '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
+END MODULE MODE_ELEC_COMPUTE_EX
diff --git a/src/common/micro/mode_elec_tendencies.F90 b/src/common/micro/mode_elec_tendencies.F90
new file mode 100644
index 0000000000000000000000000000000000000000..af2a62376f1ebd296ca6c3b46f9d88c76e7a74ce
--- /dev/null
+++ b/src/common/micro/mode_elec_tendencies.F90
@@ -0,0 +1,3462 @@
+!MNH_LIC Copyright 2022-2023 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 MODE_ELEC_TENDENCIES
+!
+IMPLICIT NONE
+CONTAINS
+!
+! #########################################################################################
+ SUBROUTINE ELEC_TENDENCIES (D, CST, ICED, ICEP, ELECD, ELECP, &
+ KRR, KMICRO, PTSTEP, ODMICRO, &
+ BUCONF, TBUDGETS, KBUDGETS, &
+ HCLOUD, PTHVREFZIKB, &
+ 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)
+!! C. Barthe 22/11/2023 initialize Nx to 0 when 1-moment
+!!
+!------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_BUDGET, ONLY: NBUDGET_TH, NBUDGET_RV, NBUDGET_RC, NBUDGET_RR, NBUDGET_RI, &
+ NBUDGET_RS, NBUDGET_RG, NBUDGET_RH, NBUDGET_SV1, &
+ TBUDGETDATA, TBUDGETCONF_t
+!
+USE MODD_CST, ONLY: CST_t
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_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_NSV, ONLY: NSV_ELECBEG, NSV_ELECEND
+USE MODD_ELEC_DESCR
+USE MODD_ELEC_PARAM
+USE MODD_ELEC_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
+!
+!#ifdef MNH_PGI
+!USE MODE_PACK_PGI
+!#endif
+use mode_tools, only: Countjv
+USE MODE_BUDGET_PHY, ONLY: BUDGET_STORE_ADD_PHY, BUDGET_STORE_INIT_PHY, BUDGET_STORE_END_PHY
+!
+USE MODE_COMPUTE_LAMBDA, ONLY: COMPUTE_LAMBDA
+USE MODE_ELEC_COMPUTE_EX,ONLY: ELEC_COMPUTE_EX
+USE MODI_MOMG
+!
+IMPLICIT NONE
+!
+!
+!* 0.1 Declaration of dummy arguments
+!
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+TYPE(CST_t), INTENT(IN) :: CST
+TYPE(TBUDGETCONF_t), INTENT(IN) :: BUCONF ! budget structure
+TYPE(RAIN_ICE_DESCR_t), INTENT(IN) :: ICED
+TYPE(RAIN_ICE_PARAM_t), INTENT(IN) :: ICEP
+TYPE(ELEC_PARAM_t), INTENT(IN) :: ELECP ! electrical parameters
+TYPE(ELEC_DESCR_t), INTENT(IN) :: ELECD ! electrical descriptive csts
+TYPE(TBUDGETDATA), DIMENSION(KBUDGETS),INTENT(INOUT) :: TBUDGETS
+INTEGER, INTENT(IN) :: KBUDGETS
+!
+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
+CHARACTER (LEN=4), INTENT(IN) :: HCLOUD ! Kind of microphysical scheme
+!
+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
+REAL, INTENT(IN) :: PTHVREFZIKB ! Reference thv at IKB for electricity
+!
+!
+!* 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
+!
+!------------------------------------------------------------------
+ASSOCIATE(XCEXVT_I=>ICED%XCEXVT, XRTMIN_I=>ICED%XRTMIN, &
+ XALPHAI_I=>ICED%XALPHAI, XNUI_I=>ICED%XNUI, XAI_I=>ICED%XAI, XBI_I=>ICED%XBI, &
+ XDS_I=>ICED%XDS, XDG_I=>ICED%XDG, &
+ XCXS_I=>ICED%XCXS, XCXG_I=>ICED%XCXG, &
+ XCOLIS_I=>ICEP%XCOLIS, XCOLEXIS_I=>ICEP%XCOLEXIS, &
+ XCOLIG_I=>ICEP%XCOLIG, XCOLEXIG_I=>ICEP%XCOLEXIG, &
+ XCOLSG_I=>ICEP%XCOLSG, XCOLEXSG_I=>ICEP%XCOLEXSG, &
+ NGAMINC_I=>ICEP%NGAMINC, &
+ NACCLBDAR_I=>ICEP%NACCLBDAR, NACCLBDAS_I=>ICEP%NACCLBDAS, &
+ XACCINTP1S_I=>ICEP%XACCINTP1S, XACCINTP2S_I=>ICEP%XACCINTP2S, &
+ XACCINTP1R_I=>ICEP%XACCINTP1R, XACCINTP2R_I=>ICEP%XACCINTP2R, &
+ NDRYLBDAR_I=>ICEP%NDRYLBDAR, NDRYLBDAS_I=>ICEP%NDRYLBDAS, &
+ NDRYLBDAG_I=>ICEP%NDRYLBDAG, &
+ XDRYINTP1R_I=>ICEP%XDRYINTP1R, XDRYINTP2R_I=>ICEP%XDRYINTP2R, &
+ XDRYINTP1S_I=>ICEP%XDRYINTP1S, XDRYINTP2S_I=>ICEP%XDRYINTP2S, &
+ XDRYINTP1G_I=>ICEP%XDRYINTP1G, XDRYINTP2G_I=>ICEP%XDRYINTP2G, &
+ XRIMINTP1_I=>ICEP%XRIMINTP1, XRIMINTP2_I=>ICEP%XRIMINTP2 )
+!
+!* 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 (HCLOUD(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 (HCLOUD == '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 = CST%XP00 / (CST%XRD * PTHVREFZIKB)
+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 (HCLOUD(1:3) == 'ICE') THEN ! ICE3 scheme
+ ALLOCATE(ZRCMLTSR(IMICRO))
+ ALLOCATE(ZRICFRR(IMICRO))
+ END IF
+ IF (HCLOUD == '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))
+ IF (IMOM_C == 1) ZCCT(JL) = 0.
+ IF (IMOM_R == 1) ZCRT(JL) = 0.
+ IF (IMOM_S == 1) ZCST(JL) = 0.
+ IF (IMOM_G == 1) ZCGT(JL) = 0.
+ IF (IMOM_H == 1) ZCHT(JL) = 0.
+ !
+ 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 (HCLOUD(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 (HCLOUD == '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 (HCLOUD(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 (HCLOUD == '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 (HCLOUD(1:3) == 'ICE') ZCCT(:) = 0.
+ CALL COMPUTE_LAMBDA(2, IMOM_C, KMICRO, HCLOUD, ZRHODREF, ZRTMIN(2), ZRCT, ZCCT, ZLBDAC)
+ CALL COMPUTE_LAMBDA(3, IMOM_R, KMICRO, HCLOUD, ZRHODREF, ZRTMIN(3), ZRRT, ZCRT, ZLBDAR)
+ CALL COMPUTE_LAMBDA(4, IMOM_I, KMICRO, HCLOUD, ZRHODREF, ZRTMIN(4), ZRIT, ZCIT, ZLBDAI)
+ CALL COMPUTE_LAMBDA(5, IMOM_S, KMICRO, HCLOUD, ZRHODREF, ZRTMIN(5), ZRST, ZCST, ZLBDAS)
+ CALL COMPUTE_LAMBDA(6, IMOM_G, KMICRO, HCLOUD, ZRHODREF, ZRTMIN(6), ZRGT, ZCGT, ZLBDAG)
+ IF (KRR == 7) CALL COMPUTE_LAMBDA(7, IMOM_H, KMICRO, HCLOUD, ZRHODREF, ZRTMIN(7), ZRHT, ZCHT, ZLBDAH)
+!
+!
+!* 1.7 update the parameter e in the charge-diameter relationship
+!
+! Compute e_x at time t
+ IF (HCLOUD == 'LIMA') THEN
+ CALL ELEC_COMPUTE_EX(2, IMOM_C, KMICRO, HCLOUD, 1., ZRHODREF, ZRTMIN(2), ZRCT, ZQCT, ZECT, PLBDX=ZLBDAC, PCX=ZCCT)
+ CALL ELEC_COMPUTE_EX(3, IMOM_R, KMICRO, HCLOUD, 1., ZRHODREF, ZRTMIN(3), ZRRT, ZQRT, ZERT, PLBDX=ZLBDAR, PCX=ZCRT)
+ CALL ELEC_COMPUTE_EX(4, IMOM_I, KMICRO, HCLOUD, 1., ZRHODREF, ZRTMIN(4), ZRIT, ZQIT, ZEIT, PLBDX=ZLBDAI, PCX=ZCIT)
+ CALL ELEC_COMPUTE_EX(5, IMOM_S, KMICRO, HCLOUD, 1., ZRHODREF, ZRTMIN(5), ZRST, ZQST, ZEST, PLBDX=ZLBDAS, PCX=ZCST)
+ CALL ELEC_COMPUTE_EX(6, IMOM_G, KMICRO, HCLOUD, 1., ZRHODREF, ZRTMIN(6), ZRGT, ZQGT, ZEGT, PLBDX=ZLBDAG, PCX=ZCGT)
+ IF (KRR == 7) CALL ELEC_COMPUTE_EX(7, IMOM_H, KMICRO, HCLOUD, 1., ZRHODREF, ZRTMIN(7), ZRHT, ZQHT, ZEHT, PLBDX=ZLBDAH, PCX=ZCHT)
+ ELSE IF (HCLOUD(1:3) == 'ICE') THEN
+ CALL ELEC_COMPUTE_EX(2, 1, KMICRO, HCLOUD, 1., ZRHODREF, ZRTMIN(2), ZRCT, ZQCT, ZECT)
+ CALL ELEC_COMPUTE_EX(3, 1, KMICRO, HCLOUD, 1., ZRHODREF, ZRTMIN(3), ZRRT, ZQRT, ZERT, PLBDX=ZLBDAR)
+ CALL ELEC_COMPUTE_EX(4, 1, KMICRO, HCLOUD, 1., ZRHODREF, ZRTMIN(4), ZRIT, ZQIT, ZEIT, PCX=ZCIT)
+ CALL ELEC_COMPUTE_EX(5, 1, KMICRO, HCLOUD, 1., ZRHODREF, ZRTMIN(5), ZRST, ZQST, ZEST, PLBDX=ZLBDAS)
+ CALL ELEC_COMPUTE_EX(6, 1, KMICRO, HCLOUD, 1., ZRHODREF, ZRTMIN(6), ZRGT, ZQGT, ZEGT, PLBDX=ZLBDAG)
+ IF (KRR == 7) CALL ELEC_COMPUTE_EX(7, 1, KMICRO, HCLOUD, 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 ( BUCONF%LBUDGET_SV ) then
+ CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 2 ), 'SFR', &
+ Unpack( zqrs(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ CALL BUDGET_STORE_INIT_PHY(D, 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 ( BUCONF%LBUDGET_SV ) then
+ CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 2 ), 'SFR', &
+ Unpack( zqrs(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 5 ), 'SFR', &
+ Unpack( zqgs(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ end if
+!
+!
+!* 2.3 cloud ice melting (rimltc)
+!
+ if ( BUCONF%LBUDGET_SV ) then
+ CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 1 ), 'IMLT', &
+ Unpack( zqcs(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ CALL BUDGET_STORE_INIT_PHY(D, 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 ( BUCONF%LBUDGET_SV ) then
+ CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 1 ), 'IMLT', &
+ Unpack( zqcs(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ CALL BUDGET_STORE_END_PHY(D, 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(:)) > ELECP%XECMIN)
+ ZWQ(:) = XQHON * ZECT(:) * ZRCHONI(:)
+ ZWQ(:) = SIGN( MIN( ABS(ZQCT(:)/PTSTEP),ABS(ZWQ(:)) ),ZQCS(:) )
+ !
+ ZQIS(:) = ZQIS(:) + ZWQ(:)
+ ZQCS(:) = ZQCS(:) - ZWQ(:)
+ END WHERE
+!
+ if ( BUCONF%LBUDGET_SV ) then
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 1 ), 'HON', &
+ Unpack( -zwq(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ CALL BUDGET_STORE_ADD_PHY(D, 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 ( BUCONF%LBUDGET_SV ) then
+ CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG ), 'DEPS', &
+ Unpack( zqpis(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ CALL BUDGET_STORE_INIT_PHY(D, 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(:)/ELECD%XECHARGE )
+ ZQNIS(:) = ZQNIS(:) - MIN( 0.0,ZWQ(:)/ELECD%XECHARGE )
+ END WHERE
+!
+ if ( BUCONF%LBUDGET_SV ) then
+ CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG ), 'DEPS', &
+ Unpack( zqpis(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECEND ), 'DEPS', &
+ Unpack( zqnis(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ CALL BUDGET_STORE_ADD_PHY(D, 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 ( BUCONF%LBUDGET_SV ) then
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 3 ), 'AGGS', &
+ Unpack( -zwq(:), mask = odmicro(:, :, :), field = 0. ) )
+ CALL BUDGET_STORE_ADD_PHY(D, 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 ( BUCONF%LBUDGET_SV ) then
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 3 ), 'NIIS', &
+ Unpack( -zwq_ni(:), mask = odmicro(:, :, :), field = 0. ) )
+ CALL BUDGET_STORE_ADD_PHY(D, 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 ( BUCONF%LBUDGET_SV ) then
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 3 ), 'AUTS', &
+ Unpack( -zwq(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 4 ), 'AUTS', &
+ Unpack( zwq(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ end if
+!
+!
+!* 2.10 snow --> ice conversion (rscnvi)
+!
+ IF (HCLOUD == 'LIMA') THEN
+ CALL COMPUTE_CHARGE_TRANSFER (ZRICNVI, ZRST, ZQST, PTSTEP, &
+ XRTMIN_ELEC(5), XQTMIN(5), XCOEF_RQ_S, &
+ ZWQ, ZQSS, ZQIS)
+!
+ if ( BUCONF%LBUDGET_SV ) then
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 3 ), 'CNVI', &
+ Unpack( zwq(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ CALL BUDGET_STORE_ADD_PHY(D, 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 ( BUCONF%LBUDGET_SV ) then
+ CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG ), 'SUBI', &
+ Unpack( zqpis(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ CALL BUDGET_STORE_INIT_PHY(D, 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(:)/ELECD%XECHARGE )
+ ZQNIS(:) = ZQNIS(:) - MIN( 0.0,ZWQ(:)/ELECD%XECHARGE )
+ END WHERE
+!
+ if ( BUCONF%LBUDGET_SV ) then
+ CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG ), 'SUBI', &
+ Unpack( zqpis(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECEND ), 'SUBI', &
+ Unpack( zqnis(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ CALL BUDGET_STORE_ADD_PHY(D, 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 ( BUCONF%LBUDGET_SV ) then
+ CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG ), 'DEPG', &
+ Unpack( zqpis(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ CALL BUDGET_STORE_INIT_PHY(D, 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(:)/ELECD%XECHARGE )
+ ZQNIS(:) = ZQNIS(:) - MIN( 0.0,ZWQ(:)/ELECD%XECHARGE )
+ END WHERE
+!
+ if ( BUCONF%LBUDGET_SV ) then
+ CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG ), 'DEPG', &
+ Unpack( zqpis(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECEND ), 'DEPG', &
+ Unpack( zqnis(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ CALL BUDGET_STORE_ADD_PHY(D, 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 ( BUCONF%LBUDGET_SV ) then
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 1 ), 'AUTO', &
+ Unpack( -zwq(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ CALL BUDGET_STORE_ADD_PHY(D, 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 ( BUCONF%LBUDGET_SV ) then
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 1 ), 'ACCR', &
+ Unpack( -zwq(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 2 ), 'ACCR', &
+ Unpack( zwq(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ end if
+!
+!
+!* 3.3 evaporation of raindrops (rrevav)
+!
+ if ( BUCONF%LBUDGET_SV ) then
+ CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG ), 'REVA', &
+ Unpack( zqpis(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ CALL BUDGET_STORE_INIT_PHY(D, 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(:)/ELECD%XECHARGE )
+ ZQNIS(:) = ZQNIS(:) - MIN( 0.0,ZWQ(:)/ELECD%XECHARGE )
+ END WHERE
+!
+ if ( BUCONF%LBUDGET_SV ) then
+ CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG ), 'REVA', &
+ Unpack( zqpis(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECEND ), 'REVA', &
+ Unpack( zqnis(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ CALL BUDGET_STORE_ADD_PHY(D, 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 (HCLOUD == 'LIMA') THEN
+ if ( BUCONF%LBUDGET_SV ) then
+ CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 1 ), 'R2C1', &
+ Unpack( zqcs(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ CALL BUDGET_STORE_INIT_PHY(D, 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 ( BUCONF%LBUDGET_SV ) then
+ CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 1 ), 'R2C1', &
+ Unpack( zqcs(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ CALL BUDGET_STORE_END_PHY(D, 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 ( BUCONF%LBUDGET_SV ) then
+ CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 1 ), 'RIM', &
+ Unpack( zqcs(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 4 ), 'RIM', &
+ Unpack( zqss(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ CALL BUDGET_STORE_INIT_PHY(D, 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) < CST%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 ( BUCONF%LBUDGET_SV ) then
+ CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 1 ), 'RIM', &
+ Unpack( zqcs(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 4 ), 'RIM', &
+ Unpack( zqss(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ CALL BUDGET_STORE_END_PHY(D, 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 (HCLOUD == 'LIMA') THEN
+ CALL COMPUTE_CHARGE_TRANSFER (ZRSHMSI, ZRST, ZQST, PTSTEP, &
+ XRTMIN_ELEC(4), XQTMIN(4), XCOEF_RQ_S, &
+ ZWQ, ZQSS, ZQIS)
+!
+ if ( BUCONF%LBUDGET_SV ) then
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 4 ), 'HMS', &
+ Unpack( -zwq(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ CALL BUDGET_STORE_ADD_PHY(D, 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(:)) > ELECP%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 ( BUCONF%LBUDGET_SV ) then
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 2 ), 'ACC', &
+ Unpack( (-zwq5(:,1) - zwq5(:,3)) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 4 ), 'ACC', &
+ Unpack( ( zwq5(:,1) - zwq5(:,4)) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ CALL BUDGET_STORE_ADD_PHY(D, 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 ( BUCONF%LBUDGET_SV ) then
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 4 ), 'CMEL', &
+ Unpack( -zwq(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ CALL BUDGET_STORE_ADD_PHY(D, 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 (HCLOUD(1:3) == 'ICE') THEN
+ CALL COMPUTE_CHARGE_TRANSFER (ZRCMLTSR, ZRCT, ZQCT, PTSTEP, &
+ XRTMIN_ELEC(2), XQTMIN(2), XCOEF_RQ_C, &
+ ZWQ, ZQCS, ZQRS)
+!
+ if ( BUCONF%LBUDGET_SV ) then
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 1 ), 'CMEL', &
+ Unpack( -zwq(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ CALL BUDGET_STORE_ADD_PHY(D, 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 ( BUCONF%LBUDGET_SV ) then
+ CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 2 ), 'CFRZ', &
+ Unpack( zqrs(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 3 ), 'CFRZ', &
+ Unpack( zqis(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ CALL BUDGET_STORE_INIT_PHY(D, 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(:)) > ELECP%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 ( BUCONF%LBUDGET_SV ) then
+ CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 2 ), 'CFRZ', &
+ Unpack( zqrs(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 3 ), 'CFRZ', &
+ Unpack( zqis(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ CALL BUDGET_STORE_END_PHY(D, 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 ( BUCONF%LBUDGET_SV ) then
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 3 ), 'NIIG', &
+ Unpack( -zwq_ni(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ CALL BUDGET_STORE_ADD_PHY(D, 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(:) - CST%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 ( BUCONF%LBUDGET_SV ) then
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 4 ), 'NISG', &
+ Unpack( -zwq_ni(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ CALL BUDGET_STORE_ADD_PHY(D, 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(:)) > ELECP%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 ( BUCONF%LBUDGET_SV ) then
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 1 ), 'DRYG', &
+ Unpack( -zwq5(:,1) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 2 ), 'DRYG', &
+ Unpack( -zwq5(:,4) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 3 ), 'DRYG', &
+ Unpack( -zwq5(:,2) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 4 ), 'DRYG', &
+ Unpack( -zwq5(:,3) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ CALL BUDGET_STORE_ADD_PHY(D, 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 (HCLOUD == 'LIMA') THEN
+ CALL COMPUTE_CHARGE_TRANSFER (ZRGHMGI, ZRGT, ZQGT, PTSTEP, &
+ XRTMIN_ELEC(6), XQTMIN(6), XCOEF_RQ_G, &
+ ZWQ, ZQGS, ZQIS)
+!
+ if ( BUCONF%LBUDGET_SV ) then
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 5 ), 'HMG', &
+ Unpack( -zwq(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ CALL BUDGET_STORE_ADD_PHY(D, 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 ( BUCONF%LBUDGET_SV ) then
+ CALL BUDGET_STORE_INIT_PHY(D, 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 ( BUCONF%LBUDGET_SV ) then
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 1 ), 'WETG', &
+ Unpack( -zwq5(:,5) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 2 ), 'WETG', &
+ Unpack( -zwq5(:,8) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 3 ), 'WETG', &
+ Unpack( -zwq5(:,6) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 4 ), 'WETG', &
+ Unpack( -zwq5(:,7) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 5 ), 'WETG', &
+ Unpack( zqgs(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ if ( krr == 7 ) &
+ CALL BUDGET_STORE_ADD_PHY(D, 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(:)) > ELECP%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 ( BUCONF%LBUDGET_SV ) then
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 1 ), 'INCG', &
+ Unpack( -zwq(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ CALL BUDGET_STORE_ADD_PHY(D, 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 ( BUCONF%LBUDGET_SV ) then
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 2 ), 'GMLT', &
+ Unpack( zwq(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ CALL BUDGET_STORE_ADD_PHY(D, 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 (HCLOUD == '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 (HCLOUD == '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 ( BUCONF%LBUDGET_SV ) then
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 1 ), 'WETH', &
+ Unpack( -zwq5(:, 1) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 2 ), 'WETH', &
+ Unpack( -zwq5(:, 4) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 3 ), 'WETH', &
+ Unpack( -zwq5(:, 2) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 4 ), 'WETH', &
+ Unpack( -zwq5(:, 3) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 5 ), 'WETH', &
+ Unpack( -zwq5(:, 5) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ CALL BUDGET_STORE_ADD_PHY(D, 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 ( BUCONF%LBUDGET_SV ) then
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 1 ), 'DRYH', &
+ Unpack( -zwq5(:, 1) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 2 ), 'DRYH', &
+ Unpack( -zwq5(:, 4) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 3 ), 'DRYH', &
+ Unpack( -zwq5(:, 2) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 4 ), 'DRYH', &
+ Unpack( -zwq5(:, 3) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 5 ), 'DRYH', &
+ Unpack( (-zwq5(:, 5) - zwq(:)) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ CALL BUDGET_STORE_ADD_PHY(D, 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 ( BUCONF%LBUDGET_SV ) then
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 2 ), 'HMLT', &
+ Unpack( zwq(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ CALL BUDGET_STORE_ADD_PHY(D, 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 ( BUCONF%LBUDGET_SV ) then
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 1 ), 'BERFI', &
+ Unpack( -zwq(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ CALL BUDGET_STORE_ADD_PHY(D, 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 (HCLOUD == 'LIMA') THEN
+!
+ if ( BUCONF%LBUDGET_SV ) then
+ CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG ), 'CORR2', &
+ Unpack( zqpis(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ CALL BUDGET_STORE_INIT_PHY(D, 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(:)/ELECD%XECHARGE )
+ ZQNIS(:) = ZQNIS(:) - MIN( 0.0,ZWQ1(:)/ELECD%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(:)/ELECD%XECHARGE )
+ ZQNIS(:) = ZQNIS(:) - MIN( 0.0,ZWQ2(:)/ELECD%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(:)/ELECD%XECHARGE )
+ ZQNIS(:) = ZQNIS(:) - MIN( 0.0,ZWQ3(:)/ELECD%XECHARGE )
+ END WHERE
+!
+ if ( BUCONF%LBUDGET_SV ) then
+ CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG ), 'CORR2', &
+ Unpack( zqpis(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECEND ), 'CORR2', &
+ Unpack( zqnis(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 1 ), 'CORR2', &
+ Unpack( zwq1(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 2 ), 'CORR2', &
+ Unpack( zwq2(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ CALL BUDGET_STORE_ADD_PHY(D, 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)
+!
+!------------------------------------------------------------------
+END ASSOCIATE
+!
+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(:) > (CST%XTT - 40.) .AND. ZZT(:) < CST%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 - CST%XTT)) * (ZZT(:) - CST%XTT))**3 &
+ - 0.003 * ((-21 / (XQTC - CST%XTT)) * (ZZT(:) - CST%XTT))**2 &
+ - 0.05 * ((-21 / (XQTC - CST%XTT)) * (ZZT(:) - CST%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(:) > (CST%XTT - 40.) .AND. ZZT(:) <= CST%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(:) <= CST%XTT .AND. ZZT(:) >= (CST%XTT - 23.7)) ! Original from SAP98
+ ZRAR_CRIT(:) = 1.0 + 7.93E-2 * (ZZT(:) - CST%XTT) + &
+ 4.48E-2 * (ZZT(:) - CST%XTT)**2 + &
+ 7.48E-3 * (ZZT(:) - CST%XTT)**3 + &
+ 5.47E-4 * (ZZT(:) - CST%XTT)**4 + &
+ 1.67E-5 * (ZZT(:) - CST%XTT)**5 + &
+ 1.76E-7 * (ZZT(:) - CST%XTT)**6
+ END WHERE
+ !
+ WHERE (ZZT(:) < (CST%XTT - 23.7) .AND. ZZT(:) > (CST%XTT - 40.)) ! Added by Mansell
+ ZRAR_CRIT(:) = 3.4 * (1.0 - (ABS(ZZT(:) - CST%XTT + 23.7) / & ! et al. (2005)
+ (-23.7 + 40.))**3.)
+ END WHERE
+ !
+ GELEC(:,3) = ZZT(:) >= (CST%XTT - 40.) .AND. ZZT(:) <= CST%XTT
+!
+ELSE IF (CNI_CHARGING == 'BSMP1' .OR. CNI_CHARGING == 'BSMP2') THEN
+!
+ WHERE (ZZT(:) > (CST%XTT - 10.7))
+ ZRAR_CRIT(:) = 0.66
+ END WHERE
+ WHERE (ZZT(:) <= (CST%XTT - 10.7) .AND. ZZT(:) >= (CST%XTT - 23.7))
+ ZRAR_CRIT(:) = -1.47 - 0.2 * (ZZT(:) - CST%XTT)
+ END WHERE
+ WHERE (ZZT(:) < (CST%XTT - 23.7) .AND. ZZT(:) > (CST%XTT - 40.))
+ ZRAR_CRIT(:) = 3.3
+ END WHERE
+ !
+ GELEC(:,3) = ZZT(:) > (CST%XTT - 40.) .AND. ZZT(:) <= CST%XTT .AND. &
+ ZEW(:) >= 0.01 .AND. ZEW(:) <= 10.
+!
+ELSE IF (CNI_CHARGING == 'TERAR') THEN
+!
+ GELEC(:,3) = ZZT(:) >= (CST%XTT - 40.) .AND. ZZT(:) <= CST%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(:) > (CST%XTT - 40.) .AND. ZZT(:) <= CST%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(:) >= (CST%XTT - 40.) .AND. ZZT(:) <= CST%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) - CST%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(:) - CST%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(:) < (CST%XTT-30.) .AND. ZZT(:) >= (CST%XTT-40.))
+ ZWQ_NI(:) = ZWQ_NI(:) * (ZZT(:) - CST%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(:) - CST%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(:) < (CST%XTT-30.) .AND. ZZT(:) >= (CST%XTT-40.))
+ ZWQ_NI(:) = ZWQ_NI(:) * (ZZT(:) - CST%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(:) - CST%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(:) < (CST%XTT-30.) .AND. ZZT(:) >= (CST%XTT-40.))
+ ZWQ_NI(:) = ZWQ_NI(:) * (ZZT(:) - CST%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
+END MODULE MODE_ELEC_TENDENCIES
diff --git a/src/common/micro/mode_ice4_correct_negativities.F90 b/src/common/micro/mode_ice4_correct_negativities.F90
index cf569687e9cf6ddaac782d09e9f869eb0c5dde51..c680d207ae65aa592c4b3dfe44827e800b1cccaf 100644
--- a/src/common/micro/mode_ice4_correct_negativities.F90
+++ b/src/common/micro/mode_ice4_correct_negativities.F90
@@ -6,9 +6,14 @@
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
@@ -19,11 +24,15 @@ 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 +52,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 +139,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/common/micro/mode_ice4_pack.F90 b/src/common/micro/mode_ice4_pack.F90
index c434a4a2e4052032603e4bb144334e85320e6ace..80819b19ed757b9959685a39873aae97618e6c62 100644
--- a/src/common/micro/mode_ice4_pack.F90
+++ b/src/common/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
@@ -101,6 +101,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
@@ -133,6 +135,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
!
!
@@ -174,6 +181,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
!
@@ -197,7 +207,7 @@ LLSIGMA_RC=(PARAMI%CSUBG_AUCV_RC=='PDF ' .AND. PARAMI%CSUBG_PR_PDF=='SIGM')
LL_AUCV_ADJU=(PARAMI%CSUBG_AUCV_RC=='ADJU' .OR. PARAMI%CSUBG_AUCV_RI=='ADJU')
!
IF(PARAMI%LPACK_MICRO) THEN
- IF(BUCONF%LBU_ENABLE) THEN
+ IF(BUCONF%LBU_ENABLE .OR. OSAVE_MICRO) THEN
DO JV=1, IBUNUM-IBUNUM_EXTRA
ZBU_PACK(:, JV)=0.
ENDDO
@@ -278,10 +288,11 @@ IF(PARAMI%LPACK_MICRO) THEN
ZHLI_HRI(IC) = PHLI_HRI(JIJ, JK)
ENDIF
ZRAINFR(IC)=PRAINFR(JIJ, JK)
+ IF (OELEC) ZLATHAM_IAGGS(IC) = PLATHAM_IAGGS(JIJ, JK)
! Save indices for later usages:
I1(IC) = JIJ
I2(IC) = JK
- IF(BUCONF%LBU_ENABLE) THEN
+ IF(BUCONF%LBU_ENABLE .OR. OSAVE_MICRO) THEN
I1TOT(JMICRO+IC-1)=JIJ
I2TOT(JMICRO+IC-1)=JK
ENDIF
@@ -316,14 +327,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, ZRAINFR, &
- &ZEXTPK, ZBU_SUM, ZRREVAV)
+ &ZEXTPK, ZBU_SUM, ZRREVAV, &
+ &ZLATHAM_IAGGS)
!
!* 6. UNPACKING
! ---------
@@ -344,7 +356,7 @@ IF(PARAMI%LPACK_MICRO) THEN
ENDIF
PRAINFR(I1(JL),I2(JL))=ZRAINFR(JL)
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)
@@ -426,17 +438,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/common/micro/mode_ice4_sedimentation.F90 b/src/common/micro/mode_ice4_sedimentation.F90
index 9bab7506fb3316a3eb26427f85e874da59020fb7..b54b50eb80f4e4199a11980c8164c542c67dcbb3 100644
--- a/src/common/micro/mode_ice4_sedimentation.F90
+++ b/src/common/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, HCLOUD, PTSTEP, KRR, PDZZ, PTHVREFZIKB, &
&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,12 @@ 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.
+CHARACTER (LEN=4), INTENT(IN) :: HCLOUD ! Kind of microphysical scheme
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 +96,34 @@ 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
+REAL, INTENT(IN) :: PTHVREFZIKB ! Reference thv at IKB for electricity
+!
+! 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 +152,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 +185,16 @@ IF(PARAMI%CSEDIM=='STAT') THEN
PINPRS(IIJB:IIJE) = PINPRS(IIJB:IIJE) + ZINPRI(IIJB:IIJE)
!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, PTHVREFZIKB, HCLOUD, 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(IIJB:IIJE) = PINPRS(IIJB:IIJE) + ZINPRI(IIJB:IIJE)
!We correct negativities with conservation
!SPLI algorith uses a time-splitting. Inside the loop a temporary m.r. is used.
@@ -161,9 +206,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 +228,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/common/micro/mode_ice4_sedimentation_split.F90 b/src/common/micro/mode_ice4_sedimentation_split.F90
index 19baa141ba88fd0d1a88438e5adbf2a74e0f5bed..0613e7d2852cac95197128d471b52b86d712b31b 100644
--- a/src/common/micro/mode_ice4_sedimentation_split.F90
+++ b/src/common/micro/mode_ice4_sedimentation_split.F90
@@ -6,13 +6,17 @@
MODULE MODE_ICE4_SEDIMENTATION_SPLIT
IMPLICIT NONE
CONTAINS
-SUBROUTINE ICE4_SEDIMENTATION_SPLIT(D, CST, ICEP, ICED, PARAMI, &
+SUBROUTINE ICE4_SEDIMENTATION_SPLIT(D, CST, ICEP, ICED, PARAMI, ELECP, ELECD, &
+ &OELEC, OSEDIM_BEARD, PTHVREFZIKB, HCLOUD, &
&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 +32,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 +44,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 +56,18 @@ 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
+CHARACTER (LEN=4), INTENT(IN) :: HCLOUD ! Kind of microphysical scheme
+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 +84,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
+REAL, INTENT(IN) :: PTHVREFZIKB ! Reference thv at IKB for electricity
!* 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 +235,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 +259,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 +329,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 +345,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 +360,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,7 +394,7 @@ REAL :: ZINVTSTEP
REAL :: ZZWLBDC, ZZRAY, 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
@@ -324,6 +402,33 @@ LOGICAL :: ZANYREMAINT
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
@@ -350,6 +455,18 @@ ZREMAINT(IIJB:IIJE) = PTSTEP
ZANYREMAINT = .TRUE.
DO WHILE (ZANYREMAINT)
!
+ ! 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
!
@@ -360,6 +477,10 @@ DO WHILE (ZANYREMAINT)
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
@@ -372,12 +493,38 @@ DO WHILE (ZANYREMAINT)
ZZCC = ICED%XCC*(1.+1.26*ZZWLBDA/ZZRAY)
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, CST, ICED, HCLOUD, KSPE, GMASK, PT, PRHODREF, PTHVREFZIKB, &
+ 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
@@ -385,12 +532,43 @@ DO WHILE (ZANYREMAINT)
& 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
+ IF (OELEC .AND. OSEDIM_BEARD) THEN
+ CALL ELEC_BEARD_EFFECT(D, CST, ICED, HCLOUD, KSPE, GMASK, PT, PRHODREF, PTHVREFZIKB, &
+ 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==5) THEN
! ******* for snow
ZWSED(:,:) = 0.
+ IF (OELEC) THEN
+ ZWSEDQ(:,:) = 0.
+ ZLBDA3(:,:) = 0.
+ END IF
#ifdef REPRO48
!The following lines must be kept equal to the computation in the general case ("for other species" case below)
ZFSED=ICEP%XFSEDS
@@ -407,22 +585,41 @@ DO WHILE (ZANYREMAINT)
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, CST, ICED, HCLOUD, KSPE, GMASK, PT, PRHODREF, PTHVREFZIKB,&
+ 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
@@ -441,15 +638,81 @@ DO WHILE (ZANYREMAINT)
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, CST, ICED, HCLOUD, KSPE, GMASK, PT, PRHODREF, PTHVREFZIKB, &
+ 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
@@ -474,6 +737,11 @@ DO WHILE (ZANYREMAINT)
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/common/micro/mode_ice4_slow.F90 b/src/common/micro/mode_ice4_slow.F90
index e05c784fae93f11baa945c7859f61084cd5ccbcc..6b6c7140e0351dbedde6ffe0a1850d2e39b0982b 100644
--- a/src/common/micro/mode_ice4_slow.F90
+++ b/src/common/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/common/micro/mode_ice4_stepping.F90 b/src/common/micro/mode_ice4_stepping.F90
index a2b9e46c990826a4b141766f9a782091da51a7ba..06cd511afc949e9d8f27cf5c1df4c7e6be5c42c1 100644
--- a/src/common/micro/mode_ice4_stepping.F90
+++ b/src/common/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
@@ -83,6 +84,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,7 +102,9 @@ REAL, DIMENSION(KPROMA), INTENT(INOUT) :: PHLI_HCF
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT) :: 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(KPROMA), INTENT(OUT) :: PRREVAV
+REAL, DIMENSION(MERGE(KPROMA,0,OELEC)), INTENT(IN) :: PLATHAM_IAGGS ! E Function to simulate
+ ! enhancement of IAGGS
!
!
!* 0.2 Declarations of local variables :
@@ -157,7 +162,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
@@ -256,10 +261,12 @@ DO WHILE(ANY(ZTIME(1:KMICRO)<PTSTEP)) ! Loop to *really* compute tendencies
CALL ICE4_TENDENCIES(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, &
@@ -399,7 +406,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/common/micro/mode_ice4_tendencies.F90 b/src/common/micro/mode_ice4_tendencies.F90
index 1c986d3922afd015805cf8b6c130112b649c2ced..215030e7a9e4f4d5bf545649e2389033a48fee7d 100644
--- a/src/common/micro/mode_ice4_tendencies.F90
+++ b/src/common/micro/mode_ice4_tendencies.F90
@@ -8,10 +8,12 @@ IMPLICIT NONE
CONTAINS
SUBROUTINE ICE4_TENDENCIES(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(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
@@ -70,6 +73,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
@@ -82,6 +87,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
@@ -320,11 +326,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))
!
!-------------------------------------------------------------------------------
@@ -407,7 +414,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/common/micro/mode_lima_ccn_activation.F90 b/src/common/micro/mode_lima_ccn_activation.F90
index 38732eee869583c4958e6624ee743a1e322a847f..b7886c3bb8d572d3a1ce708194ae1fe719926b4f 100644
--- a/src/common/micro/mode_lima_ccn_activation.F90
+++ b/src/common/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/common/micro/mode_lima_ccn_hom_freezing.F90 b/src/common/micro/mode_lima_ccn_hom_freezing.F90
index 38f760fc59473f3cad1d4d5ef76083cf52a7bd16..f3b9dc125e3d7a7282392b769be65ea4950f0c7d 100644
--- a/src/common/micro/mode_lima_ccn_hom_freezing.F90
+++ b/src/common/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/common/micro/mode_lima_droplets_riming_snow.F90 b/src/common/micro/mode_lima_droplets_riming_snow.F90
index 9974166a1111a0ed9f0815781a6333b6eac5661e..56b57d5d8c7ecdecdbdd168e9da5ad189697de28 100644
--- a/src/common/micro/mode_lima_droplets_riming_snow.F90
+++ b/src/common/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/common/micro/mode_lima_ice_aggregation_snow.F90 b/src/common/micro/mode_lima_ice_aggregation_snow.F90
index c442ab8b02965cbbf95a0a20709632085783b02b..6097a688e663a38d0d722fd828ef85e9972a4d3f 100644
--- a/src/common/micro/mode_lima_ice_aggregation_snow.F90
+++ b/src/common/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/common/micro/mode_lima_nucleation_procs.F90 b/src/common/micro/mode_lima_nucleation_procs.F90
index 58f9212cc92f27eeca5fb93952f8a5e476357ba9..7a70adf55443ad065d97e46b04548f0416f840d4 100644
--- a/src/common/micro/mode_lima_nucleation_procs.F90
+++ b/src/common/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/common/micro/mode_lima_rain_accr_snow.F90 b/src/common/micro/mode_lima_rain_accr_snow.F90
index 6c83bf6cd49554c08f21caed8d9d6258be9d5fd5..e7ee26f7e5bccf8d571eae3b7639011b2fe16042 100644
--- a/src/common/micro/mode_lima_rain_accr_snow.F90
+++ b/src/common/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/common/micro/mode_lima_sedimentation.F90 b/src/common/micro/mode_lima_sedimentation.F90
index 1efeb31919684052c0a3fe5ba224450e668fb0e9..d9342305c5bf0ac7ad153c2ebd43d52d4a20950f 100644
--- a/src/common/micro/mode_lima_sedimentation.F90
+++ b/src/common/micro/mode_lima_sedimentation.F90
@@ -7,9 +7,11 @@ MODULE MODE_LIMA_SEDIMENTATION
IMPLICIT NONE
CONTAINS
! ######################################################################
- SUBROUTINE LIMA_SEDIMENTATION (D, CST, &
- HPHASE, KMOMENTS, KID, KSPLITG, PTSTEP, PDZZ, PRHODREF, &
- PPABST, PT, PRT_SUM, PCPT, PRS, PCS, PINPR, PFPR )
+ SUBROUTINE LIMA_SEDIMENTATION (D, CST, ICED, HCLOUD, &
+ HPHASE, KMOMENTS, KID, KSPLITG, PTSTEP, OELEC, &
+ PDZZ, PRHODREF, PTHVREFZIKB, &
+ 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,23 @@ CONTAINS
!
USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
USE MODD_CST, ONLY: CST_t
+USE MODD_RAIN_ICE_DESCR_n, ONLY: RAIN_ICE_DESCR_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_GAMMA, ONLY: GAMMA_X0D
+USE MODE_ELEC_COMPUTE_EX, ONLY: ELEC_COMPUTE_EX
+USE MODE_ELEC_BEARD_EFFECT, ONLY: ELEC_BEARD_EFFECT
!
IMPLICIT NONE
!
@@ -64,11 +75,13 @@ IMPLICIT NONE
!
TYPE(DIMPHYEX_t), INTENT(IN) :: D
TYPE(CST_t), INTENT(IN) :: CST
+TYPE(RAIN_ICE_DESCR_t), INTENT(IN) :: ICED
CHARACTER(1), INTENT(IN) :: HPHASE ! Liquid or solid hydrometeors
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 +92,10 @@ 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
+CHARACTER (LEN=4), INTENT(IN) :: HCLOUD ! Kind of microphysical scheme
+REAL, INTENT(IN) :: PTHVREFZIKB ! Reference thv at IKB for electricity
+REAL, DIMENSION(:,:,:), INTENT(INOUT), OPTIONAL :: PQS ! Elec. charge density source
!
!* 0.2 Declarations of local variables :
!
@@ -110,12 +127,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 +154,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 +162,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 +178,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 +193,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 +223,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 +234,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, CST, ICED, HCLOUD, KID, GSEDIM, PT, PRHODREF, PTHVREFZIKB, &
+ 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, HCLOUD, PTSTEP, ZRHODREF, XRTMIN(KID), &
+ ZRS, ZQS, ZES, PLBDX=ZLBDA, PCX=ZCS)
+ ELSE ! 1-moment species
+ CALL ELEC_COMPUTE_EX (KID, IMOMENTS, ISEDIM, HCLOUD, 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 +317,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 +332,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 +345,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/common/micro/mode_lima_tendencies.F90 b/src/common/micro/mode_lima_tendencies.F90
index cbfde662f9a2a3c67c487e313b5199da0dd7ebc1..5fc16d817744e60c66e2ad622a5266ed55befd97 100644
--- a/src/common/micro/mode_lima_tendencies.F90
+++ b/src/common/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
@@ -557,11 +576,13 @@ IF ((.NOT. LKHKO) .AND. NMOM_R.GE.2) THEN
P_CR_SCBU )
!
P_CR_SCBU(:) = P_CR_SCBU(:) * ZPF1D(:)
+ ! process limited until checks on concentrations are added to the time-splitting loop
+ P_CR_SCBU(:) = MAX(P_CR_SCBU(:),-0.5*PCRT(:)/PTSTEP)
!
PA_CR(:) = PA_CR(:) + P_CR_SCBU(:)
END IF
!
-IF (NMOM_R.GE.2) THEN
+IF (NMOM_R.GE.1) THEN
CALL LIMA_RAIN_EVAPORATION (PTSTEP, LDCOMPUTE, & ! depends on PF > CF
PRHODREF, ZT, ZLV, ZLVFACT, ZEVSAT, ZRVSAT, &
PRVT, ZRCT/ZPF1D, ZRRT/ZPF1D, PCRT/ZPF1D, ZLBDR, &
@@ -647,6 +668,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 +708,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/common/micro/modi_lima.F90 b/src/common/micro/modi_lima.F90
index 383df6c4d7fcad487defdff132df7cca37bb3b74..74f5ba53b482491dfa36636c728b1761c53a6d01 100644
--- a/src/common/micro/modi_lima.F90
+++ b/src/common/micro/modi_lima.F90
@@ -3,30 +3,42 @@ MODULE MODI_LIMA
IMPLICIT NONE
INTERFACE
!
- SUBROUTINE LIMA ( D, CST, BUCONF, TBUDGETS, KBUDGETS, &
- PTSTEP, &
- PRHODREF, PEXNREF, PDZZ, &
+ SUBROUTINE LIMA ( D, CST, ICED, ICEP, ELECD, ELECP, BUCONF, TBUDGETS, KBUDGETS,&
+ PTSTEP, OELEC, HCLOUD, &
+ PRHODREF, PEXNREF, PDZZ, PTHVREFZIKB, &
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
+USE MODD_RAIN_ICE_DESCR_n,ONLY: RAIN_ICE_DESCR_t
+USE MODD_RAIN_ICE_PARAM_n,ONLY: RAIN_ICE_PARAM_t
+USE MODD_ELEC_PARAM, ONLY: ELEC_PARAM_t
+USE MODD_ELEC_DESCR, ONLY: ELEC_DESCR_t
USE MODD_BUDGET, ONLY: TBUDGETDATA, TBUDGETCONF_t
USE MODD_CST, ONLY: CST_t
IMPLICIT NONE
!
TYPE(DIMPHYEX_t), INTENT(IN) :: D
TYPE(CST_t), INTENT(IN) :: CST
+TYPE(RAIN_ICE_DESCR_t), INTENT(IN) :: ICED
+TYPE(RAIN_ICE_PARAM_t), INTENT(IN) :: ICEP
+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
TYPE(TBUDGETDATA), DIMENSION(KBUDGETS), INTENT(INOUT) :: TBUDGETS
INTEGER, INTENT(IN) :: KBUDGETS
!
REAL, INTENT(IN) :: PTSTEP ! Time step
!
+LOGICAL, INTENT(IN) :: OELEC ! if true, cloud electrification is activated
+CHARACTER (LEN=4), INTENT(IN) :: HCLOUD ! Kind of microphysical scheme
+!
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 +74,12 @@ 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(:,:,:), OPTIONAL, 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
+!
+REAL, INTENT(IN) :: PTHVREFZIKB ! Reference thv at IKB for electricity
END SUBROUTINE LIMA
END INTERFACE
END MODULE MODI_LIMA
diff --git a/src/common/micro/modi_rain_ice.F90 b/src/common/micro/modi_rain_ice.F90
index 9d921712b714761aa398ffbdd5bc736b66cddb7e..e0bcef9df4c63039398a8caac95509d4df1b3f31 100644
--- a/src/common/micro/modi_rain_ice.F90
+++ b/src/common/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, &
+ OELEC, OSEDIM_BEARD, PTHVREFZIKB, HCLOUD, &
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,9 +36,14 @@ 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
+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
+CHARACTER (LEN=4), INTENT(IN) :: HCLOUD ! Kind of microphysical scheme
!
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PEXN ! Exner function
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PDZZ ! Layer thikness (m)
@@ -76,12 +86,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
+!
+! scalar variables for cloud electricity
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), OPTIONAL, INTENT(IN) :: PQPIT ! Positive ion -
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), OPTIONAL, INTENT(INOUT) :: PQCT ! Cloud droplet |
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), OPTIONAL, INTENT(INOUT) :: PQRT ! Rain | electric
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), OPTIONAL, INTENT(INOUT) :: PQIT ! Ice crystals | charge
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), OPTIONAL, INTENT(INOUT) :: PQST ! Snow | at t
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), OPTIONAL, INTENT(INOUT) :: PQGT ! Graupel |
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), OPTIONAL, INTENT(IN) :: PQNIT ! Negative ion -
+!
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), OPTIONAL, INTENT(INOUT) :: PQPIS ! Positive ion -
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), OPTIONAL, INTENT(INOUT) :: PQCS ! Cloud droplet |
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), OPTIONAL, INTENT(INOUT) :: PQRS ! Rain | electric
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), OPTIONAL, INTENT(INOUT) :: PQIS ! Ice crystals | charge
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), OPTIONAL, INTENT(INOUT) :: PQSS ! Snow | source
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), OPTIONAL, INTENT(INOUT) :: PQGS ! Graupel |
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), OPTIONAL, INTENT(INOUT) :: PQNIS ! Negative ion -
+!
+REAL, DIMENSION(MERGE(D%NIJT,0,OSEDIM_BEARD),MERGE(D%NKT,0,OSEDIM_BEARD)), OPTIONAL, INTENT(IN) :: PEFIELDW ! vertical electric field
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), OPTIONAL, INTENT(IN) :: PLATHAM_IAGGS ! E Function to simulate
+REAL, INTENT(IN) :: PTHVREFZIKB ! Reference thv at IKB for electricity
+ ! 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/common/micro/momg.F90 b/src/common/micro/momg.F90
new file mode 100644
index 0000000000000000000000000000000000000000..40296659745b7a8d9e20a2bf0bbe8e9aed208d45
--- /dev/null
+++ b/src/common/micro/momg.F90
@@ -0,0 +1,96 @@
+!MNH_LIC Copyright 1994-2014 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_MOMG
+! ################
+!
+INTERFACE MOMG
+!
+FUNCTION MOMG_X0D(PALPHA, PNU, PP) RESULT(PMOMG)
+REAL, INTENT(IN) :: PALPHA, PNU
+REAL, INTENT(IN) :: PP
+REAL :: PMOMG
+END FUNCTION MOMG_X0D
+!
+FUNCTION MOMG_X1D(PALPHA, PNU, PP) RESULT(PMOMG)
+REAL, INTENT(IN) :: PALPHA, PNU
+REAL, DIMENSION(:), INTENT(IN) :: PP
+REAL, DIMENSION(SIZE(PP)) :: PMOMG
+END FUNCTION MOMG_X1D
+!
+END INTERFACE
+END MODULE MODI_MOMG
+!
+!--------------------------------------------------------------------------
+!
+!
+!!**** *MOMG* -
+!!
+!! PURPOSE
+!! -------
+!! Compute: G(p) = Gamma(nu + p/alpha) / Gamma(nu)
+!! = M(p) * lambda^p
+!!
+!!** IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! REFERENCE
+!! ---------
+!!
+!! AUTHOR
+!! ------
+!! C. Barthe * Laboratoire de l'Atmosphere et des Cyclones *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 26 Nov. 2009
+!!
+!--------------------------------------------------------------------------------
+!
+!* 1. FUNCTION MOMG FOR SCALAR VARIABLE
+! ---------------------------------
+!
+! ##############################################
+ FUNCTION MOMG_X0D(PALPHA, PNU, PP) RESULT(PMOMG)
+! ##############################################
+!
+USE MODI_GAMMA
+!
+IMPLICIT NONE
+!
+REAL, INTENT(IN) :: PALPHA, PNU
+REAL, INTENT(IN) :: PP
+REAL :: PMOMG
+!
+!
+PMOMG = GAMMA(PNU+PP/PALPHA) / GAMMA(PNU)
+RETURN
+!
+END FUNCTION MOMG_X0D
+!
+!-------------------------------------------------------------------------------
+!
+!* 2. FUNCTION MOMG FOR 1D ARRAY
+! --------------------------
+!
+! ##############################################
+ FUNCTION MOMG_X1D(PALPHA, PNU, PP) RESULT(PMOMG)
+! ##############################################
+!
+USE MODI_GAMMA
+!
+IMPLICIT NONE
+!
+REAL, INTENT(IN) :: PALPHA, PNU
+REAL, DIMENSION(:), INTENT(IN) :: PP
+REAL, DIMENSION(SIZE(PP)) :: PMOMG
+!
+!
+PMOMG(:) = GAMMA(PNU+PP(:)/PALPHA) / GAMMA(PNU)
+RETURN
+!
+END FUNCTION MOMG_X1D
+!
+!------------------------------------------------------------------------------
diff --git a/src/common/micro/rain_ice.F90 b/src/common/micro/rain_ice.F90
index ef288e454eb3106961d75eb6b7b60482f1e9c538..26e230ed9c5e9bf81708cce57def0beab26d667f 100644
--- a/src/common/micro/rain_ice.F90
+++ b/src/common/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, &
+ OELEC, OSEDIM_BEARD, PTHVREFZIKB, HCLOUD, &
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
!!
@@ -170,7 +174,10 @@
!! P. Wautelet 02/2020: use the new data structures and subroutines for budgets
!! 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
+! 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
!! S. Riette Sept 23: e from ice4_tendencies
!-----------------------------------------------------------------
!
@@ -186,15 +193,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
@@ -205,6 +244,8 @@ USE MODE_ICE4_SEDIMENTATION, ONLY: ICE4_SEDIMENTATION
USE MODE_ICE4_PACK, ONLY: ICE4_PACK
USE MODE_ICE4_CORRECT_NEGATIVITIES, ONLY: ICE4_CORRECT_NEGATIVITIES
!
+USE MODE_ELEC_TENDENCIES, ONLY : ELEC_TENDENCIES
+!
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
@@ -216,9 +257,14 @@ 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
+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
+CHARACTER (LEN=4), INTENT(IN) :: HCLOUD ! Kind of microphysical scheme
!
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PEXN ! Exner function
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PDZZ ! Layer thikness (m)
@@ -258,15 +304,41 @@ REAL, DIMENSION(D%NIJT), INTENT(OUT) :: PINPRG! Graupel instant precip
REAL, DIMENSION(D%NIJT), INTENT(OUT) :: PINDEP ! Cloud instant deposition
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PRAINFR !Precipitation fraction
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PSIGS ! Sigma_s at t
+REAL, INTENT(IN) :: PTHVREFZIKB ! Reference thv at IKB for electricity
!
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)), OPTIONAL, INTENT(IN) :: PQPIT ! Positive ion -
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), OPTIONAL, INTENT(INOUT) :: PQCT ! Cloud droplet |
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), OPTIONAL, INTENT(INOUT) :: PQRT ! Rain | electric
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), OPTIONAL, INTENT(INOUT) :: PQIT ! Ice crystals | charge
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), OPTIONAL, INTENT(INOUT) :: PQST ! Snow | at t
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), OPTIONAL, INTENT(INOUT) :: PQGT ! Graupel |
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), OPTIONAL, INTENT(IN) :: PQNIT ! Negative ion -
+!
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), OPTIONAL, INTENT(INOUT) :: PQPIS ! Positive ion -
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), OPTIONAL, INTENT(INOUT) :: PQCS ! Cloud droplet |
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), OPTIONAL, INTENT(INOUT) :: PQRS ! Rain | electric
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), OPTIONAL, INTENT(INOUT) :: PQIS ! Ice crystals | charge
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), OPTIONAL, INTENT(INOUT) :: PQSS ! Snow | source
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), OPTIONAL, INTENT(INOUT) :: PQGS ! Graupel |
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), OPTIONAL, INTENT(INOUT) :: PQNIS ! Negative ion -
+!
+REAL, DIMENSION(MERGE(D%NIJT,0,OSEDIM_BEARD),MERGE(D%NKT,0,OSEDIM_BEARD)), OPTIONAL, INTENT(IN) :: PEFIELDW ! vertical electric field
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), OPTIONAL, 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 :
@@ -298,6 +370,13 @@ LOGICAL, DIMENSION(D%NIJT,D%NKT) :: LLW3D
REAL, DIMENSION(KRR) :: ZRSMIN
INTEGER :: ISIZE, IPROMA, IGPBLKS, ISIZE2
!
+LOGICAL :: LSAVE_MICRO = .FALSE. ! 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)
!
@@ -313,9 +392,6 @@ IIJE=D%NIJE
IIJT=D%NIJT
!-------------------------------------------------------------------------------
!
-IF(PARAMI%LOCND2) THEN
- CALL PRINT_MSG(NVERB_FATAL, 'GEN', 'RAIN_ICE', 'LOCND2 OPTION NOT CODED IN THIS RAIN_ICE VERSION')
-END IF
ZINV_TSTEP=1./PTSTEP
!
! LSFACT and LVFACT without exner, and LLMICRO
@@ -360,14 +436,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, HCLOUD, PTSTEP, KRR, PDZZ, PTHVREFZIKB, &
&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
!
!
@@ -403,7 +481,7 @@ ENDDO
!* 4.1 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
@@ -521,10 +599,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, &
@@ -533,15 +618,109 @@ CALL ICE4_PACK(D, CST, PARAMI, ICEP, ICED, BUCONF, &
ZZ_RVHENI, ZZ_LVFACT, ZZ_LSFACT, &
ZWR, &
TBUDGETS, KBUDGETS, &
- PRHS )
+ ZMICRO_TEND, PLATHAM_IAGGS, PRHS )
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 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, CST, ICED, ICEP, ELECD, ELECP, &
+ KRR, IELEC, PTSTEP, GMASK_ELEC, &
+ BUCONF, TBUDGETS, KBUDGETS, &
+ HCLOUD, PTHVREFZIKB, 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, CST, ICED, ICEP, ELECD, ELECP, &
+ KRR, ISIZE, PTSTEP, LLMICRO, &
+ BUCONF, TBUDGETS, KBUDGETS, &
+ HCLOUD, PTHVREFZIKB, 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
+!
!
!-------------------------------------------------------------------------------
!
-!* 6. TOTAL TENDENCIES
+!* 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
@@ -581,7 +760,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,
@@ -602,11 +781,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(:, :))
@@ -621,19 +805,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, HCLOUD, PTSTEP, KRR, PDZZ, PTHVREFZIKB, &
&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
@@ -656,7 +842,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/common/turb/modd_param_mfshalln.F90 b/src/common/turb/modd_param_mfshalln.F90
index 664812c582f179a458ab25c786b1c0db22964a46..a4724bcc176a2fc67855d781dc54eb89890da0d0 100644
--- a/src/common/turb/modd_param_mfshalln.F90
+++ b/src/common/turb/modd_param_mfshalln.F90
@@ -82,6 +82,7 @@ REAL :: XGZ !< Tuning of the surface initialisation for Grey Zo
!
LOGICAL :: LTHETAS_MF !< .TRUE. to use ThetaS1 instead of ThetaL
REAL :: XLAMBDA_MF !< Thermodynamic parameter: Lambda to compute ThetaS1 from ThetaL
+LOGICAL :: LVERLIMUP !< .TRUE. to use correction on vertical limitation of updraft (issue #38 PHYEX)
END TYPE PARAM_MFSHALL_t
@@ -119,13 +120,15 @@ REAL, POINTER :: XR=>NULL()
LOGICAL, POINTER :: LTHETAS_MF=>NULL()
REAL, POINTER :: XLAMBDA_MF=>NULL()
LOGICAL, POINTER :: LGZ=>NULL()
-REAL, POINTER :: XGZ=>NULL()
+REAL, POINTER :: XGZ=>NULL()
+LOGICAL, POINTER :: LVERLIMUP=>NULL()
!
NAMELIST/NAM_PARAM_MFSHALLn/XIMPL_MF,CMF_UPDRAFT,CMF_CLOUD,LMIXUV,LMF_FLX,&
XALP_PERT,XABUO,XBENTR,XBDETR,XCMF,XENTR_MF,&
XCRAD_MF,XENTR_DRY,XDETR_DRY,XDETR_LUP,XKCF_MF,&
XKRC_MF,XTAUSIGMF,XPRES_UV,XALPHA_MF,XSIGMA_MF,&
- XFRAC_UP_MAX,XA1,XB,XC,XBETA1,XR,LTHETAS_MF,LGZ,XGZ
+ XFRAC_UP_MAX,XA1,XB,XC,XBETA1,XR,LTHETAS_MF,LGZ,XGZ,&
+ LVERLIMUP
!
!-------------------------------------------------------------------------------
!
@@ -176,12 +179,13 @@ LTHETAS_MF=>PARAM_MFSHALL_MODEL(KTO)%LTHETAS_MF
XLAMBDA_MF=>PARAM_MFSHALL_MODEL(KTO)%XLAMBDA_MF
LGZ=>PARAM_MFSHALL_MODEL(KTO)%LGZ
XGZ=>PARAM_MFSHALL_MODEL(KTO)%XGZ
+LVERLIMUP=>PARAM_MFSHALL_MODEL(KTO)%LVERLIMUP
!
ENDIF
!
END SUBROUTINE PARAM_MFSHALL_GOTO_MODEL
-SUBROUTINE PARAM_MFSHALLN_INIT(HPROGRAM, KUNITNML, LDNEEDNAM, KLUOUT, &
+SUBROUTINE PARAM_MFSHALLN_INIT(HPROGRAM, TFILENAM, LDNEEDNAM, KLUOUT, &
&LDDEFAULTVAL, LDREADNAM, LDCHECK, KPRINT)
!!*** *PARAM_MFSHALLN* - Code needed to initialize the MODD_PARAM_MFSHALL_n module
!!
@@ -213,6 +217,7 @@ SUBROUTINE PARAM_MFSHALLN_INIT(HPROGRAM, KUNITNML, LDNEEDNAM, KLUOUT, &
!
USE MODE_POSNAM_PHY, ONLY: POSNAM_PHY
USE MODE_CHECK_NAM_VAL, ONLY: CHECK_NAM_VAL_CHAR
+USE MODD_IO, ONLY: TFILEDATA
!
IMPLICIT NONE
!
@@ -220,7 +225,7 @@ IMPLICIT NONE
! ------------------------
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM !< Name of the calling program
-INTEGER, INTENT(IN) :: KUNITNML !< Logical unit to access the namelist
+TYPE(TFILEDATA), INTENT(IN) :: TFILENAM !< Namelist file
LOGICAL, INTENT(IN) :: LDNEEDNAM !< True to abort if namelist is absent
INTEGER, INTENT(IN) :: KLUOUT !< Logical unit for outputs
LOGICAL, OPTIONAL, INTENT(IN) :: LDDEFAULTVAL !< Must we initialize variables with default values (defaults to .TRUE.)
@@ -284,14 +289,16 @@ IF(LLDEFAULTVAL) THEN
XLAMBDA_MF=0.
LGZ=.FALSE.
XGZ=1.83 ! between 1.83 and 1.33
+ LVERLIMUP=.FALSE.
+ IF(HPROGRAM=='MESONH') LVERLIMUP=.TRUE.
ENDIF
!
!* 2. NAMELIST
! -----------
!
IF(LLREADNAM) THEN
- CALL POSNAM_PHY(KUNITNML, 'NAM_PARAM_MFSHALLN', LDNEEDNAM, LLFOUND, KLUOUT)
- IF(LLFOUND) READ(UNIT=KUNITNML, NML=NAM_PARAM_MFSHALLn)
+ CALL POSNAM_PHY(TFILENAM, 'NAM_PARAM_MFSHALLN', LDNEEDNAM, LLFOUND)
+ IF(LLFOUND) READ(UNIT=TFILENAM%NLU, NML=NAM_PARAM_MFSHALLn)
ENDIF
!
!* 3. CHECKS
diff --git a/src/common/turb/modd_turbn.F90 b/src/common/turb/modd_turbn.F90
index b4c173c55c0f15b29987a2d25658bbb25a326a2f..a3f2c6e9df4054b8b84a257cb31d1d5b27f8be5c 100644
--- a/src/common/turb/modd_turbn.F90
+++ b/src/common/turb/modd_turbn.F90
@@ -281,7 +281,7 @@ ENDIF
!
END SUBROUTINE TURB_GOTO_MODEL
-SUBROUTINE TURBN_INIT(HPROGRAM, KUNITNML, LDNEEDNAM, KLUOUT, &
+SUBROUTINE TURBN_INIT(HPROGRAM, TFILENAM, LDNEEDNAM, KLUOUT, &
&LDDEFAULTVAL, LDREADNAM, LDCHECK, KPRINT)
!!*** *TURBN_INIT* - Code needed to initialize the MODD_TURB_n module
!!
@@ -314,6 +314,8 @@ SUBROUTINE TURBN_INIT(HPROGRAM, KUNITNML, LDNEEDNAM, KLUOUT, &
USE MODE_POSNAM_PHY, ONLY: POSNAM_PHY
USE MODE_CHECK_NAM_VAL, ONLY: CHECK_NAM_VAL_CHAR
USE MODD_PARAMETERS, ONLY: XUNDEF
+USE MODD_IO, ONLY: TFILEDATA
+
!
IMPLICIT NONE
!
@@ -321,7 +323,7 @@ IMPLICIT NONE
! ------------------------
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM !< Name of the calling program
-INTEGER, INTENT(IN) :: KUNITNML !< Logical unit to access the namelist
+TYPE(TFILEDATA), INTENT(IN) :: TFILENAM !< Namelist file
LOGICAL, INTENT(IN) :: LDNEEDNAM !< True to abort if namelist is absent
INTEGER, INTENT(IN) :: KLUOUT !< Logical unit for outputs
LOGICAL, OPTIONAL, INTENT(IN) :: LDDEFAULTVAL !< Must we initialize variables with default values (defaults to .TRUE.)
@@ -404,8 +406,8 @@ ENDIF
! -----------
!
IF(LLREADNAM) THEN
- CALL POSNAM_PHY(KUNITNML, 'NAM_TURBN', LDNEEDNAM, LLFOUND, KLUOUT)
- IF(LLFOUND) READ(UNIT=KUNITNML, NML=NAM_TURBn)
+ CALL POSNAM_PHY(TFILENAM, 'NAM_TURBN', LDNEEDNAM, LLFOUND)
+ IF(LLFOUND) READ(UNIT=TFILENAM%NLU, NML=NAM_TURBn)
ENDIF
!
!* 3. CHECKS
@@ -413,9 +415,9 @@ ENDIF
!
IF(LLCHECK) THEN
CALL CHECK_NAM_VAL_CHAR(KLUOUT, 'CTURBDIM', CTURBDIM, '1DIM', '3DIM')
- CALL CHECK_NAM_VAL_CHAR(KLUOUT, 'CTURBLEN', CTURBLEN, 'DELT', 'BL89', 'RM17', 'DEAR', 'BLKR', 'ADAP')
+ CALL CHECK_NAM_VAL_CHAR(KLUOUT, 'CTURBLEN', CTURBLEN, 'DELT', 'BL89', 'RM17', 'DEAR', 'BLKR', 'HM21')
CALL CHECK_NAM_VAL_CHAR(KLUOUT, 'CTOM', CTOM, 'NONE', 'TM06')
- CALL CHECK_NAM_VAL_CHAR(KLUOUT, 'CTURBLEN_CLOUD', CTURBLEN_CLOUD, 'DELT', 'BL89', 'RM17', 'DEAR', 'BLKR', 'ADAP')
+ CALL CHECK_NAM_VAL_CHAR(KLUOUT, 'CTURBLEN_CLOUD', CTURBLEN_CLOUD, 'DELT', 'BL89', 'RM17', 'DEAR', 'BLKR', 'HM21')
ENDIF
!
diff --git a/src/common/turb/mode_compute_updraft.F90 b/src/common/turb/mode_compute_updraft.F90
index 2f8cabf9a6276f55e41c8db4ee1eeee3acc3a508..04b96c802f419664a523e489259a4e19ad590102 100644
--- a/src/common/turb/mode_compute_updraft.F90
+++ b/src/common/turb/mode_compute_updraft.F90
@@ -190,7 +190,7 @@ REAL :: ZTMAX,ZRMAX ! control value
REAL, DIMENSION(D%NIJT) :: ZSURF
REAL, DIMENSION(D%NIJT,D%NKT) :: ZSHEAR,ZDUDZ,ZDVDZ ! vertical wind shear
!
-REAL, DIMENSION(D%NIJT,D%NKT) :: ZWK
+REAL, DIMENSION(D%NIJT,D%NKT) :: ZWK, KDEPTH
REAL, DIMENSION(D%NIJT,16) :: ZBUF
!
REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
@@ -688,14 +688,24 @@ IF(OENTR_DETR) THEN
DO JIJ=IIJB,IIJE
PDEPTH(JIJ) = MAX(0., PZZ(JIJ,KKCTL(JIJ)) - PZZ(JIJ,KKLCL(JIJ)) )
END DO
-
+ IF(PARAMMF%LVERLIMUP) THEN
+ DO JK=1,IKT
+ DO JIJ=IIJB,IIJE
+ KDEPTH(JIJ,JK) = MIN(MAX(0., PZZ(JIJ,JK) - PZZ(JIJ,KKLCL(JIJ)) ), PDEPTH(JIJ))
+ END DO
+ END DO
+ END IF
!$mnh_expand_array(JIJ=IIJB:IIJE)
GWORK1(IIJB:IIJE)= (GTESTLCL(IIJB:IIJE) .AND. (PDEPTH(IIJB:IIJE) > ZDEPTH_MAX1) )
!$mnh_end_expand_array(JIJ=IIJB:IIJE)
DO JK=1,IKT
!$mnh_expand_array(JIJ=IIJB:IIJE)
GWORK2(IIJB:IIJE,JK) = GWORK1(IIJB:IIJE)
- ZCOEF(IIJB:IIJE,JK) = (1.-(PDEPTH(IIJB:IIJE)-ZDEPTH_MAX1)/(ZDEPTH_MAX2-ZDEPTH_MAX1))
+ IF(PARAMMF%LVERLIMUP) THEN
+ ZCOEF(IIJB:IIJE,JK) = (1.-(KDEPTH(IIJB:IIJE,JK)-ZDEPTH_MAX1)/(ZDEPTH_MAX2-ZDEPTH_MAX1))
+ ELSE
+ ZCOEF(IIJB:IIJE,JK) = (1.-(PDEPTH(IIJB:IIJE)-ZDEPTH_MAX1)/(ZDEPTH_MAX2-ZDEPTH_MAX1))
+ END IF
ZCOEF(IIJB:IIJE,JK)=MIN(MAX(ZCOEF(IIJB:IIJE,JK),0.),1.)
!$mnh_end_expand_array(JIJ=IIJB:IIJE)
ENDDO
diff --git a/src/common/turb/mode_ini_turb.F90 b/src/common/turb/mode_ini_turb.F90
index fc70cfaf945db2312defa67a60b887f9f3bea4af..fb860ba83cb79ac0a23d9b6093c80148a457e531 100644
--- a/src/common/turb/mode_ini_turb.F90
+++ b/src/common/turb/mode_ini_turb.F90
@@ -82,7 +82,7 @@ IF(XCED == XUNDEF) THEN
! Schmidt-Schumann (1989) = 0.845
! Cheng-Canuto-Howard (2002) = 0.845
! Rodier, Masson, Couvreux, Paci (2017) = 0.34
- IF(CTURBLEN=='RM17' .OR. CTURBLEN=='ADAP') THEN
+ IF(CTURBLEN=='RM17' .OR. CTURBLEN=='HM21') THEN
XCED=0.34
ELSE
IF(HPROGRAM=='AROME') THEN
diff --git a/src/common/turb/modi_turb.F90 b/src/common/turb/modi_turb.F90
index 9762dc484b7eff5c5945392ab8db5c685f7ac36e..e36d2aaa36d55d238aadb2590788274a135e419d 100644
--- a/src/common/turb/modi_turb.F90
+++ b/src/common/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/common/turb/turb.F90 b/src/common/turb/turb.F90
index c1ba44f85b8ae439e9fb21fc4ae3f0c372422c20..8b155db279a40bb634355448dc6e230aa8c3128c 100644
--- a/src/common/turb/turb.F90
+++ b/src/common/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
diff --git a/src/lmdz/aux/modd_misc.F90 b/src/lmdz/aux/modd_misc.F90
index d2e39b49066543d99333dc833488181ff9083b4a..279fccab7194c6d060deee2d198e4456f5fa22ac 100644
--- a/src/lmdz/aux/modd_misc.F90
+++ b/src/lmdz/aux/modd_misc.F90
@@ -29,6 +29,9 @@ TYPE MISC_t
TYPE(TFILEDATA) :: ZTFILE
TYPE(TLES_t) :: TLES
CHARACTER(LEN=6) :: CPROGRAM
+ CHARACTER(LEN=4) :: CELEC='NONE' !< Name of the electricity scheme
+ LOGICAL :: OELEC=.FALSE. !< Lightning prognostic scheme
+ LOGICAL :: OSEDIM_BEARD=.FALSE. !< Switch for effect of electrical forces on sedim.
CHARACTER(LEN=4) ::CMICRO
CHARACTER(LEN=4) ::CSCONV
CHARACTER(LEN=4) ::CTURB
diff --git a/src/lmdz/ext/mode_init_phyex.F90 b/src/lmdz/ext/mode_init_phyex.F90
index 8fb3e00d8d65f52908c3fd38f3d935bf022c5d4f..d195da1c8125465c55cdce69724a87f63461af9d 100644
--- a/src/lmdz/ext/mode_init_phyex.F90
+++ b/src/lmdz/ext/mode_init_phyex.F90
@@ -41,6 +41,7 @@ SUBROUTINE INIT_PHYEX(PTSTEP, PDZMIN, PHYEX)
!
USE MODD_PHYEX, ONLY: PHYEX_t
USE MODI_INI_PHYEX, ONLY: INI_PHYEX
+USE MODD_IO, ONLY: TFILEDATA
USE print_control_mod, ONLY : lunout
!
IMPLICIT NONE
@@ -55,7 +56,8 @@ CHARACTER(LEN=4) :: CSCONV
CHARACTER(LEN=4) :: CTURB
INTEGER :: K
LOGICAL :: LREADNAM, LOPENED
-INTEGER :: IUNITNML, ILUN
+INTEGER :: ILUN
+TYPE(TFILEDATA) :: TPFILE
!
!General configuration, cannot be modified by namelist
CPROGRAM='LMDZ'
@@ -67,17 +69,17 @@ CTURB='TKEL'
!If the namelist file exists, we use it
INQUIRE(FILE='phyex.nam', EXIST=LREADNAM)
IF(LREADNAM) THEN
- IUNITNML=-1
+ TPFILE%NLU=-1
DO ILUN=1,100
INQUIRE(UNIT=ILUN, OPENED=LOPENED)
IF (.NOT. LOPENED) THEN
- IUNITNML=ILUN
+ TPFILE%NLU=ILUN
EXIT
END IF
END DO
- OPEN(ACTION='read', FILE='phyex.nam', UNIT=IUNITNML)
+ OPEN(ACTION='read', FILE='phyex.nam', UNIT=TPFILE%NLU)
ENDIF
-CALL INI_PHYEX(HPROGRAM=CPROGRAM, KUNITNML=IUNITNML, LDNEEDNAM=.FALSE., &
+CALL INI_PHYEX(HPROGRAM=CPROGRAM, TPFILE=TPFILE, LDNEEDNAM=.FALSE., &
&KLUOUT=lunout, KFROM=0, KTO=1, &
&PTSTEP=PTSTEP, PDZMIN=PDZMIN, &
&CMICRO=CMICRO, CSCONV=CSCONV, CTURB=CTURB, &
diff --git a/src/lmdz/ext/physiqex_mod.F90 b/src/lmdz/ext/physiqex_mod.F90
index ebbd45c1a3cb63f510e48b72917d1440d3db950e..f5b294c1c596ea49acbf21b9d5cc79794344cd7a 100644
--- a/src/lmdz/ext/physiqex_mod.F90
+++ b/src/lmdz/ext/physiqex_mod.F90
@@ -162,6 +162,7 @@ REAL, DIMENSION(klon,klev+2) :: ZDP ! Dynamic TKE production
REAL, DIMENSION(klon,klev+2) :: ZTDIFF ! Diffusion TKE term
REAL, DIMENSION(klon,klev+2) :: ZTDISS ! Dissipation TKE term
REAL, DIMENSION(0,0) :: PLENGTHM, PLENGTHH ! length scale from vdfexcu (HARMONIE-AROME)
+REAL :: ZTHVREFZIKB ! for electricity scheme interface
REAL, DIMENSION(klon,klev+2) :: ZDXX,ZDYY,ZDZX,ZDZY,ZZZ
REAL, DIMENSION(klon) :: ZDIRCOSXW,ZDIRCOSYW,ZDIRCOSZW,ZCOSSLOPE,ZSINSLOPE
! Shallow variables
@@ -480,7 +481,7 @@ CALL TURB(PHYEX%CST, PHYEX%CSTURB, PHYEX%MISC%TBUCONF, PHYEX%TURBN, PHYEX%NEBN,
& PHYEX%MISC%OBLOWSNOW,PHYEX%MISC%OIBM, &
& PHYEX%MISC%OFLYER, PHYEX%MISC%COMPUTE_SRC, PHYEX%MISC%PRSNOW, &
& PHYEX%MISC%OOCEAN, PHYEX%MISC%ODEEPOC, PHYEX%MISC%ODIAG_IN_RUN, &
- & PHYEX%TURBN%CTURBLEN_CLOUD, PHYEX%MISC%CMICRO, &
+ & PHYEX%TURBN%CTURBLEN_CLOUD, PHYEX%MISC%CMICRO, PHYEX%MISC%CELEC, &
& pdtphys,PHYEX%MISC%ZTFILE, &
& ZDXX(:,:),ZDYY(:,:),zdzm(:,:), &
& ZDZX(:,:),ZDZY(:,:),zz_flux(:,:), &
@@ -513,7 +514,11 @@ ENDIF
ZSEA=1.
ZTOWN=0.
ZCIT=0.
-CALL RAIN_ICE (D, PHYEX%CST, PHYEX%PARAM_ICEN, PHYEX%RAIN_ICE_PARAMN, PHYEX%RAIN_ICE_DESCRN, PHYEX%MISC%TBUCONF, &
+ZTHVREFZIKB=0
+CALL RAIN_ICE (D, PHYEX%CST, PHYEX%PARAM_ICEN, PHYEX%RAIN_ICE_PARAMN, PHYEX%RAIN_ICE_DESCRN, &
+ PHYEX%ELEC_PARAM, PHYEX%ELEC_DESCR, PHYEX%MISC%TBUCONF, &
+ OELEC=PHYEX%MISC%OELEC, OSEDIM_BEARD=PHYEX%MISC%OSEDIM_BEARD, &
+ PTHVREFZIKB=ZTHVREFZIKB, HCLOUD='ICE3', &
pdtphys, KRR, ZEXN, &
zdzf, PRHODJ, ZRHOD, ZEXN, ZPABST, ZCIT, ZCLDFR, &
ZHLC_HRC, ZHLC_HCF, ZHLI_HRI, ZHLI_HCF, &
diff --git a/src/mesonh/aux/mode_fill_dimphyexn.F90 b/src/mesonh/aux/mode_fill_dimphyexn.F90
index 5f965be18b7d6a788d424ab047032aded219485c..469ae60851a7750d02d1e5c37a652c0502c7901f 100644
--- a/src/mesonh/aux/mode_fill_dimphyexn.F90
+++ b/src/mesonh/aux/mode_fill_dimphyexn.F90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1995-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2022-2023 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -6,7 +6,7 @@
MODULE MODE_FILL_DIMPHYEX
IMPLICIT NONE
CONTAINS
-SUBROUTINE FILL_DIMPHYEX(YDDIMPHYEX, KIT, KJT, KKT, LTURB,KLES_TIMES)
+SUBROUTINE FILL_DIMPHYEX( YDDIMPHYEX, KIT, KJT, KKT, LTURB, KLES_TIMES, KLES_K )
! #########################
!
!!
@@ -29,6 +29,7 @@ SUBROUTINE FILL_DIMPHYEX(YDDIMPHYEX, KIT, KJT, KKT, LTURB,KLES_TIMES)
!! MODIFICATIONS
!! -------------
!! Original January 2022
+! P. Wautelet 04/10/2023: bugfix: set NKLES correctly
!
!-----------------------------------------------------------------
!* 0. DECLARATIONS
@@ -48,9 +49,11 @@ IMPLICIT NONE
!
TYPE(DIMPHYEX_t), INTENT(OUT) :: YDDIMPHYEX ! Structure to fill in
INTEGER, INTENT(IN) :: KIT, KJT, KKT ! Array dimensions
-INTEGER, INTENT(IN), OPTIONAL :: KLES_TIMES ! Number of LES data storage frequency
LOGICAL, INTENT(IN), OPTIONAL :: LTURB ! Flag to replace array dimensions I/JB and I/JE to the full array size
! needed if computation in HALO points (e.g. in turbulence)
+INTEGER, INTENT(IN), OPTIONAL :: KLES_TIMES ! number of LES computations in time
+INTEGER, INTENT(IN), OPTIONAL :: KLES_K ! number of vertical levels for LES diagnostics
+
LOGICAL :: YTURB
!
!* 0.2 declaration of local variables
@@ -75,7 +78,6 @@ YDDIMPHYEX%NKA=1
YDDIMPHYEX%NKU=KKT
YDDIMPHYEX%NKB=1+JPVEXT
YDDIMPHYEX%NKE=KKT-JPVEXT
-YDDIMPHYEX%NKLES=KKT-2*JPVEXT
YDDIMPHYEX%NKTB=1+JPVEXT
YDDIMPHYEX%NKTE=KKT-JPVEXT
!
@@ -103,6 +105,10 @@ YDDIMPHYEX%NLES_TIMES=0
IF (PRESENT(KLES_TIMES)) THEN
YDDIMPHYEX%NLES_TIMES = KLES_TIMES
END IF
+YDDIMPHYEX%NKLES=0
+IF (PRESENT(KLES_K)) THEN
+ YDDIMPHYEX%NKLES = KLES_K
+END IF
IF (LLES_MY_MASK) YDDIMPHYEX%NLESMASK = YDDIMPHYEX%NLESMASK + NLES_MASKS_USER
IF (LLES_NEB_MASK) YDDIMPHYEX%NLESMASK = YDDIMPHYEX%NLESMASK + 2
IF (LLES_CORE_MASK) YDDIMPHYEX%NLESMASK = YDDIMPHYEX%NLESMASK + 2
diff --git a/src/mesonh/aux/mode_posnam_phy.F90 b/src/mesonh/aux/mode_posnam_phy.F90
index 692ade32693b100f3b984d76bf0d0acc487cb84d..5f5f47b584035599d30348614e34ba5d729a79c4 100644
--- a/src/mesonh/aux/mode_posnam_phy.F90
+++ b/src/mesonh/aux/mode_posnam_phy.F90
@@ -3,22 +3,22 @@ IMPLICIT NONE
PRIVATE
PUBLIC :: POSNAM_PHY
CONTAINS
-SUBROUTINE POSNAM_PHY(KULNAM, CDNAML, LDNEEDNAM, LDFOUND, KLUOUT)
+SUBROUTINE POSNAM_PHY(TFILENAM, CDNAML, LDNEEDNAM, LDFOUND)
!Wrapper to call the Meso-NH version of posnam
USE MODE_MSG, ONLY: NVERB_FATAL, PRINT_MSG
USE MODE_POS, ONLY: POSNAM
+USE MODD_IO, ONLY: TFILEDATA
IMPLICIT NONE
-INTEGER, INTENT(IN) :: KULNAM !< Logical unit to access the namelist
+TYPE(TFILEDATA), INTENT(IN) :: TFILENAM !< Namelist file
CHARACTER(LEN=*), INTENT(IN) :: CDNAML !< Namelist name
LOGICAL, INTENT(IN) :: LDNEEDNAM !< True to abort if namelist is absent
LOGICAL, INTENT(OUT) :: LDFOUND !< True if namelist has been found
-INTEGER, INTENT(IN) :: KLUOUT !< Logical unit for output
-CALL POSNAM(KULNAM, CDNAML, LDFOUND, KLUOUT)
+CALL POSNAM(TFILENAM, CDNAML, LDFOUND)
IF(LDNEEDNAM .AND. .NOT. LDFOUND) CALL PRINT_MSG(NVERB_FATAL, 'GEN', 'POSNAM_PHY', 'CANNOT LOCATE '//CDNAML)
END SUBROUTINE POSNAM_PHY
diff --git a/src/mesonh/aux/sources_neg_correct.f90 b/src/mesonh/aux/sources_neg_correct.f90
index 0302839408bb4045ae0b78adc29bdc812452c071..1abd41813466a70337c747a0e4ee19eb1b1cfd63 100644
--- a/src/mesonh/aux/sources_neg_correct.f90
+++ b/src/mesonh/aux/sources_neg_correct.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 2020-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2020-2022 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -8,6 +8,7 @@
! P. Wautelet 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, &
@@ -51,8 +53,10 @@ use modd_budget, only: lbudget_th, lbudget_rv, lbudget_rc, lbudget_rr, lbudg
NBUDGET_RS, NBUDGET_RG, NBUDGET_RH, NBUDGET_SV1, &
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
+use modd_elec_descr, only: xrtmin_elec, xecharge
+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_elecbeg, nsv_elecend
use modd_param_lima, only: lspro_lima => lspro, &
xctmin_lima => xctmin, xrtmin_lima => xrtmin
@@ -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/mesonh/ext/advection_metsv.f90 b/src/mesonh/ext/advection_metsv.f90
index 8473c5a3b9f58609ef24a788a49f2153056a0380..f6d9d08e74fe9620e20a506baf9ebc92a5445efb 100644
--- a/src/mesonh/ext/advection_metsv.f90
+++ b/src/mesonh/ext/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
@@ -151,7 +153,6 @@ use modd_budget, only: lbudget_th, lbudget_tke, lbudget_rv, lbudget_rc,
NBUDGET_RR, NBUDGET_RI, NBUDGET_RS, NBUDGET_RG, NBUDGET_RH, NBUDGET_SV1, &
tbudgets
USE MODD_CST
-USE MODD_TURB_n, ONLY: XTKEMIN
USE MODD_CONF, ONLY: LNEUTRAL,NHALO,L1D, L2D
use modd_field, only: tfieldmetadata, TYPEREAL
USE MODD_IBM_PARAM_n, ONLY: LIBM,XIBM_LS,XIBM_EPSI
@@ -165,6 +166,7 @@ USE MODD_BLOWSNOW
USE MODD_BLOWSNOW_n
USE MODD_PARAMETERS
USE MODD_REF_n, ONLY: XRHODJ,XRHODREF
+USE MODD_TURB_n, ONLY: XTKEMIN
!
use mode_budget, only: Budget_store_init, Budget_store_end
USE MODE_IO_FIELD_WRITE, only: IO_Field_write
@@ -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/mesonh/ext/aer_wet_dep_kmt_warm.f90 b/src/mesonh/ext/aer_wet_dep_kmt_warm.f90
index cb2bb68e73e1fa5de72b8c7c206463ab5afc6fac..b7af9765600152a32db44e639a7542680b591a41 100644
--- a/src/mesonh/ext/aer_wet_dep_kmt_warm.f90
+++ b/src/mesonh/ext/aer_wet_dep_kmt_warm.f90
@@ -12,7 +12,7 @@ INTERFACE
!!
SUBROUTINE AER_WET_DEP_KMT_WARM(KSPLITR, PTSTEP, PZZ, PRHODREF, &
PRCT, PRRT, &
- PRCS, PRRS, PSVT, PTHT, &
+ PSVT, PTHT, &
PPABST, PRGAER, PEVAP3D, KMODE, &
PDENSITY_AER, PMASSMIN, PSEA, PTOWN, &
PCCT, PCRT )
@@ -30,8 +30,6 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCT ! Cloud water m.r. at t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Rain water m.r. at t
REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVT ! Tracer m.r. at t
!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCS ! Cloud water conc derived from source term
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRS ! Rain water conc derifed from source term
REAL, DIMENSION(:,:,:), INTENT(IN) :: PEVAP3D ! Instantaneous 3D Rain Evaporation flux (KG/KG/S)
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT !Potential temp
@@ -53,7 +51,7 @@ END MODULE MODI_AER_WET_DEP_KMT_WARM
! ###############################################################
SUBROUTINE AER_WET_DEP_KMT_WARM (KSPLITR, PTSTEP, PZZ, &
PRHODREF, PRCT, PRRT, &
- PRCS, PRRS, PSVT, PTHT, &
+ PSVT, PTHT, &
PPABST, PRGAER, PEVAP3D, KMODE, &
PDENSITY_AER, PMASSMIN, PSEA, PTOWN, &
PCCT, PCRT )
@@ -123,14 +121,16 @@ END MODULE MODI_AER_WET_DEP_KMT_WARM
! ------------
!
USE MODD_CST
-USE MODD_RAIN_ICE_PARAM_n
+USE MODD_RAIN_ICE_PARAM_n, ONLY: YEXCACCR=>XEXCACCR, XFSEDC, XFCACCR, &
+ XEXSEDR, XCRIAUTC, XFSEDR, XTIMAUTC, &
+ YFCACCR => XFCACCR
!++th++ 10/05/17
-USE MODD_RAIN_ICE_DESCR_n, ONLY : YRTMIN => XRTMIN, YCEXVT => XCEXVT, &
- XCONC_LAND, XCONC_SEA, XCONC_URBAN, &
- XNUC2, XALPHAC2, XNUC, XALPHAC, &
- YLBC => XLBC, XLBEXC, &
- XCCR, &
- YLBR => XLBR, YLBEXR => XLBEXR
+USE MODD_RAIN_ICE_DESCR_n, ONLY: YRTMIN => XRTMIN, YCEXVT => XCEXVT, &
+ XCONC_LAND, XCONC_SEA, XCONC_URBAN, &
+ XNUC2, XALPHAC2, XNUC, XALPHAC, &
+ YLBC => XLBC, XLBEXC, &
+ XCCR, &
+ YLBR => XLBR, YLBEXR => XLBEXR
!--th--
USE MODD_PRECIP_n
USE MODI_AER_VELGRAV
@@ -145,7 +145,8 @@ USE MODD_PARAM_LIMA_WARM, ONLY : WLBR => XLBR, WLBEXR => XLBEXR, & ! fo
WLBC => XLBC, &
XACCR1, XACCR2, XACCR3, XACCR4, XACCR5, & ! for
XACCR_RLARGE1, XACCR_RLARGE2, & ! accr.
- XACCR_RSMALL1, XACCR_RSMALL2
+ XACCR_RSMALL1, XACCR_RSMALL2, &
+ WEXCACCR=>XEXCACCR, WFCACCR=>XFCACCR
USE MODD_PARAM_n, ONLY: CCLOUD
!--th--
@@ -165,8 +166,6 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCT ! Cloud water m.r. at t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Rain water m.r. at t
REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVT ! Tracer m.r. at t
!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCS ! Cloud water m.r. from source term
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRS ! Rain water m.r. from source term
REAL, DIMENSION(:,:,:), INTENT(IN) :: PEVAP3D ! Instantaneous 3D Rain Evaporation flux (KG/KG/S)
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Potential temp
@@ -263,7 +262,7 @@ INTEGER :: IKE
REAL, DIMENSION(:), ALLOCATABLE :: KRTMIN
REAL :: KCEXVT, KLBR, KLBEXR, KLBC, ZLBEXC
REAL, DIMENSION(2) :: ZXLBC
-REAL :: ZEXSEDR, ZDR
+REAL :: ZEXSEDR, ZDR, ZEXCACCR, ZFCACCR
!
!-------------------------------------------------------------------------------
!
@@ -282,6 +281,8 @@ CASE('ICE3')
KLBEXR = YLBEXR
ZXLBC(:) = YLBC(:)
ZLBEXC = XLBEXC
+ ZEXCACCR = YEXCACCR
+ ZFCACCR = YFCACCR
CASE('LIMA')
ALLOCATE(KRTMIN(SIZE(WRTMIN)))
KRTMIN = WRTMIN
@@ -291,6 +292,8 @@ CASE('LIMA')
KLBC = WLBC
ZLBEXC = 1.0 / 3.0
ZDR = 0.8
+ ZEXCACCR = WEXCACCR
+ ZFCACCR = WFCACCR
END SELECT
!--cb--
!
@@ -361,9 +364,7 @@ CALL AER_WET_DEP_KMT_ICE_WARM
!
CALL AER_WET_DEP_KMT_EVAP
!
-!++cb++
DEALLOCATE(KRTMIN)
-!--cb--
!
!-------------------------------------------------------------------------------
!
@@ -396,12 +397,10 @@ INTEGER :: JKAQ ! counter for chemistry
GCLOUD(:,:,:) = .FALSE.
!
IF (PRESENT(PCCT)) THEN ! case KHKO, C2R2, C3R5, LIMA (2-moment schemes)
- GCLOUD(:,:,:) = PRCS(:,:,:) > KRTMIN(2) .AND. PCCT(:,:,:) > XCTMIN(2)
+ GCLOUD(:,:,:) = PRCT(:,:,:) > KRTMIN(2) .AND. PCCT(:,:,:) > XCTMIN(2)
ELSE ! Case ICE3, REVE, KESS, ... (1-moment schemes)
- GCLOUD(:,:,:) = PRCS(:,:,:) > KRTMIN(2)
+ GCLOUD(:,:,:) = PRCT(:,:,:) > KRTMIN(2)
END IF
-!--cb--
-!--th--
ICLOUD = COUNTJV( GCLOUD(:,:,:),I1C(:),I2C(:),I3C(:))
IF( ICLOUD >= 1 ) THEN
@@ -437,7 +436,7 @@ IF( ICLOUD >= 1 ) THEN
ZTHT(JL) = PTHT(I1C(JL),I2C(JL),I3C(JL))
ZRC(JL) = ZRAY(I1C(JL),I2C(JL),I3C(JL))
ZPABST(JL) = PPABST(I1C(JL),I2C(JL),I3C(JL))
- ZRCT(JL) = PRCS(I1C(JL),I2C(JL),I3C(JL))
+ ZRCT(JL) = PRCT(I1C(JL),I2C(JL),I3C(JL))
ZRHODREF(JL) = PRHODREF(I1C(JL),I2C(JL),I3C(JL))
ZMASSMIN(JL,:) = PMASSMIN(I1C(JL),I2C(JL),I3C(JL),:)
ZWLBDC(JL) = ZLBC(I1C(JL),I2C(JL),I3C(JL))
@@ -711,7 +710,7 @@ DO JN = 1 , KSPLITR
ZSVT(JL,KMODE*2+JKAQ) = PSVT(IR1(JL),IR2(JL),IR3(JL),KMODE*2+JKAQ)
END DO
!
- IF (PRESENT(PCRT)) ZCRT(JL) = PCRT(IR1(JL),IR2(JL),IR2(JL))
+ IF (PRESENT(PCRT)) ZCRT(JL) = PCRT(IR1(JL),IR2(JL),IR3(JL))
ZRRT(JL) = PRRT(IR1(JL),IR2(JL),IR3(JL))
ZRHODREF(JL) = PRHODREF(IR1(JL),IR2(JL),IR3(JL))
ENDDO
@@ -803,10 +802,12 @@ ZZRCT(:,:,:) = MAX(ZZRCT(:,:,:), KRTMIN(2)/2.)
IF (PRESENT(PCRT)) THEN ! 2-moment schemes
!
! from lima_warm_coal.f90 (AUTO)
- ZLBDC3(:,:,:) = XMNH_HUGE
+ ZLBDC3(:,:,:) = 1E40
+ ! ZLBDC3(:,:,:) = XMNH_HUGE
ZLBDC(:,:,:) = 1.E15
WHERE (ZZRCT(:,:,:) > KRTMIN(2) .AND. PCCT(:,:,:) > XCTMIN(2))
- ZLBDC3(:,:,:) = KLBC * PCCT(:,:,:) / PRCT(:,:,:)
+ ZLBDC3(:,:,:) = KLBC * PCCT(:,:,:) / ZZRCT(:,:,:)
+ ! ZLBDC3(:,:,:) = KLBC * PCCT(:,:,:) / PRCT(:,:,:)
ZLBDC(:,:,:) = ZLBDC3(:,:,:)**ZLBEXC
END WHERE
!
@@ -814,14 +815,14 @@ IF (PRESENT(PCRT)) THEN ! 2-moment schemes
WHERE (ZZRCT(:,:,:) > KRTMIN(2))
ZZW3(:,:,:) = MAX(0.0, XLAUTR*PRHODREF(:,:,:)*ZZRCT(:,:,:)* &
(XAUTO1/ZLBDC3(:,:,:)**4-XLAUTR_THRESHOLD)) ! L
- ZZW4(:,:,:) = MIN(PRCS(:,:,:), MAX(0.0, XITAUTR*ZZW3(:,:,:)*ZZRCT(:,:,:)* &
+ ZZW4(:,:,:) = MIN(PRCT(:,:,:), MAX(0.0, XITAUTR*ZZW3(:,:,:)*ZZRCT(:,:,:)* &
(XAUTO2/ZLBDC3(:,:,:)-XITAUTR_THRESHOLD))) ! L/tau
END WHERE
!
ELSE ! 1-moment scheme
!
- WHERE ((ZZRCT(:,:,:) > KRTMIN(2)) .AND. (PRCS(:,:,:) > 0.0))
- ZZW4(:,:,:) = MIN(PRCS(:,:,:), XTIMAUTC* &
+ WHERE ((ZZRCT(:,:,:) > KRTMIN(2)) .AND. (PRCT(:,:,:) > 0.0))
+ ZZW4(:,:,:) = MIN(PRCT(:,:,:), XTIMAUTC* &
MAX((ZZRCT(:,:,:)-XCRIAUTC/PRHODREF(:,:,:)), 0.0))
END WHERE
!
@@ -853,12 +854,14 @@ IF (PRESENT(PCRT)) THEN ! 2-moment schemes
! from lima_warm_coal.f90 (ACCR)
ZLBDR3(:,:,:) = 1.E30
ZLBDR(:,:,:) = 1.E10
+
+
WHERE (PRRT(:,:,:) > KRTMIN(3) .AND. PCRT(:,:,:) > XCTMIN(3))
ZLBDAR(:,:,:) = KLBR * (PRHODREF(:,:,:) * PRRT(:,:,:))**KLBEXR
ZLBDR3(:,:,:) = KLBR * PCRT(:,:,:) / PRRT(:,:,:)
ZLBDR(:,:,:) = ZLBDR3(:,:,:)**KLBEXR
- ZZW4(:,:,:) = MIN(PRCS(:,:,:), XFCACCR * ZZRCT(:,:,:) &
- * ZLBDAR(:,:,:)**XEXCACCR &
+ ZZW4(:,:,:) = MIN(PRCT(:,:,:), ZFCACCR * ZZRCT(:,:,:) &
+ * ZLBDAR(:,:,:)**ZEXCACCR &
* PRHODREF(:,:,:)**(-KCEXVT) )
ZDIM(:,:,:) = XACCR1 / ZLBDAR(:,:,:)
END WHERE
@@ -871,7 +874,7 @@ IF (PRESENT(PCRT)) THEN ! 2-moment schemes
ZZW5(:,:,:) = ZLBDC3(:,:,:) / ZLBDR3(:,:,:)
ZZW1(:,:,:) = (PCCT(:,:,:) * PCRT(:,:,:) / ZLBDC3(:,:,:)**2) * PRHODREF(:,:,:)
ZZW4(:,:,:) = MIN(ZZW1(:,:,:)*(XACCR_RLARGE1+XACCR_RLARGE2*ZZW5(:,:,:)), &
- PRCS(:,:,:))
+ PRCT(:,:,:))
END WHERE
! Accretion for D < 100 10-6 m
WHERE (PRRT(:,:,:) > KRTMIN(3) .AND. PCRT(:,:,:) > XCTMIN(3) .AND. &
@@ -881,17 +884,17 @@ IF (PRESENT(PCRT)) THEN ! 2-moment schemes
ZZW5(:,:,:) = (ZLBDC3(:,:,:) / ZLBDR3(:,:,:))**2
ZZW1(:,:,:) = (PCCT(:,:,:) * PCRT(:,:,:) / ZLBDC3(:,:,:)**3) * PRHODREF(:,:,:)
ZZW4(:,:,:) = MIN(ZZW1(:,:,:)*(XACCR_RSMALL1+XACCR_RSMALL2*ZZW5(:,:,:)), &
- PRCS(:,:,:))
+ PRCT(:,:,:))
END WHERE
!
ELSE ! 1-moment schemes
!
ZLBDR(:,:,:) = 0.0
WHERE ((ZZRCT(:,:,:) > KRTMIN(2)) .AND. (PRRT(:,:,:) > KRTMIN(3)) &
- .AND. (PRCS(:,:,:) > 0.0))
+ .AND. (PRCT(:,:,:) > 0.0))
ZLBDR(:,:,:) = KLBR * (PRHODREF(:,:,:) * PRRT(:,:,:))**KLBEXR
- ZZW4(:,:,:) = MIN(PRCS(:,:,:), XFCACCR * ZZRCT(:,:,:) &
- * ZLBDR(:,:,:)**XEXCACCR &
+ ZZW4(:,:,:) = MIN(PRCT(:,:,:), ZFCACCR * ZZRCT(:,:,:) &
+ * ZLBDR(:,:,:)**ZEXCACCR &
* PRHODREF(:,:,:)**(-KCEXVT) )
END WHERE
END IF
@@ -960,7 +963,7 @@ ZWEVAP(:,:,:) = MAX(ZWEVAP(:,:,:), 0.0)
! no partial cloud evaporation at this stage
!
ZMASK(:,:,:) = 0.
-WHERE(PRCS(:,:,:) .LT. KRTMIN(2))
+WHERE(PRCT(:,:,:) .LT. KRTMIN(2))
ZMASK(:,:,:) = 1.
END WHERE
!
diff --git a/src/mesonh/ext/aircraft_balloon_evol.f90 b/src/mesonh/ext/aircraft_balloon_evol.f90
index 34e4aeb15b940fc1ed14750ff8701e0b51300ae7..d59b33721819904ac9baabd7719c0572b91a2433 100644
--- a/src/mesonh/ext/aircraft_balloon_evol.f90
+++ b/src/mesonh/ext/aircraft_balloon_evol.f90
@@ -25,6 +25,7 @@
! -PSEA was always used even if not allocated (CSURF/=EXTE)
! -do not use PMAP if cartesian domain
! P. Wautelet 06/2022: reorganize flyers
+! P. Wautelet 01/06/2023: deduplicate code => moved to modd/mode_sensors.f90
!-----------------------------------------------------------------
! ##########################
MODULE MODE_AIRCRAFT_BALLOON_EVOL
@@ -154,6 +155,7 @@ REAL, DIMENSION(2,2,SIZE(PZ,3)) :: ZZV ! V points z coordinates
REAL, DIMENSION(2,2,SIZE(PZ,3)) :: ZWM ! mass point wind
!
REAL, DIMENSION(2,2,SIZE(PTH,3)) :: ZEXN ! Exner function
+REAL, DIMENSION(2,2,SIZE(PTH,3)) :: ZTH_EXN ! potential temperature multiplied by Exner function
REAL, DIMENSION(2,2,SIZE(PTH,3)) :: ZRHO ! air density
REAL :: ZFLYER_EXN ! balloon/aircraft Exner func.
REAL, DIMENSION(2,2,SIZE(PTH,3)) :: ZTHW_FLUX !
@@ -161,7 +163,6 @@ REAL, DIMENSION(2,2,SIZE(PTH,3)) :: ZRCW_FLUX !
REAL, DIMENSION(2,2,SIZE(PSV,3),SIZE(PSV,4)) :: ZSVW_FLUX
!
LOGICAL :: GLAUNCH ! launch/takeoff is effective at this time-step (if true)
-LOGICAL :: GSTORE ! storage occurs at this time step
LOGICAL :: GOWNER_CUR ! The process is the current owner of the flyer
!
INTEGER :: II_M ! mass balloon position (x index)
@@ -169,37 +170,6 @@ INTEGER :: IJ_M ! mass balloon position (y index)
INTEGER :: II_U ! U flux point balloon position (x index)
INTEGER :: IJ_V ! V flux point balloon position (y index)
!
-INTEGER :: IK00 ! balloon position for II_M , IJ_M
-INTEGER :: IK01 ! balloon position for II_M , IJ_M+1
-INTEGER :: IK10 ! balloon position for II_M+1, IJ_M
-INTEGER :: IK11 ! balloon position for II_M+1, IJ_M+1
-INTEGER :: IU00 ! balloon position for II_U , IJ_M
-INTEGER :: IU01 ! balloon position for II_U , IJ_M+1
-INTEGER :: IU10 ! balloon position for II_U+1, IJ_M
-INTEGER :: IU11 ! balloon position for II_U+1, IJ_M+1
-INTEGER :: IV00 ! balloon position for II_M , IJ_V
-INTEGER :: IV01 ! balloon position for II_M , IJ_V+1
-INTEGER :: IV10 ! balloon position for II_M+1, IJ_V
-INTEGER :: IV11 ! balloon position for II_M+1, IJ_V+1
-!
-REAL :: ZXCOEF ! X direction interpolation coefficient
-REAL :: ZUCOEF ! X direction interpolation coefficient (for U)
-REAL :: ZYCOEF ! Y direction interpolation coefficient
-REAL :: ZVCOEF ! Y direction interpolation coefficient (for V)
-!
-REAL :: ZZCOEF00 ! Z direction interpolation coefficient for II_M , IJ_M
-REAL :: ZZCOEF01 ! Z direction interpolation coefficient for II_M , IJ_M+1
-REAL :: ZZCOEF10 ! Z direction interpolation coefficient for II_M+1, IJ_M
-REAL :: ZZCOEF11 ! Z direction interpolation coefficient for II_M+1, IJ_M+1
-REAL :: ZUCOEF00 ! Z direction interpolation coefficient for II_U , IJ_M
-REAL :: ZUCOEF01 ! Z direction interpolation coefficient for II_U , IJ_M+1
-REAL :: ZUCOEF10 ! Z direction interpolation coefficient for II_U+1, IJ_M
-REAL :: ZUCOEF11 ! Z direction interpolation coefficient for II_U+1, IJ_M+1
-REAL :: ZVCOEF00 ! Z direction interpolation coefficient for II_M , IJ_V
-REAL :: ZVCOEF01 ! Z direction interpolation coefficient for II_M , IJ_V+1
-REAL :: ZVCOEF10 ! Z direction interpolation coefficient for II_M+1, IJ_V
-REAL :: ZVCOEF11 ! Z direction interpolation coefficient for II_M+1, IJ_V+1
-!
INTEGER :: ISTORE ! time index for storage
!
REAL :: ZTSTEP
@@ -237,10 +207,13 @@ SELECT TYPE ( TPFLYER )
END IF TAKEOFF
!Do we have to store aircraft data?
- IF ( IMI == TPFLYER%NMODEL ) CALL FLYER_CHECK_STORESTEP( TPFLYER )
+ IF ( IMI == TPFLYER%NMODEL ) THEN
+ TPFLYER%LSTORE = TPFLYER%TFLYER_TIME%STORESTEP_CHECK_AND_SET( ISTORE )
+ IF ( TPFLYER%LSTORE ) TPFLYER%NSTORE_CUR = ISTORE
+ END IF
+
! For aircrafts, data has only to be computed at store moments
- ISTORE = TPFLYER%TFLYER_TIME%N_CUR
IF ( IMI == TPFLYER%NMODEL .AND. TPFLYER%LFLY .AND. TPFLYER%LSTORE ) THEN
! Check if it is the right moment to store data
IF ( ABS( TDTCUR - TPFLYER%TFLYER_TIME%TPDATES(ISTORE) ) < 1e-10 ) THEN
@@ -316,7 +289,8 @@ SELECT TYPE ( TPFLYER )
IF ( TPFLYER%NMODEL == IMI .AND. &
( .NOT. TPFLYER%LFLY .OR. TPFLYER%LCRASH .OR. ABS( TPFLYER%TPOS_CUR - TDTCUR ) < 1.e-8 ) ) THEN
!Do we have to store balloon data?
- CALL FLYER_CHECK_STORESTEP( TPFLYER )
+ TPFLYER%LSTORE = TPFLYER%TFLYER_TIME%STORESTEP_CHECK_AND_SET( ISTORE )
+ IF ( TPFLYER%LSTORE ) TPFLYER%NSTORE_CUR = ISTORE
END IF
! In flight
@@ -344,7 +318,7 @@ SELECT TYPE ( TPFLYER )
TPFLYER%LFLY = .FALSE.
WRITE( CMNHMSG(1), "( 'Balloon ', A, ' crashed the ', I2, '/', I2, '/', I4, ' at ', F18.12, &
's (too low or too high)' )" ) &
- TRIM( TPFLYER%CTITLE ), TDTCUR%NDAY, TDTCUR%NMONTH, TDTCUR%NYEAR, TDTCUR%XTIME
+ TRIM( TPFLYER%CNAME ), TDTCUR%NDAY, TDTCUR%NMONTH, TDTCUR%NYEAR, TDTCUR%XTIME
CALL PRINT_MSG( NVERB_WARNING, 'GEN', 'AIRCRAFT_BALLOON_EVOL', OLOCAL = .TRUE. )
ELSE CRASH_VERT
!No vertical crash
@@ -386,34 +360,22 @@ IMPLICIT NONE
CLASS(TBALLOONDATA), INTENT(INOUT) :: TPBALLOON
+LOGICAL :: GLOW, GHIGH
+
SELECT CASE ( TPBALLOON%CTYPE )
!
! Iso-density balloon
!
CASE ( 'ISODEN' )
IF ( TPBALLOON%XALTLAUNCH /= XNEGUNDEF ) THEN
- IK00 = MAX ( COUNT (TPBALLOON%XALTLAUNCH >= ZZM(1,1,:)), 1)
- IK01 = MAX ( COUNT (TPBALLOON%XALTLAUNCH >= ZZM(1,2,:)), 1)
- IK10 = MAX ( COUNT (TPBALLOON%XALTLAUNCH >= ZZM(2,1,:)), 1)
- IK11 = MAX ( COUNT (TPBALLOON%XALTLAUNCH >= ZZM(2,2,:)), 1)
- ZZCOEF00 = (TPBALLOON%XALTLAUNCH - ZZM(1,1,IK00)) / ( ZZM(1,1,IK00+1) - ZZM(1,1,IK00))
- ZZCOEF01 = (TPBALLOON%XALTLAUNCH - ZZM(1,2,IK01)) / ( ZZM(1,2,IK01+1) - ZZM(1,2,IK01))
- ZZCOEF10 = (TPBALLOON%XALTLAUNCH - ZZM(2,1,IK10)) / ( ZZM(2,1,IK10+1) - ZZM(2,1,IK10))
- ZZCOEF11 = (TPBALLOON%XALTLAUNCH - ZZM(2,2,IK11)) / ( ZZM(2,2,IK11+1) - ZZM(2,2,IK11))
- TPBALLOON%XRHO = FLYER_INTERP(ZRHO)
+ CALL TPBALLOON%COMPUTE_VERTICAL_INTERP_COEFF( 'MASS', TPBALLOON%XALTLAUNCH, ZZM, GLOW, GHIGH )
+ TPBALLOON%XRHO = TPBALLOON%INTERP_FROM_MASSPOINT( ZRHO )
ELSE IF ( TPBALLOON%XPRES /= XNEGUNDEF ) THEN
ZFLYER_EXN = (TPBALLOON%XPRES/XP00)**(XRD/XCPD)
- IK00 = MAX ( COUNT (ZFLYER_EXN <= ZEXN(1,1,:)), 1)
- IK01 = MAX ( COUNT (ZFLYER_EXN <= ZEXN(1,2,:)), 1)
- IK10 = MAX ( COUNT (ZFLYER_EXN <= ZEXN(2,1,:)), 1)
- IK11 = MAX ( COUNT (ZFLYER_EXN <= ZEXN(2,2,:)), 1)
- ZZCOEF00 = (ZFLYER_EXN - ZEXN(1,1,IK00)) / ( ZEXN(1,1,IK00+1) - ZEXN(1,1,IK00))
- ZZCOEF01 = (ZFLYER_EXN - ZEXN(1,2,IK01)) / ( ZEXN(1,2,IK01+1) - ZEXN(1,2,IK01))
- ZZCOEF10 = (ZFLYER_EXN - ZEXN(2,1,IK10)) / ( ZEXN(2,1,IK10+1) - ZEXN(2,1,IK10))
- ZZCOEF11 = (ZFLYER_EXN - ZEXN(2,2,IK11)) / ( ZEXN(2,2,IK11+1) - ZEXN(2,2,IK11))
- TPBALLOON%XRHO = FLYER_INTERP(ZRHO)
+ CALL TPBALLOON%COMPUTE_VERTICAL_INTERP_COEFF( 'MASS', ZFLYER_EXN, ZEXN, GLOW, GHIGH )
+ TPBALLOON%XRHO = TPBALLOON%INTERP_FROM_MASSPOINT( ZRHO )
ELSE
- CMNHMSG(1) = 'Error in balloon initial position (balloon ' // TRIM(TPBALLOON%CTITLE) // ' )'
+ CMNHMSG(1) = 'Error in balloon initial position (balloon ' // TRIM(TPBALLOON%CNAME) // ' )'
CMNHMSG(2) = 'neither initial ALTITUDE or PRESsure is given'
CMNHMSG(3) = 'Check your INI_BALLOON routine'
CALL PRINT_MSG( NVERB_FATAL, 'GEN', 'AIRCRAFT_BALLOON_EVOL', OLOCAL = .TRUE. )
@@ -427,65 +389,70 @@ SELECT CASE ( TPBALLOON%CTYPE )
TPBALLOON%XZ_CUR = MAX ( TPBALLOON%XZ_CUR , ZZM(2,1,IKB) )
TPBALLOON%XZ_CUR = MAX ( TPBALLOON%XZ_CUR , ZZM(1,2,IKB) )
TPBALLOON%XZ_CUR = MAX ( TPBALLOON%XZ_CUR , ZZM(2,2,IKB) )
+ IF ( TPBALLOON%XZ_CUR > TPBALLOON%XALTLAUNCH ) THEN
+ WRITE( CMNHMSG(1), '(A)' ) 'initial vertical position of ' // TRIM( TPBALLOON%CNAME ) // ' was too low'
+ WRITE( CMNHMSG(2), '( "forced to ", EN12.3, " (instead of ", EN12.3, ")" )' ) TPBALLOON%XZ_CUR, TPBALLOON%XALTLAUNCH
+ CALL PRINT_MSG( NVERB_WARNING, 'GEN', 'BALLOON_COMPUTE_INITIAL_VERTICAL_POSITION', OLOCAL = .TRUE. )
+ END IF
!
! Constant Volume Balloon
!
CASE ( 'CVBALL' )
IF ( TPBALLOON%XALTLAUNCH /= XNEGUNDEF ) THEN
- IK00 = MAX ( COUNT (TPBALLOON%XALTLAUNCH >= ZZM(1,1,:)), 1)
- IK01 = MAX ( COUNT (TPBALLOON%XALTLAUNCH >= ZZM(1,2,:)), 1)
- IK10 = MAX ( COUNT (TPBALLOON%XALTLAUNCH >= ZZM(2,1,:)), 1)
- IK11 = MAX ( COUNT (TPBALLOON%XALTLAUNCH >= ZZM(2,2,:)), 1)
- IF (IK00*IK01*IK10*IK11 .EQ. 0) THEN
+ CALL TPBALLOON%COMPUTE_VERTICAL_INTERP_COEFF( 'MASS', TPBALLOON%XALTLAUNCH, ZZM, GLOW, GHIGH )
+ IF ( GLOW ) THEN
TPBALLOON%XZ_CUR = TPBALLOON%XALTLAUNCH
TPBALLOON%XZ_CUR = MAX ( TPBALLOON%XZ_CUR , ZZM(1,1,IKB) )
TPBALLOON%XZ_CUR = MAX ( TPBALLOON%XZ_CUR , ZZM(2,1,IKB) )
TPBALLOON%XZ_CUR = MAX ( TPBALLOON%XZ_CUR , ZZM(1,2,IKB) )
TPBALLOON%XZ_CUR = MAX ( TPBALLOON%XZ_CUR , ZZM(2,2,IKB) )
+
+ WRITE( CMNHMSG(1), '(A)' ) 'initial vertical position of ' // TRIM( TPBALLOON%CNAME ) // ' was too low'
+ WRITE( CMNHMSG(2), '( "forced to ", EN12.3, " (instead of ", EN12.3, ")" )' ) TPBALLOON%XZ_CUR, TPBALLOON%XALTLAUNCH
+ CALL PRINT_MSG( NVERB_WARNING, 'GEN', 'BALLOON_COMPUTE_INITIAL_VERTICAL_POSITION', OLOCAL = .TRUE. )
+
+ !Recompute the vertical interpolation coefficients at the corrected vertical position
+ CALL TPBALLOON%COMPUTE_VERTICAL_INTERP_COEFF( 'MASS', TPBALLOON%XALTLAUNCH, ZZM, GLOW, GHIGH )
ELSE
- ZZCOEF00 = (TPBALLOON%XALTLAUNCH - ZZM(1,1,IK00)) / ( ZZM(1,1,IK00+1) - ZZM(1,1,IK00))
- ZZCOEF01 = (TPBALLOON%XALTLAUNCH - ZZM(1,2,IK01)) / ( ZZM(1,2,IK01+1) - ZZM(1,2,IK01))
- ZZCOEF10 = (TPBALLOON%XALTLAUNCH - ZZM(2,1,IK10)) / ( ZZM(2,1,IK10+1) - ZZM(2,1,IK10))
- ZZCOEF11 = (TPBALLOON%XALTLAUNCH - ZZM(2,2,IK11)) / ( ZZM(2,2,IK11+1) - ZZM(2,2,IK11))
- TPBALLOON%XRHO = FLYER_INTERP(ZRHO)
- TPBALLOON%XZ_CUR = FLYER_INTERP(ZZM)
+ TPBALLOON%XZ_CUR = TPBALLOON%INTERP_FROM_MASSPOINT( ZZM )
END IF
+ TPBALLOON%XRHO = TPBALLOON%INTERP_FROM_MASSPOINT( ZRHO )
ELSE IF ( TPBALLOON%XPRES /= XNEGUNDEF ) THEN
ZFLYER_EXN = (TPBALLOON%XPRES/XP00)**(XRD/XCPD)
- IK00 = MAX ( COUNT (ZFLYER_EXN <= ZEXN(1,1,:)), 1)
- IK01 = MAX ( COUNT (ZFLYER_EXN <= ZEXN(1,2,:)), 1)
- IK10 = MAX ( COUNT (ZFLYER_EXN <= ZEXN(2,1,:)), 1)
- IK11 = MAX ( COUNT (ZFLYER_EXN <= ZEXN(2,2,:)), 1)
- IF (IK00*IK01*IK10*IK11 .EQ. 0) THEN
+ CALL TPBALLOON%COMPUTE_VERTICAL_INTERP_COEFF( 'MASS', ZFLYER_EXN, ZEXN, GLOW, GHIGH )
+ IF ( GLOW ) THEN
TPBALLOON%XZ_CUR = ZZM(1,1,IKB)
TPBALLOON%XZ_CUR = MAX ( TPBALLOON%XZ_CUR , ZZM(2,1,IKB) )
TPBALLOON%XZ_CUR = MAX ( TPBALLOON%XZ_CUR , ZZM(1,2,IKB) )
TPBALLOON%XZ_CUR = MAX ( TPBALLOON%XZ_CUR , ZZM(2,2,IKB) )
+
+ WRITE( CMNHMSG(1), '(A)' ) 'initial vertical position of ' // TRIM( TPBALLOON%CNAME ) // ' was too low'
+ WRITE( CMNHMSG(2), '( "forced to ", EN12.3 )' ) TPBALLOON%XZ_CUR
+ CALL PRINT_MSG( NVERB_WARNING, 'GEN', 'BALLOON_COMPUTE_INITIAL_VERTICAL_POSITION', OLOCAL = .TRUE. )
+
+ !Recompute the vertical interpolation coefficients at the corrected vertical position
+ CALL TPBALLOON%COMPUTE_VERTICAL_INTERP_COEFF( 'MASS', TPBALLOON%XZ_CUR, ZZM, GLOW, GHIGH )
ELSE
- ZZCOEF00 = (ZFLYER_EXN - ZEXN(1,1,IK00)) / ( ZEXN(1,1,IK00+1) - ZEXN(1,1,IK00))
- ZZCOEF01 = (ZFLYER_EXN - ZEXN(1,2,IK01)) / ( ZEXN(1,2,IK01+1) - ZEXN(1,2,IK01))
- ZZCOEF10 = (ZFLYER_EXN - ZEXN(2,1,IK10)) / ( ZEXN(2,1,IK10+1) - ZEXN(2,1,IK10))
- ZZCOEF11 = (ZFLYER_EXN - ZEXN(2,2,IK11)) / ( ZEXN(2,2,IK11+1) - ZEXN(2,2,IK11))
- TPBALLOON%XRHO = FLYER_INTERP(ZRHO)
- TPBALLOON%XZ_CUR = FLYER_INTERP(ZZM)
+ TPBALLOON%XZ_CUR = TPBALLOON%INTERP_FROM_MASSPOINT( ZZM )
END IF
+ TPBALLOON%XRHO = TPBALLOON%INTERP_FROM_MASSPOINT( ZRHO )
ELSE
TPBALLOON%XRHO = TPBALLOON%XMASS / TPBALLOON%XVOLUME
- IK00 = MAX ( COUNT (TPBALLOON%XRHO <= ZRHO(1,1,:)), 1)
- IK01 = MAX ( COUNT (TPBALLOON%XRHO <= ZRHO(1,2,:)), 1)
- IK10 = MAX ( COUNT (TPBALLOON%XRHO <= ZRHO(2,1,:)), 1)
- IK11 = MAX ( COUNT (TPBALLOON%XRHO <= ZRHO(2,2,:)), 1)
- IF (IK00*IK01*IK10*IK11 .EQ. 0) THEN
+ CALL TPBALLOON%COMPUTE_VERTICAL_INTERP_COEFF( 'MASS', TPBALLOON%XRHO, ZRHO, GLOW, GHIGH )
+ IF ( GLOW ) THEN
TPBALLOON%XZ_CUR = ZZM(1,1,IKB)
TPBALLOON%XZ_CUR = MAX ( TPBALLOON%XZ_CUR , ZZM(2,1,IKB) )
TPBALLOON%XZ_CUR = MAX ( TPBALLOON%XZ_CUR , ZZM(1,2,IKB) )
TPBALLOON%XZ_CUR = MAX ( TPBALLOON%XZ_CUR , ZZM(2,2,IKB) )
+
+ WRITE( CMNHMSG(1), '(A)' ) 'initial vertical position of ' // TRIM( TPBALLOON%CNAME ) // ' was too low'
+ WRITE( CMNHMSG(2), '( "forced to ", EN12.3 )' ) TPBALLOON%XZ_CUR
+ CALL PRINT_MSG( NVERB_WARNING, 'GEN', 'BALLOON_COMPUTE_INITIAL_VERTICAL_POSITION', OLOCAL = .TRUE. )
+
+ !Recompute the vertical interpolation coefficients at the corrected vertical position
+ CALL TPBALLOON%COMPUTE_VERTICAL_INTERP_COEFF( 'MASS', TPBALLOON%XZ_CUR, ZZM, GLOW, GHIGH )
ELSE
- ZZCOEF00 = (TPBALLOON%XRHO - ZRHO(1,1,IK00)) / ( ZRHO(1,1,IK00+1) - ZRHO(1,1,IK00))
- ZZCOEF01 = (TPBALLOON%XRHO - ZRHO(1,2,IK01)) / ( ZRHO(1,2,IK01+1) - ZRHO(1,2,IK01))
- ZZCOEF10 = (TPBALLOON%XRHO - ZRHO(2,1,IK10)) / ( ZRHO(2,1,IK10+1) - ZRHO(2,1,IK10))
- ZZCOEF11 = (TPBALLOON%XRHO - ZRHO(2,2,IK11)) / ( ZRHO(2,2,IK11+1) - ZRHO(2,2,IK11))
- TPBALLOON%XZ_CUR = FLYER_INTERP(ZZM)
+ TPBALLOON%XZ_CUR = TPBALLOON%INTERP_FROM_MASSPOINT( ZZM )
END IF
END IF
END SELECT
@@ -516,10 +483,10 @@ REAL :: ZV_BAL ! horizontal wind speed at balloon location (along y)
ZTSTEP = PTSTEP
-ZU_BAL = FLYER_INTERP_U(PU)
-ZV_BAL = FLYER_INTERP_V(PV)
+ZU_BAL = TPBALLOON%INTERP_FROM_UPOINT( PU )
+ZV_BAL = TPBALLOON%INTERP_FROM_VPOINT( PV )
if ( .not. lcartesian ) then
- ZMAP = FLYER_INTERP_2D(PMAP)
+ ZMAP = TPBALLOON%INTERP_HOR_FROM_MASSPOINT( PMAP )
else
ZMAP = 1.
end if
@@ -541,7 +508,7 @@ CALL FLYER_GET_RANK_MODEL_ISCRASHED( TPBALLOON )
IF ( TPBALLOON%LCRASH ) THEN
WRITE( CMNHMSG(1), "( 'Balloon ', A, ' crashed the ', I2, '/', I2, '/', I4, ' at ', F18.12, &
's (out of the horizontal boundaries)' )" ) &
- TRIM( TPBALLOON%CTITLE ), TDTCUR%NDAY, TDTCUR%NMONTH, TDTCUR%NYEAR, TDTCUR%XTIME
+ TRIM( TPBALLOON%CNAME ), TDTCUR%NDAY, TDTCUR%NMONTH, TDTCUR%NYEAR, TDTCUR%XTIME
CALL PRINT_MSG( NVERB_WARNING, 'GEN', 'AIRCRAFT_BALLOON_EVOL', OLOCAL = .TRUE. )
END IF
@@ -581,8 +548,8 @@ IF ( TPBALLOON%NMODEL /= IMODEL_OLD .AND. .NOT. TPBALLOON%LCRASH ) THEN
TPBALLOON%TFLYER_TIME%TPDATES(ISTORE) = TPBALLOON%TFLYER_TIME%TPDATES(ISTORE-1) + TPBALLOON%TFLYER_TIME%XTSTEP
WRITE( CMNHMSG(1), "( 'Balloon ', A, ': store skipped at ', I2, '/', I2, '/', I4, ' at ', F18.12, 's' )" ) &
- TRIM( TPBALLOON%CTITLE ), &
- TPBALLOON%TFLYER_TIME%TPDATES(ISTORE)%NDAY, TPBALLOON%TFLYER_TIME%TPDATES(ISTORE)%NMONTH, &
+ TRIM( TPBALLOON%CNAME ), &
+ TPBALLOON%TFLYER_TIME%TPDATES(ISTORE)%NDAY, TPBALLOON%TFLYER_TIME%TPDATES(ISTORE)%NMONTH, &
TPBALLOON%TFLYER_TIME%TPDATES(ISTORE)%NYEAR, TPBALLOON%TFLYER_TIME%TPDATES(ISTORE)%XTIME
CMNHMSG(2) = 'due to change of model (child to its parent)'
CALL PRINT_MSG( NVERB_WARNING, 'GEN', 'AIRCRAFT_BALLOON_EVOL', OLOCAL = .TRUE. )
@@ -600,13 +567,13 @@ IF ( TPBALLOON%NMODEL /= IMODEL_OLD .AND. .NOT. TPBALLOON%LCRASH ) THEN
IF ( TPBALLOON%LCRASH ) THEN
WRITE( CMNHMSG(1), "( 'Balloon ', A, ' crashed the ', I2, '/', I2, '/', I4, ' at ', F18.12, &
's (out of the horizontal boundaries)' )" ) &
- TRIM( TPBALLOON%CTITLE ), TDTCUR%NDAY, TDTCUR%NMONTH, TDTCUR%NYEAR, TDTCUR%XTIME
+ TRIM( TPBALLOON%CNAME ), TDTCUR%NDAY, TDTCUR%NMONTH, TDTCUR%NYEAR, TDTCUR%XTIME
CALL PRINT_MSG( NVERB_WARNING, 'GEN', 'AIRCRAFT_BALLOON_EVOL', OLOCAL = .TRUE. )
END IF
ELSE
! Special case not-managed (different dads, change of several models in 1 step (going to grand parent/grand children)...)
! This situation should be very infrequent => reasonable risk, error on the trajectory should be relatively small in most cases
- CMNHMSG(1) = 'unmanaged change of model for ballon ' // TPBALLOON%CTITLE
+ CMNHMSG(1) = 'unmanaged change of model for ballon ' // TPBALLOON%CNAME
CMNHMSG(2) = 'its trajectory might be wrong'
CALL PRINT_MSG( NVERB_WARNING, 'GEN', 'AIRCRAFT_BALLOON_EVOL', OLOCAL = .TRUE. )
END IF
@@ -629,13 +596,13 @@ REAL :: ZRO_BAL ! air density at balloon location
REAL :: ZW_BAL ! vertical wind speed at balloon location (along z)
IF ( TPBALLOON%CTYPE == 'RADIOS' ) THEN
- ZW_BAL = FLYER_INTERP(ZWM)
+ ZW_BAL = TPBALLOON%INTERP_FROM_MASSPOINT( ZWM )
TPBALLOON%XZ_CUR = TPBALLOON%XZ_CUR + ( ZW_BAL + TPBALLOON%XWASCENT ) * ZTSTEP
END IF
IF ( TPBALLOON%CTYPE == 'CVBALL' ) THEN
- ZW_BAL = FLYER_INTERP(ZWM)
- ZRO_BAL = FLYER_INTERP(ZRHO)
+ ZW_BAL = TPBALLOON%INTERP_FROM_MASSPOINT( ZWM )
+ ZRO_BAL = TPBALLOON%INTERP_FROM_MASSPOINT( ZRHO )
! calculation with a time step of 1 second or less
IF (INT(ZTSTEP) .GT. 1 ) THEN
DO JK=1,INT(ZTSTEP)
@@ -680,12 +647,17 @@ IKE = SIZE(PZ,3) - JPVEXT
! ------------------------------------------------
! X position
-II_U = COUNT( XXHAT (:) <= TPFLYER%XX_CUR )
-II_M = COUNT( XXHATM(:) <= TPFLYER%XX_CUR )
+TPFLYER%NI_U = COUNT( XXHAT (:) <= TPFLYER%XX_CUR )
+TPFLYER%NI_M = COUNT( XXHATM(:) <= TPFLYER%XX_CUR )
+II_U = TPFLYER%NI_U
+II_M = TPFLYER%NI_M
! Y position
-IJ_V=COUNT( XYHAT (:)<=TPFLYER%XY_CUR )
-IJ_M=COUNT( XYHATM(:)<=TPFLYER%XY_CUR )
+TPFLYER%NJ_V = COUNT( XYHAT (:)<=TPFLYER%XY_CUR )
+TPFLYER%NJ_M = COUNT( XYHATM(:)<=TPFLYER%XY_CUR )
+IJ_V = TPFLYER%NJ_V
+IJ_M = TPFLYER%NJ_M
+
ZZM(:,:,1:IKU-1)=0.5 *PZ(II_M :II_M+1,IJ_M :IJ_M+1,1:IKU-1)+0.5 *PZ(II_M :II_M+1,IJ_M :IJ_M+1,2:IKU )
ZZM(:,:, IKU )=1.5 *PZ(II_M :II_M+1,IJ_M :IJ_M+1, IKU-1)-0.5 *PZ(II_M :II_M+1,IJ_M :IJ_M+1, IKU-2)
@@ -765,20 +737,20 @@ USE MODD_GRID_n, ONLY: XXHAT, XXHATM, XYHAT, XYHATM
IMPLICIT NONE
! Interpolation coefficient for X
-ZXCOEF = (TPFLYER%XX_CUR - XXHATM(II_M)) / (XXHATM(II_M+1) - XXHATM(II_M))
-ZXCOEF = MAX (0.,MIN(ZXCOEF,1.))
+TPFLYER%XXMCOEF = ( TPFLYER%XX_CUR - XXHATM(II_M) ) / ( XXHATM(II_M+1) - XXHATM(II_M) )
+TPFLYER%XXMCOEF = MAX( 0., MIN( TPFLYER%XXMCOEF, 1. ) )
! Interpolation coefficient for y
-ZYCOEF = (TPFLYER%XY_CUR - XYHATM(IJ_M)) / (XYHATM(IJ_M+1) - XYHATM(IJ_M))
-ZYCOEF = MAX (0.,MIN(ZYCOEF,1.))
+TPFLYER%XYMCOEF = ( TPFLYER%XY_CUR - XYHATM(IJ_M) ) / ( XYHATM(IJ_M+1) - XYHATM(IJ_M) )
+TPFLYER%XYMCOEF = MAX( 0., MIN( TPFLYER%XYMCOEF, 1. ) )
! Interpolation coefficient for X (for U)
-ZUCOEF = (TPFLYER%XX_CUR - XXHAT(II_U)) / (XXHAT(II_U+1) - XXHAT(II_U))
-ZUCOEF = MAX(0.,MIN(ZUCOEF,1.))
+TPFLYER%XXUCOEF = ( TPFLYER%XX_CUR - XXHAT(II_U) ) / ( XXHAT(II_U+1) - XXHAT(II_U) )
+TPFLYER%XXUCOEF = MAX( 0., MIN( TPFLYER%XXUCOEF, 1. ) )
! Interpolation coefficient for y (for V)
-ZVCOEF = (TPFLYER%XY_CUR - XYHAT(IJ_V)) / (XYHAT(IJ_V+1) - XYHAT(IJ_V))
-ZVCOEF = MAX(0.,MIN(ZVCOEF,1.))
+TPFLYER%XYVCOEF = ( TPFLYER%XY_CUR - XYHAT(IJ_V) ) / ( XYHAT(IJ_V+1) - XYHAT(IJ_V) )
+TPFLYER%XYVCOEF = MAX( 0., MIN( TPFLYER%XYVCOEF, 1. ) )
END SUBROUTINE FLYER_COMPUTE_INTERP_COEFF_HOR_STAGE1
!----------------------------------------------------------------------------
@@ -791,97 +763,46 @@ USE MODD_TIME_n, ONLY: TDTCUR
IMPLICIT NONE
+LOGICAL :: GLOW, GHIGH
+
! Find indices surrounding the vertical box where the flyer is
SELECT TYPE ( TPFLYER )
CLASS IS ( TAIRCRAFTDATA)
IF ( TPFLYER%LALTDEF ) THEN
ZFLYER_EXN = (TPFLYER%XP_CUR/XP00)**(XRD/XCPD)
- IK00 = MAX ( COUNT (ZFLYER_EXN <= ZEXN(1,1,:)), 1)
- IK01 = MAX ( COUNT (ZFLYER_EXN <= ZEXN(1,2,:)), 1)
- IK10 = MAX ( COUNT (ZFLYER_EXN <= ZEXN(2,1,:)), 1)
- IK11 = MAX ( COUNT (ZFLYER_EXN <= ZEXN(2,2,:)), 1)
+ CALL TPFLYER%COMPUTE_VERTICAL_INTERP_COEFF( 'MASS', ZFLYER_EXN, ZEXN, GLOW, GHIGH, ODONOLOWCRASH = .TRUE. )
ELSE
- IK00 = MAX ( COUNT (TPFLYER%XZ_CUR >= ZZM(1,1,:)), 1)
- IK01 = MAX ( COUNT (TPFLYER%XZ_CUR >= ZZM(1,2,:)), 1)
- IK10 = MAX ( COUNT (TPFLYER%XZ_CUR >= ZZM(2,1,:)), 1)
- IK11 = MAX ( COUNT (TPFLYER%XZ_CUR >= ZZM(2,2,:)), 1)
+ CALL TPFLYER%COMPUTE_VERTICAL_INTERP_COEFF( 'MASS', TPFLYER%XZ_CUR, ZZM, GLOW, GHIGH, ODONOLOWCRASH = .TRUE. )
END IF
CLASS IS ( TBALLOONDATA)
IF ( TPFLYER%CTYPE == 'ISODEN' ) THEN
- IK00 = MAX ( COUNT (TPFLYER%XRHO <= ZRHO(1,1,:)), 1)
- IK01 = MAX ( COUNT (TPFLYER%XRHO <= ZRHO(1,2,:)), 1)
- IK10 = MAX ( COUNT (TPFLYER%XRHO <= ZRHO(2,1,:)), 1)
- IK11 = MAX ( COUNT (TPFLYER%XRHO <= ZRHO(2,2,:)), 1)
+ CALL TPFLYER%COMPUTE_VERTICAL_INTERP_COEFF( 'MASS', TPFLYER%XRHO, ZRHO, GLOW, GHIGH, ODONOLOWCRASH = .TRUE. )
ELSE IF ( TPFLYER%CTYPE == 'RADIOS' .OR. TPFLYER%CTYPE == 'CVBALL' ) THEN
- IK00 = MAX ( COUNT (TPFLYER%XZ_CUR >= ZZM(1,1,:)), 1)
- IK01 = MAX ( COUNT (TPFLYER%XZ_CUR >= ZZM(1,2,:)), 1)
- IK10 = MAX ( COUNT (TPFLYER%XZ_CUR >= ZZM(2,1,:)), 1)
- IK11 = MAX ( COUNT (TPFLYER%XZ_CUR >= ZZM(2,2,:)), 1)
+ CALL TPFLYER%COMPUTE_VERTICAL_INTERP_COEFF( 'MASS', TPFLYER%XZ_CUR, ZZM, GLOW, GHIGH, ODONOLOWCRASH = .TRUE. )
END IF
END SELECT
-! Do not allow crash on the ground: set position on the ground if too low
-IF ( ANY( [ IK00, IK01, IK10, IK11 ] < IKB ) ) THEN
- !Minimum altitude is on the ground at IKB (no crash if too low)
- IK00 = MAX ( IK00, IKB )
- IK01 = MAX ( IK01, IKB )
- IK10 = MAX ( IK10, IKB )
- IK11 = MAX ( IK11, IKB )
-
- CMNHMSG(1) = 'flyer ' // TRIM( TPFLYER%CTITLE ) // ' is near the ground'
- WRITE( CMNHMSG(2), "( 'at ', I2, '/', I2, '/', I4, ' ', F18.12, 's' )" ) &
- TDTCUR%NDAY, TDTCUR%NMONTH, TDTCUR%NYEAR, TDTCUR%XTIME
- CALL PRINT_MSG( NVERB_INFO, 'GEN', 'FLYER_COMPUTE_INTERP_COEFF_VER', OLOCAL = .TRUE. )
-END IF
-
-! ! Check if the flyer crashed vertically (lower bound)
-! IF (IK00 < IKB .OR. IK01 < IKB .OR. IK10 < IKB .OR. IK11 < IKB ) THEN
-! TPFLYER%LCRASH = .TRUE.
-! TPFLYER%NCRASH = NCRASH_OUT_LOW
-! END IF
-
! Check if the flyer crashed vertically (higher bound)
-IF (IK00 >= IKE .OR. IK01 >= IKE .OR. IK10 >= IKE .OR. IK11 >= IKE ) THEN
+IF ( GHIGH ) THEN
TPFLYER%LCRASH = .TRUE.
TPFLYER%NCRASH = NCRASH_OUT_HIGH
END IF
-SELECT TYPE ( TPFLYER )
- CLASS IS ( TBALLOONDATA)
- IF ( TPFLYER%LCRASH ) RETURN
-END SELECT
-
-! Interpolation coefficients for the 4 suroundings verticals
SELECT TYPE ( TPFLYER )
CLASS IS ( TAIRCRAFTDATA)
IF ( TPFLYER%LALTDEF ) THEN
- ZZCOEF00 = (ZFLYER_EXN - ZEXN(1,1,IK00)) / ( ZEXN(1,1,IK00+1) - ZEXN(1,1,IK00) )
- ZZCOEF01 = (ZFLYER_EXN - ZEXN(1,2,IK01)) / ( ZEXN(1,2,IK01+1) - ZEXN(1,2,IK01) )
- ZZCOEF10 = (ZFLYER_EXN - ZEXN(2,1,IK10)) / ( ZEXN(2,1,IK10+1) - ZEXN(2,1,IK10) )
- ZZCOEF11 = (ZFLYER_EXN - ZEXN(2,2,IK11)) / ( ZEXN(2,2,IK11+1) - ZEXN(2,2,IK11) )
- TPFLYER%XZ_CUR = FLYER_INTERP(ZZM)
+ TPFLYER%XZ_CUR = TPFLYER%INTERP_FROM_MASSPOINT( ZZM )
ELSE
- ZZCOEF00 = (TPFLYER%XZ_CUR - ZZM(1,1,IK00)) / ( ZZM(1,1,IK00+1) - ZZM(1,1,IK00) )
- ZZCOEF01 = (TPFLYER%XZ_CUR - ZZM(1,2,IK01)) / ( ZZM(1,2,IK01+1) - ZZM(1,2,IK01) )
- ZZCOEF10 = (TPFLYER%XZ_CUR - ZZM(2,1,IK10)) / ( ZZM(2,1,IK10+1) - ZZM(2,1,IK10) )
- ZZCOEF11 = (TPFLYER%XZ_CUR - ZZM(2,2,IK11)) / ( ZZM(2,2,IK11+1) - ZZM(2,2,IK11) )
- TPFLYER%XP_CUR = FLYER_INTERP(PP)
+ TPFLYER%XP_CUR = TPFLYER%INTERP_FROM_MASSPOINT( PP )
END IF
CLASS IS ( TBALLOONDATA)
IF ( TPFLYER%CTYPE == 'ISODEN' ) THEN
- ZZCOEF00 = (TPFLYER%XRHO - ZRHO(1,1,IK00)) / ( ZRHO(1,1,IK00+1) - ZRHO(1,1,IK00) )
- ZZCOEF01 = (TPFLYER%XRHO - ZRHO(1,2,IK01)) / ( ZRHO(1,2,IK01+1) - ZRHO(1,2,IK01) )
- ZZCOEF10 = (TPFLYER%XRHO - ZRHO(2,1,IK10)) / ( ZRHO(2,1,IK10+1) - ZRHO(2,1,IK10) )
- ZZCOEF11 = (TPFLYER%XRHO - ZRHO(2,2,IK11)) / ( ZRHO(2,2,IK11+1) - ZRHO(2,2,IK11) )
- TPFLYER%XZ_CUR = FLYER_INTERP(ZZM)
+ TPFLYER%XZ_CUR = TPFLYER%INTERP_FROM_MASSPOINT( ZZM )
ELSE IF ( TPFLYER%CTYPE == 'RADIOS' .OR. TPFLYER%CTYPE == 'CVBALL' ) THEN
- ZZCOEF00 = (TPFLYER%XZ_CUR - ZZM(1,1,IK00)) / ( ZZM(1,1,IK00+1) - ZZM(1,1,IK00) )
- ZZCOEF01 = (TPFLYER%XZ_CUR - ZZM(1,2,IK01)) / ( ZZM(1,2,IK01+1) - ZZM(1,2,IK01) )
- ZZCOEF10 = (TPFLYER%XZ_CUR - ZZM(2,1,IK10)) / ( ZZM(2,1,IK10+1) - ZZM(2,1,IK10) )
- ZZCOEF11 = (TPFLYER%XZ_CUR - ZZM(2,2,IK11)) / ( ZZM(2,2,IK11+1) - ZZM(2,2,IK11) )
+ !Nothing to do
END IF
END SELECT
@@ -895,96 +816,38 @@ SUBROUTINE FLYER_COMPUTE_INTERP_COEFF_HOR_STAGE2( )
IMPLICIT NONE
-! Interpolation coefficients for the 4 suroundings verticals (for U)
-IU00 = MAX( COUNT (TPFLYER%XZ_CUR >= ZZU(1,1,:)), 1)
-IU01 = MAX( COUNT (TPFLYER%XZ_CUR >= ZZU(1,2,:)), 1)
-IU10 = MAX( COUNT (TPFLYER%XZ_CUR >= ZZU(2,1,:)), 1)
-IU11 = MAX( COUNT (TPFLYER%XZ_CUR >= ZZU(2,2,:)), 1)
-ZUCOEF00 = (TPFLYER%XZ_CUR - ZZU(1,1,IU00)) / ( ZZU(1,1,IU00+1) - ZZU(1,1,IU00) )
-ZUCOEF01 = (TPFLYER%XZ_CUR - ZZU(1,2,IU01)) / ( ZZU(1,2,IU01+1) - ZZU(1,2,IU01) )
-ZUCOEF10 = (TPFLYER%XZ_CUR - ZZU(2,1,IU10)) / ( ZZU(2,1,IU10+1) - ZZU(2,1,IU10) )
-ZUCOEF11 = (TPFLYER%XZ_CUR - ZZU(2,2,IU11)) / ( ZZU(2,2,IU11+1) - ZZU(2,2,IU11) )
+LOGICAL :: GLOW, GHIGH
+
+! Interpolation coefficients for the 4 surroundings verticals (for U)
+! ODONOLOWCRASH = .TRUE. because check for low crash has already been done
+CALL TPFLYER%COMPUTE_VERTICAL_INTERP_COEFF( 'U', TPFLYER%XZ_CUR, ZZU, GLOW, GHIGH, ODONOLOWCRASH = .TRUE. )
! Interpolation coefficients for the 4 suroundings verticals (for V)
-IV00 = MAX ( COUNT (TPFLYER%XZ_CUR >= ZZV(1,1,:)), 1)
-IV01 = MAX ( COUNT (TPFLYER%XZ_CUR >= ZZV(1,2,:)), 1)
-IV10 = MAX ( COUNT (TPFLYER%XZ_CUR >= ZZV(2,1,:)), 1)
-IV11 = MAX ( COUNT (TPFLYER%XZ_CUR >= ZZV(2,2,:)), 1)
-ZVCOEF00 = (TPFLYER%XZ_CUR - ZZV(1,1,IV00)) / ( ZZV(1,1,IV00+1) - ZZV(1,1,IV00) )
-ZVCOEF01 = (TPFLYER%XZ_CUR - ZZV(1,2,IV01)) / ( ZZV(1,2,IV01+1) - ZZV(1,2,IV01) )
-ZVCOEF10 = (TPFLYER%XZ_CUR - ZZV(2,1,IV10)) / ( ZZV(2,1,IV10+1) - ZZV(2,1,IV10) )
-ZVCOEF11 = (TPFLYER%XZ_CUR - ZZV(2,2,IV11)) / ( ZZV(2,2,IV11+1) - ZZV(2,2,IV11) )
+CALL TPFLYER%COMPUTE_VERTICAL_INTERP_COEFF( 'V', TPFLYER%XZ_CUR, ZZV, GLOW, GHIGH, ODONOLOWCRASH = .TRUE. )
END SUBROUTINE FLYER_COMPUTE_INTERP_COEFF_HOR_STAGE2
!----------------------------------------------------------------------------
!----------------------------------------------------------------------------
SUBROUTINE FLYER_RECORD_DATA( )
-USE MODD_CST, ONLY: XCPD, XLAM_CRAD, XLIGHTSPEED, XP00, XPI, XRD, XRHOLW, XTT
-USE MODD_DIAG_IN_RUN, ONLY: LDIAG_IN_RUN, XCURRENT_TKE_DISS
+USE MODD_CST, ONLY: XP00, XPI, XRD
+USE MODD_DIAG_IN_RUN, ONLY: XCURRENT_TKE_DISS
USE MODD_GRID, ONLY: XBETA, XLON0, XRPK
USE MODD_NSV, ONLY: NSV_LIMA_NC, NSV_LIMA_NR, NSV_LIMA_NI
USE MODD_PARAMETERS, ONLY: JPVEXT
-USE MODD_PARAM_ICE_n, ONLY: LSNOW_T_I => LSNOW_T
-USE MODD_PARAM_LIMA, ONLY: LSNOW_T_L => LSNOW_T, &
- XALPHAR_L => XALPHAR, XNUR_L => XNUR, XALPHAS_L => XALPHAS, XNUS_L => XNUS, &
- XALPHAG_L => XALPHAG, XNUG_L => XNUG, XALPHAI_L => XALPHAI, XNUI_L => XNUI, &
- XRTMIN_L => XRTMIN, XALPHAC_L => XALPHAC, XNUC_L => XNUC
-USE MODD_PARAM_LIMA_COLD, ONLY: XAI_L => XAI, XBI_L => XBI, XLBEXS_L => XLBEXS,XLBS_L => XLBS,XCCS_L => XCCS, &
- XAS_L => XAS, XBS_L => XBS, XCXS_L => XCXS, &
- XLBDAS_MAX_L => XLBDAS_MAX, XLBDAS_MIN_L => XLBDAS_MIN, &
- XNS_L => XNS, XTRANS_MP_GAMMAS_L=>XTRANS_MP_GAMMAS
-USE MODD_PARAM_LIMA_MIXED, ONLY: XLBEXG_L => XLBEXG, XLBG_L => XLBG, XCCG_L => XCCG, XAG_L => XAG, XBG_L => XBG, XCXG_L => XCXG
-USE MODD_PARAM_LIMA_WARM, ONLY: XAC_L => XAC, XAR_L => XAR, XBC_L => XBC, XBR_L => XBR
-USE MODD_PARAM_n, ONLY: CCLOUD, CSURF
-USE MODD_RAIN_ICE_DESCR_n, ONLY: XALPHAR_I => XALPHAR, XNUR_I => XNUR, XLBEXR_I => XLBEXR, &
- XLBR_I => XLBR, XCCR_I => XCCR, XBR_I => XBR, XAR_I => XAR, &
- XALPHAC_I => XALPHAC, XNUC_I => XNUC, XBC_I => XBC, XAC_I => XAC, &
- XALPHAC2_I => XALPHAC2, XNUC2_I => XNUC2, &
- XALPHAS_I => XALPHAS, XNUS_I => XNUS, XLBEXS_I => XLBEXS, &
- XLBS_I => XLBS, XCCS_I => XCCS, XAS_I => XAS, XBS_I => XBS, XCXS_I => XCXS, &
- XALPHAG_I => XALPHAG, XNUG_I => XNUG, XLBEXG_I => XLBEXG, &
- XLBG_I => XLBG, XCCG_I => XCCG, XAG_I => XAG, XBG_I => XBG, XCXG_I => XCXG, &
- XALPHAI_I => XALPHAI, XNUI_I => XNUI, XLBEXI_I => XLBEXI, &
- XLBI_I => XLBI, XAI_I => XAI, XBI_I => XBI, &
- XNS_I => XNS, XRTMIN_I => XRTMIN, XCONC_LAND, XCONC_SEA, &
- XLBDAS_MAX_I => XLBDAS_MAX, XLBDAS_MIN_I => XLBDAS_MIN, &
- XTRANS_MP_GAMMAS_I => XTRANS_MP_GAMMAS
-
-USE MODE_FGAU, ONLY: GAULAG
-USE MODE_FSCATTER, ONLY: BHMIE, MOMG, MG, QEPSI, QEPSW
-USE MODE_GRIDPROJ, ONLY: SM_LATLON
+USE MODD_PARAM_n, ONLY: CCLOUD, CRAD
-USE MODI_GAMMA, ONLY: GAMMA
+USE MODE_GRIDPROJ, ONLY: SM_LATLON
+USE MODE_SENSOR, ONLY: Sensor_rare_compute, Sensor_wc_compute
IMPLICIT NONE
-INTEGER, PARAMETER :: JPTS_GAULAG = 7 ! number of points for Gauss-Laguerre quadrature
-
-INTEGER :: JK ! loop index
INTEGER :: JLOOP ! loop counter
-REAL, DIMENSION(SIZE(PR,3)) :: ZTEMPZ! vertical profile of temperature
-REAL, DIMENSION(SIZE(PR,3)) :: ZRHODREFZ ! vertical profile of dry air density of the reference state
-REAL, DIMENSION(SIZE(PR,3)) :: ZCIT ! pristine ice concentration
-REAL, DIMENSION(SIZE(PR,3)) :: ZCCI,ZCCR,ZCCC ! ICE,RAIN CLOUD concentration (LIMA)
-REAL, DIMENSION(SIZE(PR,1),SIZE(PR,2),SIZE(PR,3)) :: ZR
-REAL, DIMENSION(SIZE(PR,3),SIZE(PR,4)+1) :: ZRZ ! vertical profile of hydrometeor mixing ratios
-REAL :: ZA, ZB, ZCC, ZCX, ZALPHA, ZNS, ZNU, ZLB, ZLBEX, ZRHOHYD ! generic microphysical parameters
-INTEGER :: JJ ! loop counter for quadrature
-COMPLEX :: QMW,QMI,QM,QEPSIW,QEPSWI ! dielectric parameter
-REAL :: ZAETOT,ZAETMP,ZREFLOC,ZQSCA,ZQBACK,ZQEXT ! temporary scattering parameters
-REAL,DIMENSION(:),ALLOCATABLE :: ZAELOC,ZZMZ ! temporary arrays
-REAL :: ZLBDA ! slope distribution parameter
-REAL :: ZDELTA_EQUIV ! mass-equivalent Gauss-Laguerre point
-REAL :: ZFW ! liquid fraction
-REAL :: ZFPW ! weight for mixed-phase reflectivity
-REAL :: ZN ! number concentration
-REAL,DIMENSION(:),ALLOCATABLE :: ZX,ZW ! Gauss-Laguerre points and weights
-REAL,DIMENSION(:),ALLOCATABLE :: ZRTMIN ! local values for XRTMIN
-LOGICAL :: GCALC
REAL :: ZGAM ! rotation between meso-nh base and spherical lat-lon base.
REAL :: ZU_BAL ! horizontal wind speed at balloon location (along x)
REAL :: ZV_BAL ! horizontal wind speed at balloon location (along y)
+REAL, DIMENSION(SIZE(PZ,3)) :: ZZ ! altitude of model levels at station location
+REAL, DIMENSION(SIZE(PR,1),SIZE(PR,2),SIZE(PR,3)) :: ZR
TPFLYER%NMODELHIST(ISTORE) = TPFLYER%NMODEL
@@ -992,496 +855,75 @@ TPFLYER%XX(ISTORE) = TPFLYER%XX_CUR
TPFLYER%XY(ISTORE) = TPFLYER%XY_CUR
TPFLYER%XZ(ISTORE) = TPFLYER%XZ_CUR
!
-CALL SM_LATLON(PLATOR,PLONOR, &
- TPFLYER%XX_CUR, TPFLYER%XY_CUR, &
- TPFLYER%XLAT(ISTORE), TPFLYER%XLON(ISTORE) )
+CALL SM_LATLON( PLATOR, PLONOR, &
+ TPFLYER%XX_CUR, TPFLYER%XY_CUR, &
+ TPFLYER%XLAT_CUR, TPFLYER%XLON_CUR )
+TPFLYER%XLAT(ISTORE) = TPFLYER%XLAT_CUR
+TPFLYER%XLON(ISTORE) = TPFLYER%XLON_CUR
!
-ZU_BAL = FLYER_INTERP_U(PU)
-ZV_BAL = FLYER_INTERP_V(PV)
-ZGAM = (XRPK * (TPFLYER%XLON(ISTORE) - XLON0) - XBETA)*(XPI/180.)
-TPFLYER%XZON (ISTORE) = ZU_BAL * COS(ZGAM) + ZV_BAL * SIN(ZGAM)
-TPFLYER%XMER (ISTORE) = - ZU_BAL * SIN(ZGAM) + ZV_BAL * COS(ZGAM)
+ZU_BAL = TPFLYER%INTERP_FROM_UPOINT( PU )
+ZV_BAL = TPFLYER%INTERP_FROM_VPOINT( PV )
+ZGAM = (XRPK * (TPFLYER%XLON_CUR - XLON0) - XBETA)*(XPI/180.)
+TPFLYER%XZON (1,ISTORE) = ZU_BAL * COS(ZGAM) + ZV_BAL * SIN(ZGAM)
+TPFLYER%XMER (1,ISTORE) = - ZU_BAL * SIN(ZGAM) + ZV_BAL * COS(ZGAM)
!
-TPFLYER%XW (ISTORE) = FLYER_INTERP(ZWM)
-TPFLYER%XTH (ISTORE) = FLYER_INTERP(PTH)
+TPFLYER%XW (1,ISTORE) = TPFLYER%INTERP_FROM_MASSPOINT( ZWM )
+TPFLYER%XTH (1,ISTORE) = TPFLYER%INTERP_FROM_MASSPOINT( PTH )
!
-ZFLYER_EXN = FLYER_INTERP(ZEXN)
-TPFLYER%XP (ISTORE) = XP00 * ZFLYER_EXN**(XCPD/XRD)
+ZFLYER_EXN = TPFLYER%INTERP_FROM_MASSPOINT( ZEXN )
+TPFLYER%XP (1,ISTORE) = XP00 * ZFLYER_EXN**(XCPD/XRD)
ZR(:,:,:) = 0.
DO JLOOP=1,SIZE(PR,4)
- TPFLYER%XR (ISTORE,JLOOP) = FLYER_INTERP(PR(:,:,:,JLOOP))
+ TPFLYER%XR (1,ISTORE,JLOOP) = TPFLYER%INTERP_FROM_MASSPOINT( PR(:,:,:,JLOOP) )
IF (JLOOP>=2) ZR(:,:,:) = ZR(:,:,:) + PR(:,:,:,JLOOP)
END DO
DO JLOOP=1,SIZE(PSV,4)
- TPFLYER%XSV (ISTORE,JLOOP) = FLYER_INTERP(PSV(:,:,:,JLOOP))
+ TPFLYER%XSV (1,ISTORE,JLOOP) = TPFLYER%INTERP_FROM_MASSPOINT( PSV(:,:,:,JLOOP) )
END DO
-TPFLYER%XRTZ (ISTORE,:) = FLYER_INTERPZ(ZR(:,:,:))
+TPFLYER%XRTZ (:,ISTORE) = TPFLYER%INTERP_HOR_FROM_MASSPOINT( ZR(:,:,:) )
DO JLOOP=1,SIZE(PR,4)
- TPFLYER%XRZ (ISTORE,:,JLOOP) = FLYER_INTERPZ(PR(:,:,:,JLOOP))
+ TPFLYER%XRZ (:,ISTORE,JLOOP) = TPFLYER%INTERP_HOR_FROM_MASSPOINT( PR(:,:,:,JLOOP) )
END DO
-TPFLYER%XFFZ (ISTORE,:) = FLYER_INTERPZ(SQRT(PU**2+PV**2))
+TPFLYER%XFFZ (:,ISTORE) = TPFLYER%INTERP_HOR_FROM_MASSPOINT( SQRT(PU**2+PV**2) )
+
+TPFLYER%XRHOD (:,ISTORE) = TPFLYER%INTERP_HOR_FROM_MASSPOINT( PRHODREF )
IF (CCLOUD=="LIMA") THEN
- TPFLYER%XCIZ (ISTORE,:) = FLYER_INTERPZ(PSV(:,:,:,NSV_LIMA_NI))
- TPFLYER%XCCZ (ISTORE,:) = FLYER_INTERPZ(PSV(:,:,:,NSV_LIMA_NC))
- TPFLYER%XCRZ (ISTORE,:) = FLYER_INTERPZ(PSV(:,:,:,NSV_LIMA_NR))
+ TPFLYER%XCIZ (:,ISTORE) = TPFLYER%INTERP_HOR_FROM_MASSPOINT( PSV(:,:,:,NSV_LIMA_NI) )
+ TPFLYER%XCCZ (:,ISTORE) = TPFLYER%INTERP_HOR_FROM_MASSPOINT( PSV(:,:,:,NSV_LIMA_NC) )
+ TPFLYER%XCRZ (:,ISTORE) = TPFLYER%INTERP_HOR_FROM_MASSPOINT( PSV(:,:,:,NSV_LIMA_NR) )
ELSE IF ( CCLOUD=="ICE3" .OR. CCLOUD=="ICE4" ) THEN
- TPFLYER%XCIZ (ISTORE,:) = FLYER_INTERPZ(PCIT(:,:,:))
+ TPFLYER%XCIZ (:,ISTORE) = TPFLYER%INTERP_HOR_FROM_MASSPOINT( PCIT(:,:,:) )
END IF
-! initialization CRARE and CRARE_ATT + LWC and IWC
-TPFLYER%XCRARE(ISTORE,:) = 0.
-TPFLYER%XCRARE_ATT(ISTORE,:) = 0.
-TPFLYER%XLWCZ (ISTORE,:) = 0.
-TPFLYER%XIWCZ (ISTORE,:) = 0.
-IF (CCLOUD=="LIMA" .OR. CCLOUD=="ICE3" ) THEN ! only for ICE3 and LIMA
- TPFLYER%XLWCZ (ISTORE,:) = FLYER_INTERPZ((PR(:,:,:,2)+PR(:,:,:,3))*PRHODREF(:,:,:))
- TPFLYER%XIWCZ (ISTORE,:) = FLYER_INTERPZ((PR(:,:,:,4)+PR(:,:,:,5)+PR(:,:,:,6))*PRHODREF(:,:,:))
- ZTEMPZ(:)=FLYER_INTERPZ(PTH(II_M:II_M+1,IJ_M:IJ_M+1,:) * ZEXN(:,:,:))
- ZRHODREFZ(:)=FLYER_INTERPZ(PRHODREF(:,:,:))
- IF (CCLOUD=="LIMA") THEN
- ZCCI(:)=FLYER_INTERPZ(PSV(:,:,:,NSV_LIMA_NI))
- ZCCR(:)=FLYER_INTERPZ(PSV(:,:,:,NSV_LIMA_NR))
- ZCCC(:)=FLYER_INTERPZ(PSV(:,:,:,NSV_LIMA_NC))
- ELSE
- ZCIT(:)=FLYER_INTERPZ(PCIT(:,:,:))
- ENDIF
- DO JLOOP=3,6
- ZRZ(:,JLOOP)=FLYER_INTERPZ(PR(:,:,:,JLOOP))
- END DO
- if ( csurf == 'EXTE' ) then
- DO JK=1,IKU
- ZRZ(JK,2)=FLYER_INTERP_2D(PR(:,:,JK,2)*PSEA(:,:)) ! becomes cloud mixing ratio over sea
- ZRZ(JK,7)=FLYER_INTERP_2D(PR(:,:,JK,2)*(1.-PSEA(:,:))) ! becomes cloud mixing ratio over land
- END DO
- else
- !if csurf/='EXTE', psea is not allocated
- DO JK=1,IKU
- ZRZ(JK,2)=FLYER_INTERP_2D(PR(:,:,JK,2))
- ZRZ(JK,7) = 0.
- END DO
- end if
- ALLOCATE(ZAELOC(IKU))
- !
- ZAELOC(:)=0.
- ! initialization of quadrature points and weights
- ALLOCATE(ZX(JPTS_GAULAG),ZW(JPTS_GAULAG))
- CALL GAULAG(JPTS_GAULAG,ZX,ZW) ! for integration over diameters
- ! initialize minimum values
- ALLOCATE(ZRTMIN(SIZE(PR,4)+1))
- IF (CCLOUD == 'LIMA') THEN
- ZRTMIN(2)=XRTMIN_L(2) ! cloud water over sea
- ZRTMIN(3)=XRTMIN_L(3)
- ZRTMIN(4)=XRTMIN_L(4)
- ZRTMIN(5)=1E-10
- ZRTMIN(6)=XRTMIN_L(6)
- ZRTMIN(7)=XRTMIN_L(2) ! cloud water over land
- ELSE
- ZRTMIN(2)=XRTMIN_I(2) ! cloud water over sea
- ZRTMIN(3)=XRTMIN_I(3)
- ZRTMIN(4)=XRTMIN_I(4)
- ZRTMIN(5)=1E-10
- ZRTMIN(6)=XRTMIN_I(6)
- ZRTMIN(7)=XRTMIN_I(2) ! cloud water over land
- ENDIF
- ! compute cloud radar reflectivity from vertical profiles of temperature and mixing ratios
- DO JK=1,IKU
- QMW=SQRT(QEPSW(ZTEMPZ(JK),XLIGHTSPEED/XLAM_CRAD))
- QMI=SQRT(QEPSI(ZTEMPZ(JK),XLIGHTSPEED/XLAM_CRAD))
- DO JLOOP=2,7
- IF (CCLOUD == 'LIMA') THEN
- GCALC=(ZRZ(JK,JLOOP)>ZRTMIN(JLOOP).AND.(JLOOP.NE.4.OR.ZCCI(JK)>0.).AND.&
- (JLOOP.NE.3.OR.ZCCR(JK)>0.).AND.((JLOOP.NE.2.AND. JLOOP.NE.7).OR.ZCCC(JK)>0.))
- ELSE
- GCALC=(ZRZ(JK,JLOOP)>ZRTMIN(JLOOP).AND.(JLOOP.NE.4.OR.ZCIT(JK)>0.))
- ENDIF
- IF(GCALC) THEN
- SELECT CASE(JLOOP)
- CASE(2) ! cloud water over sea
- IF (CCLOUD == 'LIMA') THEN
- ZA=XAC_L
- ZB=XBC_L
- ZCC=ZCCC(JK)*ZRHODREFZ(JK)
- ZCX=0.
- ZALPHA=XALPHAC_L
- ZNU=XNUC_L
- ZLBEX=1.0/(ZCX-ZB)
- ZLB=( ZA*ZCC*MOMG(ZALPHA,ZNU,ZB) )**(-ZLBEX)
- ELSE
- ZA=XAC_I
- ZB=XBC_I
- ZCC=XCONC_SEA
- ZCX=0.
- ZALPHA=XALPHAC2_I
- ZNU=XNUC2_I
- ZLBEX=1.0/(ZCX-ZB)
- ZLB=( ZA*ZCC*MOMG(ZALPHA,ZNU,ZB) )**(-ZLBEX)
- ENDIF
- CASE(3) ! rain water
- IF (CCLOUD == 'LIMA') THEN
- ZA=XAR_L
- ZB=XBR_L
- ZCC=ZCCR(JK)*ZRHODREFZ(JK)
- ZCX=0.
- ZALPHA=XALPHAR_L
- ZNU=XNUR_L
- ZLBEX=1.0/(ZCX-ZB)
- ZLB=( ZA*ZCC*MOMG(ZALPHA,ZNU,ZB) )**(-ZLBEX)
- ELSE
- ZA=XAR_I
- ZB=XBR_I
- ZCC=XCCR_I
- ZCX=-1.
- ZALPHA=XALPHAR_I
- ZNU=XNUR_I
- ZLB=XLBR_I
- ZLBEX=XLBEXR_I
- ENDIF
- CASE(4) ! pristine ice
- IF (CCLOUD == 'LIMA') THEN
- ZA=XAI_L
- ZB=XBI_L
- ZCC=ZCCI(JK)*ZRHODREFZ(JK)
- ZCX=0.
- ZALPHA=XALPHAI_L
- ZNU=XNUI_L
- ZLBEX=1.0/(ZCX-ZB)
- ZLB=( ZA*ZCC*MOMG(ZALPHA,ZNU,ZB) )**(-ZLBEX) ! because ZCC not included in XLBI
- ZFW=0
- ELSE
- ZA=XAI_I
- ZB=XBI_I
- ZCC=ZCIT(JK)
- ZCX=0.
- ZALPHA=XALPHAI_I
- ZNU=XNUI_I
- ZLBEX=XLBEXI_I
- ZLB=XLBI_I*ZCC**(-ZLBEX) ! because ZCC not included in XLBI
- ZFW=0
- ENDIF
- CASE(5) ! snow
- IF (CCLOUD == 'LIMA') THEN
- ZA=XAS_L
- ZB=XBS_L
- ZCC=XCCS_L
- ZCX=XCXS_L
- ZALPHA=XALPHAS_L
- ZNU=XNUS_L
- ZNS=XNS_L
- ZLB=XLBS_L
- ZLBEX=XLBEXS_L
- ZFW=0
- ELSE
- ZA=XAS_I
- ZB=XBS_I
- ZCC=XCCS_I
- ZCX=XCXS_I
- ZALPHA=XALPHAS_I
- ZNU=XNUS_I
- ZNS=XNS_I
- ZLB=XLBS_I
- ZLBEX=XLBEXS_I
- ZFW=0
- ENDIF
- CASE(6) ! graupel
- !If temperature between -10 and 10°C and Mr and Mg over min threshold: melting graupel
- ! with liquid water fraction Fw=Mr/(Mr+Mg) else dry graupel (Fw=0)
- IF( ZTEMPZ(JK) > XTT-10 .AND. ZTEMPZ(JK) < XTT+10 &
- .AND. ZRZ(JK,3) > ZRTMIN(3) ) THEN
- ZFW=ZRZ(JK,3)/(ZRZ(JK,3)+ZRZ(JK,JLOOP))
- ELSE
- ZFW=0
- ENDIF
- IF (CCLOUD == 'LIMA') THEN
- ZA=XAG_L
- ZB=XBG_L
- ZCC=XCCG_L
- ZCX=XCXG_L
- ZALPHA=XALPHAG_L
- ZNU=XNUG_L
- ZLB=XLBG_L
- ZLBEX=XLBEXG_L
- ELSE
- ZA=XAG_I
- ZB=XBG_I
- ZCC=XCCG_I
- ZCX=XCXG_I
- ZALPHA=XALPHAG_I
- ZNU=XNUG_I
- ZLB=XLBG_I
- ZLBEX=XLBEXG_I
- ENDIF
- CASE(7) ! cloud water over land
- IF (CCLOUD == 'LIMA') THEN
- ZA=XAC_L
- ZB=XBC_L
- ZCC=ZCCC(JK)*ZRHODREFZ(JK)
- ZCX=0.
- ZALPHA=XALPHAC_L
- ZNU=XNUC_L
- ZLBEX=1.0/(ZCX-ZB)
- ZLB=( ZA*ZCC*MOMG(ZALPHA,ZNU,ZB) )**(-ZLBEX)
- ELSE
- ZA=XAC_I
- ZB=XBC_I
- ZCC=XCONC_LAND
- ZCX=0.
- ZALPHA=XALPHAC_I
- ZNU=XNUC_I
- ZLBEX=1.0/(ZCX-ZB)
- ZLB=( ZA*ZCC*MOMG(ZALPHA,ZNU,ZB) )**(-ZLBEX)
- ENDIF
- END SELECT
- IF ( JLOOP == 5 .AND. CCLOUD=='LIMA'.AND.LSNOW_T_L ) THEN
- IF (ZTEMPZ(JK)>XTT-10.) THEN
- ZLBDA = MAX(MIN(XLBDAS_MAX_L, 10**(14.554-0.0423*ZTEMPZ(JK))),XLBDAS_MIN_L)*XTRANS_MP_GAMMAS_L
- ELSE
- ZLBDA = MAX(MIN(XLBDAS_MAX_L, 10**(6.226-0.0106*ZTEMPZ(JK))),XLBDAS_MIN_L)*XTRANS_MP_GAMMAS_L
- END IF
- ZN=ZNS*ZRHODREFZ(JK)*ZRZ(JK,JLOOP)*ZLBDA**ZB
- ELSE IF (JLOOP.EQ.5 .AND. (CCLOUD=='ICE3'.AND.LSNOW_T_I) ) THEN
- IF (ZTEMPZ(JK)>XTT-10.) THEN
- ZLBDA = MAX(MIN(XLBDAS_MAX_I, 10**(14.554-0.0423*ZTEMPZ(JK))),XLBDAS_MIN_I)*XTRANS_MP_GAMMAS_I
- ELSE
- ZLBDA = MAX(MIN(XLBDAS_MAX_I, 10**(6.226-0.0106*ZTEMPZ(JK))),XLBDAS_MIN_I)*XTRANS_MP_GAMMAS_I
- END IF
- ZN=ZNS*ZRHODREFZ(JK)*ZRZ(JK,JLOOP)*ZLBDA**ZB
- ELSE
- ZLBDA=ZLB*(ZRHODREFZ(JK)*ZRZ(JK,JLOOP))**ZLBEX
- ZN=ZCC*ZLBDA**ZCX
- END IF
- ZREFLOC=0.
- ZAETMP=0.
- DO JJ=1,JPTS_GAULAG ! Gauss-Laguerre quadrature
- ZDELTA_EQUIV=ZX(JJ)**(1./ZALPHA)/ZLBDA
- SELECT CASE(JLOOP)
- CASE(2,3,7)
- QM=QMW
- CASE(4,5,6)
- ! pristine ice, snow, dry graupel
- ZRHOHYD=MIN(6.*ZA*ZDELTA_EQUIV**(ZB-3.)/XPI,.92*XRHOLW)
- QM=sqrt(MG(QMI**2,CMPLX(1,0),ZRHOHYD/.92/XRHOLW))
-
- ! water inclusions in ice in air
- QEPSWI=MG(QMW**2,QM**2,ZFW)
- ! ice in air inclusions in water
- QEPSIW=MG(QM**2,QMW**2,1.-ZFW)
-
- !MG weighted rule (Matrosov 2008)
- IF(ZFW .LT. 0.37) THEN
- ZFPW=0
- ELSE IF(ZFW .GT. 0.63) THEN
- ZFPW=1
- ELSE
- ZFPW=(ZFW-0.37)/(0.63-0.37)
- ENDIF
- QM=sqrt(QEPSWI*(1.-ZFPW)+QEPSIW*ZFPW)
- END SELECT
- CALL BHMIE(XPI/XLAM_CRAD*ZDELTA_EQUIV,QM,ZQEXT,ZQSCA,ZQBACK)
- ZREFLOC=ZREFLOC+ZQBACK*ZX(JJ)**(ZNU-1)*ZDELTA_EQUIV**2*ZW(JJ)
- ZAETMP =ZAETMP +ZQEXT *ZX(JJ)**(ZNU-1)*ZDELTA_EQUIV**2*ZW(JJ)
- END DO
- ZREFLOC=ZREFLOC*(XLAM_CRAD/XPI)**4*ZN/(4.*GAMMA(ZNU)*.93)
- ZAETMP=ZAETMP * XPI *ZN/(4.*GAMMA(ZNU))
- TPFLYER%XCRARE(ISTORE,JK)=TPFLYER%XCRARE(ISTORE,JK)+ZREFLOC
- ZAELOC(JK)=ZAELOC(JK)+ZAETMP
- END IF
- END DO
- END DO
-
- ! apply attenuation
- ALLOCATE(ZZMZ(IKU))
- ZZMZ(:)=FLYER_INTERPZ(ZZM(:,:,:))
- ! nadir
- ZAETOT=1.
- DO JK=COUNT(TPFLYER%XZ_CUR >= ZZMZ(:)),1,-1
- IF(JK.EQ.COUNT(TPFLYER%XZ_CUR >= ZZMZ(:))) THEN
- IF(TPFLYER%XZ_CUR<=ZZMZ(JK)+.5*(ZZMZ(JK+1)-ZZMZ(JK))) THEN
- ! only attenuation from ZAELOC(JK)
- ZAETOT=ZAETOT*EXP(-2.*(ZAELOC(JK)*(TPFLYER%XZ_CUR-ZZMZ(JK))))
- ELSE
- ! attenuation from ZAELOC(JK) and ZAELOC(JK+1)
- ZAETOT=ZAETOT*EXP(-2.*(ZAELOC(JK+1)*(TPFLYER%XZ_CUR-.5*(ZZMZ(JK+1)+ZZMZ(JK))) &
- +ZAELOC(JK)*.5*(ZZMZ(JK+1)-ZZMZ(JK))))
- END IF
- ELSE
- ! attenuation from ZAELOC(JK) and ZAELOC(JK+1)
- ZAETOT=ZAETOT*EXP(-(ZAELOC(JK+1)+ZAELOC(JK))*(ZZMZ(JK+1)-ZZMZ(JK)))
- END IF
- TPFLYER%XCRARE_ATT(ISTORE,JK)=TPFLYER%XCRARE(ISTORE,JK)*ZAETOT
- END DO
- ! zenith
- ZAETOT=1.
- DO JK = MAX(COUNT(TPFLYER%XZ_CUR >= ZZMZ(:)),1)+1,IKU
- IF ( JK .EQ. (MAX(COUNT(TPFLYER%XZ_CUR >= ZZMZ(:)),1)+1) ) THEN
- IF(TPFLYER%XZ_CUR>=ZZMZ(JK)-.5*(ZZMZ(JK)-ZZMZ(JK-1))) THEN
- ! only attenuation from ZAELOC(JK)
- ZAETOT=ZAETOT*EXP(-2.*(ZAELOC(JK)*(ZZMZ(JK)-TPFLYER%XZ_CUR)))
- ELSE
- ! attenuation from ZAELOC(JK) and ZAELOC(JK-1)
- ZAETOT=ZAETOT*EXP(-2.*(ZAELOC(JK-1)*(.5*(ZZMZ(JK)+ZZMZ(JK-1))-TPFLYER%XZ_CUR) &
- +ZAELOC(JK)*.5*(ZZMZ(JK)-ZZMZ(JK-1))))
- END IF
- ELSE
- ! attenuation from ZAELOC(JK) and ZAELOC(JK-1)
- ZAETOT=ZAETOT*EXP(-(ZAELOC(JK-1)+ZAELOC(JK))*(ZZMZ(JK)-ZZMZ(JK-1)))
- END IF
- TPFLYER%XCRARE_ATT(ISTORE,JK)=TPFLYER%XCRARE(ISTORE,JK)*ZAETOT
- END DO
-
- TPFLYER%XZZ (ISTORE,:) = ZZMZ(:)
- DEALLOCATE(ZZMZ,ZAELOC)
- ! m^3 → mm^6/m^3 → dBZ
- WHERE(TPFLYER%XCRARE(ISTORE,:)>0)
- TPFLYER%XCRARE(ISTORE,:)=10.*LOG10(1.E18*TPFLYER%XCRARE(ISTORE,:))
- ELSEWHERE
- TPFLYER%XCRARE(ISTORE,:)=XUNDEF
- END WHERE
- WHERE(TPFLYER%XCRARE_ATT(ISTORE,:)>0)
- TPFLYER%XCRARE_ATT(ISTORE,:)=10.*LOG10(1.E18*TPFLYER%XCRARE_ATT(ISTORE,:))
- ELSEWHERE
- TPFLYER%XCRARE_ATT(ISTORE,:)=XUNDEF
- END WHERE
- DEALLOCATE(ZX,ZW,ZRTMIN)
-END IF ! end LOOP ICE3
+
+ZTH_EXN(:,:,:) = PTH(TPFLYER%NI_M:TPFLYER%NI_M+1, TPFLYER%NJ_M:TPFLYER%NJ_M+1, :) * ZEXN(:,:,:)
+ZZ(:) = TPFLYER%INTERP_HOR_FROM_MASSPOINT( ZZM(:,:,:) )
+TPFLYER%XZZ(:,ISTORE) = ZZ(:)
+
+CALL Sensor_wc_compute( TPFLYER, ISTORE, PR, PRHODREF )
+CALL Sensor_rare_compute( TPFLYER, ISTORE, PR, PSV, PRHODREF, PCIT, ZTH_EXN, ZZ, PSEA )
+
! vertical wind
-TPFLYER%XWZ (ISTORE,:) = FLYER_INTERPZ(ZWM(:,:,:))
-IF (SIZE(PTKE)>0) TPFLYER%XTKE (ISTORE) = FLYER_INTERP(PTKE)
-IF (SIZE(PTS) >0) TPFLYER%XTSRAD(ISTORE) = FLYER_INTERP_2D(PTS)
-IF (LDIAG_IN_RUN) TPFLYER%XTKE_DISS(ISTORE) = FLYER_INTERP(XCURRENT_TKE_DISS)
-TPFLYER%XZS(ISTORE) = FLYER_INTERP_2D(PZ(:,:,1+JPVEXT))
-TPFLYER%XTHW_FLUX(ISTORE) = FLYER_INTERP(ZTHW_FLUX)
-TPFLYER%XRCW_FLUX(ISTORE) = FLYER_INTERP(ZRCW_FLUX)
+TPFLYER%XWZ (:,ISTORE) = TPFLYER%INTERP_HOR_FROM_MASSPOINT( ZWM(:,:,:) )
+
+! Dry air density at flyer position
+TPFLYER%XRHOD_SENSOR(ISTORE) = TPFLYER%INTERP_FROM_MASSPOINT( PRHODREF )
+
+IF (SIZE(PTKE)>0) TPFLYER%XTKE (1,ISTORE) = TPFLYER%INTERP_FROM_MASSPOINT( PTKE )
+IF ( CRAD /= 'NONE' ) TPFLYER%XTSRAD(ISTORE) = TPFLYER%INTERP_HOR_FROM_MASSPOINT(PTS )
+TPFLYER%XTKE_DISS(ISTORE) = TPFLYER%INTERP_FROM_MASSPOINT( XCURRENT_TKE_DISS )
+TPFLYER%XZS(ISTORE) = TPFLYER%INTERP_HOR_FROM_MASSPOINT( PZ(:,:,1+JPVEXT) )
+TPFLYER%XTHW_FLUX(ISTORE) = TPFLYER%INTERP_FROM_MASSPOINT( ZTHW_FLUX )
+TPFLYER%XRCW_FLUX(ISTORE) = TPFLYER%INTERP_FROM_MASSPOINT( ZRCW_FLUX )
DO JLOOP=1,SIZE(PSV,4)
-TPFLYER%XSVW_FLUX(ISTORE,JLOOP) = FLYER_INTERP(ZSVW_FLUX(:,:,:,JLOOP))
+TPFLYER%XSVW_FLUX(ISTORE,JLOOP) = TPFLYER%INTERP_FROM_MASSPOINT( ZSVW_FLUX(:,:,:,JLOOP) )
END DO
END SUBROUTINE FLYER_RECORD_DATA
!----------------------------------------------------------------------------
!----------------------------------------------------------------------------
-FUNCTION FLYER_INTERP(PA) RESULT(PB)
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PA
-REAL :: PB
-!
-INTEGER :: JI, JJ
-!
-IF (SIZE(PA,1)==2) THEN
- JI=1
- JJ=1
-ELSE
- JI=II_M
- JJ=IJ_M
-END IF
-!
-PB = (1.- ZYCOEF) * (1.-ZXCOEF) * ( (1.-ZZCOEF00) * PA(JI ,JJ ,IK00) + ZZCOEF00 * PA(JI ,JJ ,IK00+1)) &
- + (1.- ZYCOEF) * ( ZXCOEF) * ( (1.-ZZCOEF10) * PA(JI+1,JJ ,IK10) + ZZCOEF10 * PA(JI+1,JJ ,IK10+1)) &
- + ( ZYCOEF) * (1.-ZXCOEF) * ( (1.-ZZCOEF01) * PA(JI ,JJ+1,IK01) + ZZCOEF01 * PA(JI ,JJ+1,IK01+1)) &
- + ( ZYCOEF) * ( ZXCOEF) * ( (1.-ZZCOEF11) * PA(JI+1,JJ+1,IK11) + ZZCOEF11 * PA(JI+1,JJ+1,IK11+1))
-!
-END FUNCTION FLYER_INTERP
-!----------------------------------------------------------------------------
-!----------------------------------------------------------------------------
-FUNCTION FLYER_INTERPZ(PA) RESULT(PB)
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PA
-REAL, DIMENSION(SIZE(PA,3)) :: PB
-!
-INTEGER :: JI, JJ, JK
-!
-IF (SIZE(PA,1)==2) THEN
- JI=1
- JJ=1
-ELSE
- JI=II_M
- JJ=IJ_M
-END IF
-!
-!
-DO JK=1,SIZE(PA,3)
- IF ( (PA(JI,JJ,JK) /= XUNDEF) .AND. (PA(JI+1,JJ,JK) /= XUNDEF) .AND. &
- (PA(JI,JJ+1,JK) /= XUNDEF) .AND. (PA(JI+1,JJ+1,JK) /= XUNDEF) ) THEN
- PB(JK) = (1.-ZYCOEF) * (1.-ZXCOEF) * PA(JI,JJ,JK) + &
- (1.-ZYCOEF) * (ZXCOEF) * PA(JI+1,JJ,JK) + &
- (ZYCOEF) * (1.-ZXCOEF) * PA(JI,JJ+1,JK) + &
- (ZYCOEF) * (ZXCOEF) * PA(JI+1,JJ+1,JK)
- ELSE
- PB(JK) = XUNDEF
- END IF
-END DO
-!
-END FUNCTION FLYER_INTERPZ
-!----------------------------------------------------------------------------
-FUNCTION FLYER_INTERP_U(PA) RESULT(PB)
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PA
-REAL :: PB
-!
-INTEGER :: JI, JJ
-!
-IF (SIZE(PA,1)==2) THEN
- JI=1
- JJ=1
-ELSE
- JI=II_U
- JJ=IJ_M
-END IF
-!
-PB = (1.- ZYCOEF) * (1.-ZUCOEF) * ( (1.-ZUCOEF00) * PA(JI ,JJ ,IU00) + ZUCOEF00 * PA(JI ,JJ ,IU00+1)) &
- + (1.- ZYCOEF) * ( ZUCOEF) * ( (1.-ZUCOEF10) * PA(JI+1,JJ ,IU10) + ZUCOEF10 * PA(JI+1,JJ ,IU10+1)) &
- + ( ZYCOEF) * (1.-ZUCOEF) * ( (1.-ZUCOEF01) * PA(JI ,JJ+1,IU01) + ZUCOEF01 * PA(JI ,JJ+1,IU01+1)) &
- + ( ZYCOEF) * ( ZUCOEF) * ( (1.-ZUCOEF11) * PA(JI+1,JJ+1,IU11) + ZUCOEF11 * PA(JI+1,JJ+1,IU11+1))
-!
-END FUNCTION FLYER_INTERP_U
-!----------------------------------------------------------------------------
-!----------------------------------------------------------------------------
-FUNCTION FLYER_INTERP_V(PA) RESULT(PB)
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PA
-REAL :: PB
-!
-INTEGER :: JI, JJ
-!
-IF (SIZE(PA,1)==2) THEN
- JI=1
- JJ=1
-ELSE
- JI=II_M
- JJ=IJ_V
-END IF
-!
-PB = (1.- ZVCOEF) * (1.-ZXCOEF) * ( (1.-ZVCOEF00) * PA(JI ,JJ ,IV00) + ZVCOEF00 * PA(JI ,JJ ,IV00+1)) &
- + (1.- ZVCOEF) * ( ZXCOEF) * ( (1.-ZVCOEF10) * PA(JI+1,JJ ,IV10) + ZVCOEF10 * PA(JI+1,JJ ,IV10+1)) &
- + ( ZVCOEF) * (1.-ZXCOEF) * ( (1.-ZVCOEF01) * PA(JI ,JJ+1,IV01) + ZVCOEF01 * PA(JI ,JJ+1,IV01+1)) &
- + ( ZVCOEF) * ( ZXCOEF) * ( (1.-ZVCOEF11) * PA(JI+1,JJ+1,IV11) + ZVCOEF11 * PA(JI+1,JJ+1,IV11+1))
-!
-END FUNCTION FLYER_INTERP_V
-!----------------------------------------------------------------------------
-!----------------------------------------------------------------------------
-FUNCTION FLYER_INTERP_2D(PA) RESULT(PB)
-!
-REAL, DIMENSION(:,:), INTENT(IN) :: PA
-REAL :: PB
-!
-INTEGER :: JI, JJ
-!
-IF (SIZE(PA,1)==2) THEN
- JI=1
- JJ=1
-ELSE
- JI=II_M
- JJ=IJ_M
-END IF
-!
-PB = (1.- ZYCOEF) * (1.-ZXCOEF) * PA(JI ,JJ ) &
- + (1.- ZYCOEF) * ( ZXCOEF) * PA(JI+1,JJ ) &
- + ( ZYCOEF) * (1.-ZXCOEF) * PA(JI ,JJ+1) &
- + ( ZYCOEF) * ( ZXCOEF) * PA(JI+1,JJ+1)
-!
-END FUNCTION FLYER_INTERP_2D
-!----------------------------------------------------------------------------
-
END SUBROUTINE AIRCRAFT_BALLOON_EVOL
!----------------------------------------------------------------------------
!----------------------------------------------------------------------------
@@ -1591,30 +1033,5 @@ END IF
END SUBROUTINE FLYER_GET_RANK_MODEL_ISCRASHED
!----------------------------------------------------------------------------
-!----------------------------------------------------------------------------
-SUBROUTINE FLYER_CHECK_STORESTEP( TPFLYER )
-
-USE MODD_AIRCRAFT_BALLOON, ONLY: TFLYERDATA
-
-USE MODE_STATPROF_TOOLS, ONLY: STATPROF_INSTANT
-
-IMPLICIT NONE
-
-CLASS(TFLYERDATA), INTENT(INOUT) :: TPFLYER ! balloon/aircraft
-
-INTEGER :: ISTORE
-
-!Remark: TPFLYER%TFLYER_TIME%N_CUR and %TPDATES are updated in STATPROF_INSTANT
-CALL STATPROF_INSTANT( TPFLYER%TFLYER_TIME, ISTORE )
-
-IF ( ISTORE < 1 ) THEN
- !No profiler storage at this time step
- TPFLYER%LSTORE = .FALSE.
-ELSE
- TPFLYER%LSTORE = .TRUE.
-END IF
-
-END SUBROUTINE FLYER_CHECK_STORESTEP
-!----------------------------------------------------------------------------
END MODULE MODE_AIRCRAFT_BALLOON_EVOL
diff --git a/src/mesonh/ext/boundaries.f90 b/src/mesonh/ext/boundaries.f90
index 04860f27e0b15748eb3c9d075427d97f3dc803b9..91597d8be0029568c74e22c0888d87487b33b386 100644
--- a/src/mesonh/ext/boundaries.f90
+++ b/src/mesonh/ext/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/mesonh/ext/ch_aqueous_sedim1mom.f90 b/src/mesonh/ext/ch_aqueous_sedim1mom.f90
index ba0b6ffd5418befa08bfb5c44cdb761c3856a448..2ec98324e1bb4f2bb53ad9305abf71bc6548f6a1 100644
--- a/src/mesonh/ext/ch_aqueous_sedim1mom.f90
+++ b/src/mesonh/ext/ch_aqueous_sedim1mom.f90
@@ -89,14 +89,14 @@ END MODULE MODI_CH_AQUEOUS_SEDIM1MOM
!* 0. DECLARATIONS
! ------------
!
-USE MODD_PARAMETERS, ONLY : JPHEXT, JPVEXT
+USE MODD_PARAMETERS, ONLY: JPHEXT, JPVEXT
USE MODD_CONF
-USE MODD_CST, ONLY : XRHOLW
-USE MODD_CLOUDPAR, ONLY : VCEXVT=>XCEXVT, XCRS, XCEXRS
-USE MODD_RAIN_ICE_DESCR_n, ONLY : WCEXVT=>XCEXVT, WRTMIN=>XRTMIN
-USE MODD_RAIN_ICE_PARAM_n, ONLY : XFSEDR, XEXSEDR, &
- XFSEDS, XEXSEDS, &
- XFSEDG, XEXSEDG
+USE MODD_CST, ONLY: XRHOLW
+USE MODD_CLOUDPAR, ONLY: VCEXVT=>XCEXVT, XCRS, XCEXRS
+USE MODD_RAIN_ICE_DESCR_n, ONLY: WCEXVT=>XCEXVT, WRTMIN=>XRTMIN
+USE MODD_RAIN_ICE_PARAM_n, ONLY: XFSEDR, XEXSEDR, &
+ XFSEDS, XEXSEDS, &
+ XFSEDG, XEXSEDG
use mode_tools, only: Countjv
use mode_tools_ll, only: GET_INDICE_ll
diff --git a/src/mesonh/ext/ch_meteo_trans_kess.f90 b/src/mesonh/ext/ch_meteo_trans_kess.f90
index debd6ae61a8107d41da8ba5870e267cb73c5a0d1..36d216d7d1a0335fd7dcafc838e1fbf809622ee8 100644
--- a/src/mesonh/ext/ch_meteo_trans_kess.f90
+++ b/src/mesonh/ext/ch_meteo_trans_kess.f90
@@ -117,11 +117,11 @@ USE MODD_CST, ONLY: XP00, & ! Surface pressure
!!
USE MODD_CONF, ONLY: LCARTESIAN ! Logical for cartesian geometry
!!
-USE MODD_RAIN_ICE_DESCR_n, ONLY: XNUC, XALPHAC, & !Cloud droplets distrib. param.
- XRTMIN, & ! min values of the water m. r.
- XLBC, XLBEXC, & !shape param. of the cloud droplets
- XLBR, XLBEXR, & !shape param. of the raindrops
- XCONC_LAND
+USE MODD_RAIN_ICE_DESCR_n, ONLY: XNUC, XALPHAC, & !Cloud droplets distrib. param.
+ XRTMIN, & ! min values of the water m. r.
+ XLBC, XLBEXC, & !shape param. of the cloud droplets
+ XLBR, XLBEXR, & !shape param. of the raindrops
+ XCONC_LAND
!!
use mode_msg
diff --git a/src/mesonh/ext/default_desfmn.f90 b/src/mesonh/ext/default_desfmn.f90
index 9218ccad73d8db5c0d5f36bc6fb81951ca1d8324..b373a74ee01218db1dcb940d3bffdadc54cc8e1b 100644
--- a/src/mesonh/ext/default_desfmn.f90
+++ b/src/mesonh/ext/default_desfmn.f90
@@ -219,6 +219,7 @@ END MODULE MODI_DEFAULT_DESFM_n
! Q. Rodier 06/2021: modify default value to LGZ=F (grey-zone corr.), LSEDI and OSEDC=T (LIMA sedimentation)
! F. Couvreux 06/2021: add LRELAX_UVMEAN_FRC
! Q. Rodier 07/2021: modify XPOND=1
+! R. Schoetter 12/2021: multi-level coupling between MesoNH and SURFEX
! A. Costes 12/2021: Blaze fire model
! C. Barthe 03/2022: add CIBU and RDSF options in LIMA
! Delbeke/Vie 03/2022: KHKO option in LIMA
@@ -272,6 +273,7 @@ USE MODD_CONDSAMP
USE MODD_MEAN_FIELD
USE MODD_DRAGTREE_n
USE MODD_DRAGBLDG_n
+USE MODD_COUPLING_LEVELS_n
USE MODD_EOL_MAIN
USE MODD_EOL_ADNR
USE MODD_EOL_ALM
@@ -292,6 +294,7 @@ USE MODD_IBM_LSF
USE MODD_FOREFIRE
#endif
USE MODD_FIRE_n
+USE MODD_IO, ONLY: TFILEDATA
!
IMPLICIT NONE
!
@@ -302,6 +305,7 @@ INTEGER, INTENT(IN) :: KMI ! Model index
!* 0.2 declaration of local variables
!
INTEGER :: JM ! loop index
+TYPE(TFILEDATA) TFILENAM ! Empty file to satisfy interface of PHYEX_init routines which may calls POSNAM (but do not)
!
!-------------------------------------------------------------------------------
!
@@ -514,14 +518,14 @@ XTNUDGING = 21600.
!* 10. SET DEFAULT VALUES FOR MODD_TURB_n :
! ----------------------------------
!
-CALL TURBN_INIT(CPROGRAM, 0, .FALSE., TLUOUT%NLU, &
+CALL TURBN_INIT(CPROGRAM, TFILENAM, .FALSE., TLUOUT%NLU, &
&LDDEFAULTVAL=.TRUE., LDREADNAM=.FALSE., LDCHECK=.FALSE., KPRINT=0)
!-------------------------------------------------------------------------------
!
!* 10a. SET DEFAULT VALUES FOR MODD_NEB_n :
! ----------------------------------
!
-CALL NEBN_INIT(CPROGRAM, 0, .FALSE., TLUOUT%NLU, &
+CALL NEBN_INIT(CPROGRAM, TFILENAM, .FALSE., TLUOUT%NLU, &
&LDDEFAULTVAL=.TRUE., LDREADNAM=.FALSE., LDCHECK=.FALSE., KPRINT=0)
!-------------------------------------------------------------------------------
!
@@ -533,6 +537,19 @@ LDEPOTREE = .FALSE.
XVDEPOTREE = 0.02 ! 2 cm/s
!------------------------------------------------------------------------------
!
+!* 10b. SET DEFAULT VALUES FOR MODD_DRAGBLDG_n :
+! ----------------------------------
+!
+LDRAGBLDG = .FALSE.
+LFLUXBLDG = .FALSE.
+LDRAGURBVEG = .FALSE.
+!
+!* 10c. SET DEFAULT VALUES FOR MODD_COUPLING_LEVELS_n :
+! ----------------------------------
+!
+NLEV_COUPLE = 1
+!------------------------------------------------------------------------------
+!
!* 10c. SET DEFAULT VALUES FOR MODD_DRAGB
! ----------------------------------
!
@@ -577,7 +594,7 @@ XLAT_PROF(:) = XUNDEF
XLON_PROF(:) = XUNDEF
CNAME_PROF(:) = ''
CFILE_PROF = 'NO_INPUT_CSV'
-! LDIAG_SURFRAD = .TRUE.
+LDIAG_SURFRAD_PROF = .TRUE.
!------------------------------------------------------------------------------
!* 10.f SET DEFAULT VALUES FOR MODD_ALLSTATION_n :
! ----------------------------------
@@ -591,7 +608,7 @@ XLAT_STAT(:) = XUNDEF
XLON_STAT(:) = XUNDEF
CNAME_STAT(:) = ''
CFILE_STAT = 'NO_INPUT_CSV'
-LDIAG_SURFRAD = .TRUE.
+LDIAG_SURFRAD_STAT = .TRUE.
!
!-------------------------------------------------------------------------------
!
@@ -828,7 +845,7 @@ END IF
!* 16. SET DEFAULT VALUES FOR MODD_PARAM_ICE :
! ---------------------------------------
!
-CALL PARAM_ICEN_INIT(CPROGRAM, 0, .FALSE., TLUOUT%NLU, &
+CALL PARAM_ICEN_INIT(CPROGRAM, TFILENAM, .FALSE., TLUOUT%NLU, &
&LDDEFAULTVAL=.TRUE., LDREADNAM=.FALSE., LDCHECK=.FALSE., KPRINT=0)
!
!-------------------------------------------------------------------------------
@@ -854,7 +871,7 @@ NENSM = 0
!* 18. SET DEFAULT VALUES FOR MODD_PARAM_MFSHALL_n :
! --------------------------------------------
!
-CALL PARAM_MFSHALLN_INIT(CPROGRAM, 0, .FALSE., TLUOUT%NLU, &
+CALL PARAM_MFSHALLN_INIT(CPROGRAM, TFILENAM, .FALSE., TLUOUT%NLU, &
&LDDEFAULTVAL=.TRUE., LDREADNAM=.FALSE., LDCHECK=.FALSE., KPRINT=0)
!
!-------------------------------------------------------------------------------
@@ -900,7 +917,7 @@ ENDIF
! ----------------------------------------
!
IF (KMI == 1) THEN
- CALL PARAM_LIMA_INIT(CPROGRAM, 0, .FALSE., TLUOUT%NLU, &
+ CALL PARAM_LIMA_INIT(CPROGRAM, TFILENAM, .FALSE., TLUOUT%NLU, &
&LDDEFAULTVAL=.TRUE., LDREADNAM=.FALSE., LDCHECK=.FALSE., KPRINT=0)
ENDIF
!
@@ -919,7 +936,7 @@ LCH_PH = .FALSE.
LCH_RET_ICE = .FALSE.
XCH_PHINIT = 5.2
XRTMIN_AQ = 5.e-8
-CCHEM_INPUT_FILE = 'EXSEG1.nam'
+CCHEM_INPUT_FILE = 'MNHC.input'
CCH_TDISCRETIZATION = 'SPLIT'
NCH_SUBSTEPS = 1
LCH_TUV_ONLINE = .FALSE.
@@ -987,8 +1004,8 @@ LHETEROSO4 = .FALSE. ! switch to active sulfates heteronegeous
! production
LSEDIMAERO = .FALSE. ! switch to active aerosol sedimentation
LAERINIT = .FALSE. ! switch to initialize aerosol in arome
-CMINERAL = "NONE" ! mineral equilibrium scheme
-CORGANIC = "NONE" ! mineral equilibrium scheme
+CMINERAL = "EQSAM" ! mineral equilibrium scheme
+CORGANIC = "MPMPO" ! mineral equilibrium scheme
CNUCLEATION = "NONE" ! sulfates nucleation scheme
LDEPOS_AER(:) = .FALSE.
diff --git a/src/mesonh/ext/endstep.f90 b/src/mesonh/ext/endstep.f90
index 97734d72bd8ecad1aa8e4163c203fbfe7ab5fe57..2ef63e81747dce52a37f28086a6771ae3f50ec4d 100644
--- a/src/mesonh/ext/endstep.f90
+++ b/src/mesonh/ext/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
@@ -207,7 +208,6 @@ use modd_budget, only: lbudget_u, lbudget_v, lbudget_w, lbudget_th, lbudg
nbustep, tbudgets
USE MODD_CH_AEROSOL, ONLY: LORILAM
USE MODD_CONF
-USE MODD_TURB_n, ONLY: XTKEMIN
USE MODD_DUST, ONLY: LDUST
USE MODD_SALT, ONLY: LSALT
USE MODD_DYN
@@ -217,9 +217,11 @@ 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
+USE MODD_TURB_n, ONLY: XTKEMIN
use mode_budget, only: Budget_store_end, Budget_store_init
@@ -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/mesonh/ext/flash_geom_elec.f90 b/src/mesonh/ext/flash_geom_elec.f90
index e6eea2d03c113ae02451da51869d6ce8c6da983f..0155cc83229aef1ae7e39c274a7abc94ccdc24f4 100644
--- a/src/mesonh/ext/flash_geom_elec.f90
+++ b/src/mesonh/ext/flash_geom_elec.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 2010-2022 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2010-2023 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,37 +109,43 @@ 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
! ------------
!
-USE MODD_ARGSLIST_ll, ONLY: LIST_ll
-USE MODD_CONF, ONLY: CEXP, LCARTESIAN
-USE MODD_CST, ONLY: XAVOGADRO, XMD
-USE MODD_DYN_n, ONLY: XDXHATM, XDYHATM, NSTOP
+USE MODD_ARGSLIST_ll, ONLY: LIST_ll
+USE MODD_CONF, ONLY: CEXP, LCARTESIAN
+USE MODD_CST, ONLY: XAVOGADRO, XMD
+USE MODD_DYN_n, ONLY: XDXHATM, XDYHATM, NSTOP
USE MODD_ELEC_DESCR
USE MODD_ELEC_FLASH
-USE MODD_ELEC_PARAM, ONLY: XFQLIGHTR, XEXQLIGHTR, &
- XFQLIGHTI, XEXQLIGHTI, &
- XFQLIGHTS, XEXQLIGHTS, &
- XFQLIGHTG, XEXQLIGHTG, &
- XFQLIGHTH, XEXQLIGHTH, &
- XFQLIGHTC
-USE MODD_GRID, ONLY: XLATORI,XLONORI
-USE MODD_GRID_n, ONLY: XXHATM, XYHATM, XZHAT
-USE MODD_IO, ONLY: TFILEDATA
+USE MODD_ELEC_PARAM, ONLY: XFQLIGHTR, XEXQLIGHTR, &
+ XFQLIGHTI, XEXQLIGHTI, &
+ XFQLIGHTS, XEXQLIGHTS, &
+ XFQLIGHTG, XEXQLIGHTG, &
+ XFQLIGHTH, XEXQLIGHTH, &
+ XFQLIGHTC
+USE MODD_GRID, ONLY: XLATORI,XLONORI
+USE MODD_GRID_n, ONLY: XXHATM, XYHATM, XZHAT
+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_METRICS_n, ONLY: XDXX, XDYY, XDZZ ! in linox_production
+USE MODD_NSV, ONLY: NSV_ELECBEG, NSV_ELECEND, NSV_ELEC
+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
+USE MODD_VAR_ll, ONLY: NPROC,NMNH_COMM_WORLD
!
USE MODE_ELEC_ll
USE MODE_GRIDPROJ
@@ -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/mesonh/ext/goto_model_wrapper.f90 b/src/mesonh/ext/goto_model_wrapper.f90
index b09f1e3fd7c811b0676753fb95e6c8129548fb87..84e5c72c63e9524a6912e95cff99e24ab3c0ff57 100644
--- a/src/mesonh/ext/goto_model_wrapper.f90
+++ b/src/mesonh/ext/goto_model_wrapper.f90
@@ -18,6 +18,7 @@
! 11/2019 C.Lac correction in the drag formula and application to building in addition to tree
! F. Auguste 02/21: add IBM
! T. Nagel 02/21: add turbulence recycling
+! R. Schoetter 12/2021: multi-level coupling between MesoNH and SURFEX
! P. Wautelet 27/04/2022: add namelist for profilers
! P. Wautelet 10/02/2023: add Blaze variables
!-----------------------------------------------------------------
@@ -53,12 +54,9 @@ USE MODD_CH_PRODLOSSTOT_n
USE MODD_CH_ROSENBROCK_n
USE MODD_CH_SOLVER_n
USE MODD_CLOUDPAR_n
-USE MODD_PARAM_ICE_n
-USE MODD_PARAM_LIMA, ONLY: PARAM_LIMA_ASSOCIATE !not yet a '_n' module
-USE MODD_RAIN_ICE_PARAM_n
-USE MODD_RAIN_ICE_DESCR_n
USE MODD_CLOUD_MF_n
USE MODD_CONF_n
+USE MODD_COUPLING_LEVELS_n
USE MODD_CURVCOR_n
USE MODD_DIM_n
USE MODD_DRAG_n
@@ -85,11 +83,14 @@ USE MODD_LSFIELD_n
USE MODD_LUNIT_n
USE MODD_MEAN_FIELD_n
USE MODD_METRICS_n
+USE MODD_NEB_n, ONLY: NEB_GOTO_MODEL
USE MODD_NEST_PGD_n
USE MODD_NUDGING_n
USE MODD_OUT_n
USE MODD_PACK_GR_FIELD_n
+USE MODD_PARAM_ICE_n
USE MODD_PARAM_KAFR_n
+USE MODD_PARAM_LIMA, ONLY: PARAM_LIMA_ASSOCIATE !not yet a '_n' module
USE MODD_PARAM_MFSHALL_n
USE MODD_PARAM_n
USE MODD_PARAM_RAD_n
@@ -99,6 +100,8 @@ USE MODD_PAST_FIELD_n
USE MODD_PRECIP_n
USE MODD_PROFILER_n
USE MODD_RADIATIONS_n
+USE MODD_RAIN_ICE_DESCR_n
+USE MODD_RAIN_ICE_PARAM_n
USE MODD_RBK90_Global_n
USE MODD_RBK90_JacobianSP_n
USE MODD_RBK90_Parameters_n
@@ -117,7 +120,6 @@ USE MODD_SUB_PASPOL_n
USE MODD_SUB_PHYS_PARAM_n
USE MODD_TIMEZ
USE MODD_TURB_n
-USE MODD_NEB_n, ONLY: NEB_GOTO_MODEL
!
!
use mode_field, only: Fieldlist_goto_model
@@ -163,6 +165,7 @@ CALL CURVCOR_GOTO_MODEL(KFROM, KTO)
CALL DIM_GOTO_MODEL(KFROM, KTO)
CALL DRAGTREE_GOTO_MODEL(KFROM, KTO)
CALL DRAGBLDG_GOTO_MODEL(KFROM, KTO)
+CALL COUPLING_MULT_GOTO_MODEL(KFROM, KTO)
CALL DUMMY_GR_FIELD_GOTO_MODEL(KFROM, KTO)
CALL DYN_GOTO_MODEL(KFROM, KTO)
CALL DYNZD_GOTO_MODEL(KFROM,KTO)
diff --git a/src/mesonh/ext/ground_paramn.f90 b/src/mesonh/ext/ground_paramn.f90
index 39b041f029d5530d188328c3dd9ae9518ba2271d..8afc481ce2f719f36a222a269b361c58f640b02c 100644
--- a/src/mesonh/ext/ground_paramn.f90
+++ b/src/mesonh/ext/ground_paramn.f90
@@ -9,10 +9,12 @@ MODULE MODI_GROUND_PARAM_n
!
INTERFACE
!
- SUBROUTINE GROUND_PARAM_n(D, PSFTH, PSFRV, PSFSV, PSFCO2, PSFU, PSFV, &
- PDIR_ALB, PSCA_ALB, PEMIS, PTSRAD, KTCOUNT, TPFILE )
+ SUBROUTINE GROUND_PARAM_n(D, PSFTH, PSFTH_WALL, PSFTH_ROOF, PCD_ROOF, PSFRV, PSFRV_WALL, &
+ PSFRV_ROOF, PSFSV, PSFCO2, PSFU, PSFV, PDIR_ALB, PSCA_ALB, &
+ PEMIS, PTSRAD, KTCOUNT, TPFILE )
!
USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+!
!* surface fluxes
! --------------
!
@@ -20,8 +22,13 @@ USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
USE MODD_IO, ONLY: TFILEDATA
!
TYPE(DIMPHYEX_t), INTENT(IN) :: D
-REAL, DIMENSION(:,:), INTENT(OUT) :: PSFTH ! surface flux of potential temperature (Km/s)
-REAL, DIMENSION(:,:), INTENT(OUT) :: PSFRV ! surface flux of water vapor (m/s*kg/kg)
+REAL, DIMENSION(:,:), INTENT(OUT) :: PSFTH ! Total surface flux of potential temperature (Km/s)
+REAL, DIMENSION(:,:), INTENT(OUT) :: PSFTH_WALL ! Wall surface flux of potential temperature (Km/s)
+REAL, DIMENSION(:,:), INTENT(OUT) :: PSFTH_ROOF ! Roof surface flux of potential temperature (Km/s)
+REAL, DIMENSION(:,:), INTENT(OUT) :: PCD_ROOF ! Drag coefficient for roofs (-)
+REAL, DIMENSION(:,:), INTENT(OUT) :: PSFRV ! Total surface flux of water vapor (m/s*kg/kg)
+REAL, DIMENSION(:,:), INTENT(OUT) :: PSFRV_WALL ! Wall surface flux of water vapor (m/s*kg/kg)
+REAL, DIMENSION(:,:), INTENT(OUT) :: PSFRV_ROOF ! Roof surface flux of water vapor (m/s*kg/kg)
REAL, DIMENSION(:,:,:),INTENT(OUT):: PSFSV ! surface flux of scalar (m/s*kg/kg)
! flux of chemical var. (ppv.m/s)
REAL, DIMENSION(:,:), INTENT(OUT) :: PSFCO2! surface flux of CO2 (m/s*kg/kg)
@@ -44,9 +51,11 @@ END INTERFACE
!
END MODULE MODI_GROUND_PARAM_n
!
- SUBROUTINE GROUND_PARAM_n(D, PSFTH, PSFRV, PSFSV, PSFCO2, PSFU, PSFV, &
- PDIR_ALB, PSCA_ALB, PEMIS, PTSRAD, KTCOUNT, TPFILE )
-! ###############################################################################
+! ######################################################################
+ SUBROUTINE GROUND_PARAM_n(D, PSFTH, PSFTH_WALL, PSFTH_ROOF, PCD_ROOF, PSFRV, &
+ PSFRV_WALL, PSFRV_ROOF, PSFSV, PSFCO2, PSFU, &
+ PSFV, PDIR_ALB, PSCA_ALB, PEMIS, PTSRAD, KTCOUNT, TPFILE )
+! #######################################################################
!
!
!!**** *GROUND_PARAM*
@@ -117,6 +126,7 @@ END MODULE MODI_GROUND_PARAM_n
!! (V. Vionnet) 18/07/2017 add coupling for blowing snow module
!! (Bielli S.) 02/2019 Sea salt : significant sea wave height influences salt emission; 5 salt modes
! P. Wautelet 20/05/2019: add name argument to ADDnFIELD_ll + new ADD4DFIELD_ll subroutine
+! R. Schoetter 12/2021: multi-level coupling between MesoNH and SURFEX
! A. Costes 12/2021: Blaze Fire model
! P. Wautelet 09/02/2022: bugfix: add missing XCURRENT_LEI computation
! P. Wautelet 30/09/2022: bugfix: missing communications for SWDIFF, SWDIR and LEI
@@ -127,103 +137,108 @@ END MODULE MODI_GROUND_PARAM_n
!* 0. DECLARATIONS
! ------------
!
-!
+USE MODD_ALLPROFILER_n, ONLY: LDIAG_SURFRAD_PROF
+USE MODD_ALLSTATION_n, ONLY: LDIAG_SURFRAD_STAT
+USE MODD_ARGSLIST_ll, ONLY: LIST_ll
+USE MODD_BLOWSNOW, ONLY: LBLOWSNOW, NBLOWSNOW_2D, YPBLOWSNOW_2D
+USE MODD_BLOWSNOW_n, ONLY: XRSNWCANOS
+USE MODD_BUDGET, ONLY: LBUDGET_TH, LBUDGET_RV, NBUDGET_RV, NBUDGET_TH, TBUDGETS
+USE MODD_CH_AEROSOL, ONLY: LORILAM
+USE MODD_CH_FLX_n, ONLY: XCHFLX
+USE MODD_CH_MNHC_n, ONLY: LUSECHEM
+USE MODD_CONF, ONLY: CPROGRAM, LCARTESIAN, NHALO, NVERB
+USE MODD_CONF_n, ONLY: NRR
+USE MODD_COUPLING_LEVELS_n
+USE MODD_CST, ONLY: XP00, XCPD, XRD, XRV, XRHOLW, XDAY, XPI, XMD, XAVOGADRO
+USE MODD_CSTS_DUST, ONLY: XMOLARWEIGHT_DUST
+USE MODD_CSTS_SALT, ONLY: XMOLARWEIGHT_SALT
+USE MODD_DEEP_CONVECTION_n, ONLY: XPRCONV, XPRSCONV
+USE MODD_DRAGBLDG_n, ONLY: LFLUXBLDG
+USE MODD_DIAG_FLAG, ONLY: LCHEMDIAG
+USE MODD_DIAG_IN_RUN
+USE MODD_DIM_n, ONLY: NKMAX
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+USE MODD_DUST, ONLY: LDUST
+USE MODD_DYN_n, ONLY: XTSTEP
+USE MODD_FIELD_n, ONLY: XUT, XVT, XWT, XTHT, XRT, XPABST, XSVT, XTKET, XZWS, XRTHS, XRRS
+USE MODD_FIRE_n, ONLY: XLSPHI, XBMAP, XFMR0, XFMRFA, XFMWF0, XFMR00, XFMIGNITION, XFMFUELTYPE, &
+ XFIRETAU, XFLUXPARAMH, XFLUXPARAMW, XFIRERW, XFMASE, XFMAWC, XFMWALKIG, &
+ XFMFLUXHDH, XFMFLUXHDW, XFMHWS, XFMWINDU, XFMWINDV, XFMWINDW, XGRADLSPHIX, &
+ XGRADLSPHIY, XFIREWIND, XFMGRADOROX, XFMGRADOROY
+USE MODD_GRID, ONLY: XLON0, XRPK, XBETA
+USE MODD_GRID_n, ONLY: XLON, XZZ, XDIRCOSXW, XDIRCOSYW, XDIRCOSZW, &
+ XCOSSLOPE, XSINSLOPE, XZS
+USE MODD_IO, ONLY: TFILEDATA
+USE MODD_LUNIT_n, ONLY: TLUOUT
+USE MODD_METRICS_n, ONLY: XDXX, XDYY, XDZZ
+USE MODD_MNH_SURFEX_n, ONLY: YSURF_CUR
+USE MODD_NSV, ONLY: CSV, NSV, NSV_AERBEG, NSV_AEREND, NSV_CHEMBEG, NSV_CHEMEND, NSV_DSTBEG, NSV_DSTEND, &
+ NSV_SLTBEG, NSV_SLTEND, NSV_SNWBEG, NSV_SNWEND
+USE MODD_PARAM_C2R2, ONLY: LSEDC
+USE MODD_PARAMETERS, ONLY: JPVEXT
+USE MODD_PARAM_ICE_n, ONLY: LSEDIC
+USE MODD_PARAM_LIMA, ONLY: MSEDC=>LSEDC
+USE MODD_PARAM_n, ONLY: CDCONV, CCLOUD, CRAD, CTURB
+USE MODD_PRECIP_n, ONLY: XINPRC, XINPRR, XINPRS, XINPRG, XINPRH
+USE MODD_PRECISION, ONLY: MNHTIME
+USE MODD_PREP_SNOW, ONLY: NIMPUR
+USE MODD_PROFILER_n, ONLY: LPROFILER
+USE MODD_RADIATIONS_n, ONLY: XFLALWD, XCCO2, XTSIDER, &
+ XSW_BANDS, XDIRSRFSWD, XSCAFLASWD, &
+ XZENITH, XAZIM, XAER, XSWU, XLWU
+USE MODD_REF_n, ONLY: XEXNREF, XRHODREF, XRHODJ
+USE MODD_SALT, ONLY: LSALT
+USE MODD_STATION_n, ONLY: LSTATION
+USE MODD_SURF_PAR, ONLY: XUNDEF_SFX => XUNDEF
+USE MODD_TIME, ONLY: TDTSEG
+USE MODD_TIME_n, ONLY: TDTCUR
#ifdef CPLOASIS
-USE MODI_GET_HALO
-USE MODI_MNH_OASIS_RECV
-USE MODI_MNH_OASIS_SEND
-USE MODD_SFX_OASIS, ONLY : LOASIS
-USE MODD_DYN, ONLY : XSEGLEN
-USE MODD_DYN_n, ONLY : DYN_MODEL
+USE MODD_SFX_OASIS, ONLY: LOASIS
+USE MODD_DYN, ONLY: XSEGLEN
+USE MODD_DYN_n, ONLY: DYN_MODEL
#endif
-!
-USE MODD_LUNIT_n, ONLY: TLUOUT
-USE MODD_BUDGET, ONLY: LBUDGET_TH, LBUDGET_RV, NBUDGET_RV, NBUDGET_TH,TBUDGETS
-USE MODE_BUDGET, ONLY: BUDGET_STORE_INIT, BUDGET_STORE_END
-USE MODD_CST, ONLY : XP00, XCPD, XRD, XRV,XRHOLW, XDAY, XPI, XLVTT, XMD, XAVOGADRO
-USE MODD_DIMPHYEX, ONLY : DIMPHYEX_t
-USE MODD_PARAMETERS, ONLY : JPVEXT
-USE MODD_DYN_n, ONLY : XTSTEP
-USE MODD_CH_MNHC_n, ONLY : LUSECHEM
-USE MODD_FIELD_n, ONLY : XUT, XVT, XWT, XTHT, XRT, XPABST, XSVT, XTKET, XZWS, XRTHS, XRRS
-USE MODD_FIRE_n, ONLY : XLSPHI, XBMAP, XFMR0, XFMRFA, XFMWF0, XFMR00, XFMIGNITION, XFMFUELTYPE, &
- XFIRETAU, XFLUXPARAMH, XFLUXPARAMW, XFIRERW, XFMASE, XFMAWC, XFMWALKIG, &
- XFMFLUXHDH, XFMFLUXHDW, XFMHWS, XFMWINDU, XFMWINDV, XFMWINDW, XGRADLSPHIX, &
- XGRADLSPHIY, XFIREWIND, XFMGRADOROX, XFMGRADOROY
-USE MODD_METRICS_n, ONLY : XDXX, XDYY, XDZZ
-USE MODD_DIM_n, ONLY : NKMAX
-USE MODD_GRID_n, ONLY : XLON, XZZ, XDIRCOSXW, XDIRCOSYW, XDIRCOSZW, &
- XCOSSLOPE, XSINSLOPE, XZS
-USE MODD_REF_n, ONLY : XEXNREF, XRHODREF, XRHODJ
-USE MODD_CONF_n, ONLY : NRR
-USE MODD_PARAM_n, ONLY : CDCONV,CCLOUD, CRAD
-USE MODD_PRECIP_n, ONLY : XINPRC, XINPRR, XINPRS, XINPRG, XINPRH
-USE MODD_DEEP_CONVECTION_n, ONLY : XPRCONV, XPRSCONV
-USE MODD_CONF, ONLY : LCARTESIAN, CPROGRAM
-USE MODD_TIME_n, ONLY : TDTCUR
-USE MODD_RADIATIONS_n, ONLY : XFLALWD, XCCO2, XTSIDER, &
- XSW_BANDS, XDIRSRFSWD, XSCAFLASWD, &
- XZENITH, XAZIM, XAER, XSWU, XLWU
-USE MODD_NSV
-USE MODD_GRID, ONLY : XLON0, XRPK, XBETA
-USE MODD_PARAM_ICE_n, ONLY : LSEDIC
-USE MODD_PARAM_C2R2, ONLY : LSEDC
-USE MODD_DIAG_IN_RUN
-USE MODD_DUST, ONLY : LDUST
-USE MODD_SALT, ONLY : LSALT
-USE MODD_BLOWSNOW
-USE MODD_BLOWSNOW_n
-USE MODD_CH_AEROSOL, ONLY : LORILAM
-USE MODD_CSTS_DUST, ONLY : XMOLARWEIGHT_DUST
-USE MODD_CSTS_SALT, ONLY : XMOLARWEIGHT_SALT
-USE MODD_CH_FLX_n, ONLY : XCHFLX
-USE MODD_DIAG_FLAG, ONLY : LCHEMDIAG
-USE MODD_SURF_PAR, ONLY: XUNDEF_SFX => XUNDEF
-USE MODD_PRECISION, ONLY: MNHTIME
-!
-USE MODI_NORMAL_INTERPOL
-USE MODE_ROTATE_WIND, ONLY: ROTATE_WIND
-USE MODI_SHUMAN
-USE MODI_MNHGET_SURF_PARAM_n
-USE MODI_COUPLING_SURF_ATM_n
-USE MODI_DIAG_SURF_ATM_n
-USE MODD_MNH_SURFEX_n
-!
-USE MODE_DATETIME
-USE MODE_ll
-USE MODD_ARGSLIST_ll, ONLY : LIST_ll
#ifdef MNH_FOREFIRE
-!** MODULES FOR FOREFIRE **!
USE MODD_FOREFIRE
USE MODD_FOREFIRE_n
-USE MODI_COUPLING_FOREFIRE_n
#endif
-!
-USE MODD_TIME_n
-USE MODD_TIME
-!
-USE MODD_PARAM_LIMA, ONLY : MSEDC=>LSEDC
-!
-USE MODD_FIRE_n
-USE MODD_FIELD
+
+USE MODE_BUDGET, ONLY: BUDGET_STORE_INIT, BUDGET_STORE_END
+USE MODE_DATETIME
USE MODE_FIRE_MODEL
-USE MODD_CONF, ONLY : NVERB, NHALO
-USE MODE_MNH_TIMING, ONLY : SECOND_MNH2
+USE MODE_ll
+USE MODE_MNH_TIMING, ONLY: SECOND_MNH2
USE MODE_MSG
-USE MODD_IO, ONLY: TFILEDATA
+USE MODE_ROTATE_WIND, ONLY: ROTATE_WIND
+
+USE MODI_COUPLING_SURF_ATM_n
+USE MODI_DIAG_SURF_ATM_n
+USE MODI_MNHGET_SURF_PARAM_n
+USE MODI_NORMAL_INTERPOL
+USE MODI_SHUMAN
+#ifdef CPLOASIS
+USE MODI_GET_HALO
+USE MODI_MNH_OASIS_RECV
+USE MODI_MNH_OASIS_SEND
+#endif
+#ifdef MNH_FOREFIRE
+USE MODI_COUPLING_FOREFIRE_n
+#endif
!
IMPLICIT NONE
!
-!
-!
!* 0.1 declarations of arguments
!
!* surface fluxes
! --------------
!
TYPE(DIMPHYEX_t), INTENT(IN) :: D
-REAL, DIMENSION(:,:), INTENT(OUT) :: PSFTH ! surface flux of potential temperature (Km/s)
-REAL, DIMENSION(:,:), INTENT(OUT) :: PSFRV ! surface flux of water vapor (m/s*kg/kg)
+REAL, DIMENSION(:,:), INTENT(OUT) :: PSFTH ! Total surface flux of potential temperature (Km/s)
+REAL, DIMENSION(:,:), INTENT(OUT) :: PSFTH_WALL ! Wall surface flux of potential temperature (Km/s)
+REAL, DIMENSION(:,:), INTENT(OUT) :: PSFTH_ROOF ! Roof surface flux of potential temperature (Km/s)
+REAL, DIMENSION(:,:), INTENT(OUT) :: PCD_ROOF ! Drag coefficient for roofs (-)
+REAL, DIMENSION(:,:), INTENT(OUT) :: PSFRV ! Total surface flux of water vapor (m/s*kg/kg)
+REAL, DIMENSION(:,:), INTENT(OUT) :: PSFRV_WALL ! Wall surface flux of water vapor (m/s*kg/kg)
+REAL, DIMENSION(:,:), INTENT(OUT) :: PSFRV_ROOF ! Roof surface flux of water vapor (m/s*kg/kg)
REAL, DIMENSION(:,:,:),INTENT(OUT):: PSFSV ! surface flux of scalar (m/s*kg/kg)
! flux of chemical var. (ppv.m/s)
REAL, DIMENSION(:,:), INTENT(OUT) :: PSFCO2! surface flux of CO2 (m/s*kg/kg)
@@ -256,46 +271,65 @@ REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRV ! vapor mixing ratio
!
! suffix 'A' stands for atmospheric variable at first model level
!
-REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZZREF ! Forcing height
-REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZTA ! Temperature
-REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZRVA ! vapor mixing ratio
-REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZQA ! humidity (kg/m3)
-REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZPA ! Pressure
-REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZPS ! Pressure
-REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZEXNA ! Exner function
-REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZEXNS ! Exner function
-REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZTHA ! potential temperature
REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZRAIN ! liquid precipitation (kg/m2/s)
REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZSNOW ! solid precipitation (kg/m2/s)
REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZTSUN ! solar time (s since midnight)
-!
-REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZUA ! u component of the wind
-! ! parallel to the orography
-REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZVA ! v component of the wind
-! ! parallel to the orography
-REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZU ! zonal wind
-REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZV ! meridian wind
-REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZWIND ! wind parallel to the orography
-REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZRHOA ! air density
-REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZDIR ! wind direction (rad from N clockwise)
-REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZSFU ! zonal momentum flux
-REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZSFV ! meridian momentum flux
+REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZPS ! Surface pressure
+REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZEXNS ! Surface Exner function
REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZCO2 ! CO2 concentration (kg/kg)
-REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZALFA ! angle between the wind
-! ! and the x axis
-REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2),1):: ZU2D ! u and v component of the
-REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2),1):: ZV2D ! wind at mass point
-REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZSFTH ! Turbulent flux of heat
-REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZSFTQ ! Turbulent flux of water
-REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZSFCO2 ! Turbulent flux of CO2
-REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2),NSV):: ZSFTS! Turbulent flux of scalar
!
+! Variables for which multiple levels are sent to SURFEX and related ancilliary variables
+!
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZZREF ! Forcing height
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTA ! Temperature
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRVA ! vapor mixing ratio
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZQA ! humidity (kg/m3)
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZPA ! Pressure
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZEXNA ! Exner function
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTHA ! potential temperature
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZUA ! u component of the wind parallel to the orography
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZVA ! v component of the wind parallel to the orography
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZU ! zonal wind
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZV ! meridian wind
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZWIND ! wind parallel to the orography
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRHOA ! air density
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTKE ! Subgrid turbulent kinetic energy
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZDIR ! wind direction (rad from N clockwise)
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZALFA ! angle between the wind and the x axis
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZU2D ! u and v component of the
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZV2D ! wind at mass point
+!
+! SURFEX output fluxes
+!
+REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZSFU ! zonal momentum flux
+REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZSFV ! meridian momentum flux
+REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZSFTH ! Total turbulent flux of heat
+REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZSFTH_SURF ! Surface turbulent flux of heat
+REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZSFTH_WALL ! Wall turbulent flux of heat
+REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZSFTH_ROOF ! Roof turbulent flux of heat
+REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZCD_ROOF ! Drag coefficient for roofs
+REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZSFTQ ! Total turbulent flux of water
+REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZSFTQ_SURF ! Surface turbulent flux of water
+REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZSFTQ_WALL ! Wall turbulent flux of water
+REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZSFTQ_ROOF ! Roof turbulent flux of water
+REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZSFCO2 ! Turbulent flux of CO2
+REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2),NSV):: ZSFTS ! Turbulent flux of scalar
REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2),NBLOWSNOW_2D) :: ZBLOWSNOW_2D ! 2D blowing snow variables
! after advection
! They refer to the 2D fields advected by MNH including:
! - total number concentration in Canopy
! - total mass concentration in Canopy
! - equivalent concentration in the saltation layer
+
+!
+! Anxiliary variables
+!
+REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZZREF_DIST
+REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZZREF_VERT
+REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZWEIGHT_VERT
+REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZAGLW_ILEV
+REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZAGLW_ILEVP1
+REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZAGLSCAL_ILEV
!
!* Dimensions
! ----------
@@ -322,29 +356,44 @@ INTEGER :: KSV_SURF ! Number of scalar variables sent to SURFEX
!* Arrays put in 1D vectors
! ------------------------
!
-REAL, DIMENSION(:), ALLOCATABLE :: ZP_TSUN ! solar time
-REAL, DIMENSION(:), ALLOCATABLE :: ZP_ZENITH ! zenithal angle
-REAL, DIMENSION(:), ALLOCATABLE :: ZP_AZIM ! azimuthal angle
-REAL, DIMENSION(:), ALLOCATABLE :: ZP_ZREF ! forcing height
-REAL, DIMENSION(:), ALLOCATABLE :: ZP_ZS ! orography
-REAL, DIMENSION(:), ALLOCATABLE :: ZP_U ! zonal wind
-REAL, DIMENSION(:), ALLOCATABLE :: ZP_V ! meridian wind
-REAL, DIMENSION(:), ALLOCATABLE :: ZP_QA ! air humidity (kg/m3)
-REAL, DIMENSION(:), ALLOCATABLE :: ZP_TA ! air temperature
-REAL, DIMENSION(:), ALLOCATABLE :: ZP_RHOA ! air density
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZP_SV ! scalar at first atmospheric level
+! Pure surface variables or variables forced at only one level
+!
REAL, DIMENSION(:), ALLOCATABLE :: ZP_CO2 ! air CO2 concentration
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZP_SV ! scalar at first atmospheric level
REAL, DIMENSION(:), ALLOCATABLE :: ZP_RAIN ! liquid precipitation
REAL, DIMENSION(:), ALLOCATABLE :: ZP_SNOW ! solid precipitation
REAL, DIMENSION(:), ALLOCATABLE :: ZP_LW ! incoming longwave
REAL, DIMENSION(:,:), ALLOCATABLE :: ZP_DIR_SW ! direct incoming shortwave
REAL, DIMENSION(:,:), ALLOCATABLE :: ZP_SCA_SW ! diffuse incoming shortwave
-REAL, DIMENSION(:), ALLOCATABLE :: ZP_PS ! surface pressure
-REAL, DIMENSION(:), ALLOCATABLE :: ZP_PA ! pressure at first atmospheric level
REAL, DIMENSION(:), ALLOCATABLE :: ZP_ZWS ! significant wave height (m)
-
-REAL, DIMENSION(:), ALLOCATABLE :: ZP_SFTQ ! water vapor flux
-REAL, DIMENSION(:), ALLOCATABLE :: ZP_SFTH ! potential temperature flux
+REAL, DIMENSION(:), ALLOCATABLE :: ZP_PS ! surface pressure
+REAL, DIMENSION(:), ALLOCATABLE :: ZP_TSUN ! solar time
+REAL, DIMENSION(:), ALLOCATABLE :: ZP_ZENITH ! zenithal angle
+REAL, DIMENSION(:), ALLOCATABLE :: ZP_AZIM ! azimuthal angle
+REAL, DIMENSION(:), ALLOCATABLE :: ZP_ZS ! orography
+!
+! Variables that are forced at multiple levels
+!
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZP_ZREF ! forcing height
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZP_U ! zonal wind
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZP_V ! meridian wind
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZP_QA ! air humidity (kg/m3)
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZP_TA ! air temperature
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZP_RHOA ! air density
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZP_PA ! pressure at first atmospheric level
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZP_TKE ! Subgrid turbulent kinetic energy
+!
+! SURFEX output variables
+!
+REAL, DIMENSION(:), ALLOCATABLE :: ZP_SFTQ ! Total water vapor flux
+REAL, DIMENSION(:), ALLOCATABLE :: ZP_SFTQ_SURF ! Surface water vapor flux
+REAL, DIMENSION(:), ALLOCATABLE :: ZP_SFTQ_WALL ! Wall water vapor flux
+REAL, DIMENSION(:), ALLOCATABLE :: ZP_SFTQ_ROOF ! Roof water vapor flux
+REAL, DIMENSION(:), ALLOCATABLE :: ZP_SFTH ! Total potential temperature flux
+REAL, DIMENSION(:), ALLOCATABLE :: ZP_SFTH_SURF ! Surface potential temperature flux
+REAL, DIMENSION(:), ALLOCATABLE :: ZP_SFTH_WALL ! Wall potential temperature flux
+REAL, DIMENSION(:), ALLOCATABLE :: ZP_SFTH_ROOF ! Roof potential temperature flux
+REAL, DIMENSION(:), ALLOCATABLE :: ZP_CD_ROOF ! Drag coefficient for roofs
REAL, DIMENSION(:,:), ALLOCATABLE :: ZP_SFTS ! scalar flux
REAL, DIMENSION(:), ALLOCATABLE :: ZP_SFCO2 ! CO2 flux
REAL, DIMENSION(:), ALLOCATABLE :: ZP_SFU ! zonal momentum flux
@@ -353,12 +402,11 @@ REAL, DIMENSION(:), ALLOCATABLE :: ZP_TSRAD ! radiative surface temperature
REAL, DIMENSION(:,:), ALLOCATABLE :: ZP_DIR_ALB ! direct albedo
REAL, DIMENSION(:,:), ALLOCATABLE :: ZP_SCA_ALB ! diffuse albedo
REAL, DIMENSION(:), ALLOCATABLE :: ZP_EMIS ! emissivity
-
REAL, DIMENSION(:), ALLOCATABLE :: ZP_TSURF
REAL, DIMENSION(:), ALLOCATABLE :: ZP_Z0
REAL, DIMENSION(:), ALLOCATABLE :: ZP_Z0H
REAL, DIMENSION(:), ALLOCATABLE :: ZP_QSURF
-
+!
REAL, DIMENSION(:), ALLOCATABLE :: ZP_PEW_A_COEF ! coefficients for
REAL, DIMENSION(:), ALLOCATABLE :: ZP_PEW_B_COEF ! implicit coupling
REAL, DIMENSION(:), ALLOCATABLE :: ZP_PET_A_COEF
@@ -375,6 +423,9 @@ REAL, DIMENSION(:), ALLOCATABLE :: ZP_Q2M ! Air humidity at 2 meters
REAL, DIMENSION(:), ALLOCATABLE :: ZP_HU2M ! Air relative humidity at 2 meters (-)
REAL, DIMENSION(:), ALLOCATABLE :: ZP_ZON10M ! zonal Wind at 10 meters (m/s)
REAL, DIMENSION(:), ALLOCATABLE :: ZP_MER10M ! meridian Wind at 10 meters (m/s)
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZP_ZIMPWET ! wet deposit coefficient for each impurity type (g)
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZP_ZIMPDRY ! dry deposit coefficient for each impurity type (g)
+
TYPE(LIST_ll), POINTER :: TZFIELDSURF_ll ! list of fields to exchange
INTEGER :: IINFO_ll ! return code of parallel routine
!
@@ -383,8 +434,16 @@ CHARACTER(LEN=6) :: YJSV
CHARACTER(LEN=6), DIMENSION(:), ALLOCATABLE :: YSV_SURF ! name of the scalar variables
! sent to SURFEX
!
-REAL :: ZTIMEC
-INTEGER :: ILUOUT ! logical unit
+LOGICAL :: GSTATPROF_SURF ! TRUE if station or profiler need to write surface or radiation data
+REAL :: ZTIMEC
+INTEGER :: ILUOUT ! logical unit
+!
+! New variables for coupling at several levels
+!
+REAL :: ZAGLW_JK
+REAL :: ZAGLW_JKP1
+REAL :: ZAGLSCAL_JK
+INTEGER :: ICOUNT, ILEV
!
! Fire model
REAL(KIND=MNHTIME), DIMENSION(2) :: ZFIRETIME1, ZFIRETIME2 ! CPU time for Blaze perf profiling
@@ -395,7 +454,7 @@ REAL(KIND=MNHTIME), DIMENSION(2) :: ZROSWINDTIME1, ZROSWINDTIME2 ! CPU
REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZFIREFUELMAP ! Fuel map
CHARACTER(LEN=7) :: YFUELMAPFILE ! Fuel Map file name
TYPE(LIST_ll), POINTER :: TZFIELDFIRE_ll ! list of fields to exchange
-
+!
!-------------------------------------------------------------------------------
!
!
@@ -406,8 +465,14 @@ IKE=IKU-JPVEXT
!
CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
!
-PSFTH = XUNDEF_SFX
-PSFRV = XUNDEF_SFX
+PSFTH = XUNDEF_SFX
+PSFTH_WALL = XUNDEF_SFX
+PSFTH_ROOF = XUNDEF_SFX
+PCD_ROOF = XUNDEF_SFX
+PSFRV = XUNDEF_SFX
+PSFRV_WALL = XUNDEF_SFX
+PSFRV_ROOF = XUNDEF_SFX
+!
PSFSV = XUNDEF_SFX
PSFCO2 = XUNDEF_SFX
PSFU = XUNDEF_SFX
@@ -417,6 +482,28 @@ PSCA_ALB = XUNDEF_SFX
PEMIS = XUNDEF_SFX
PTSRAD = XUNDEF_SFX
!
+! Allocation of the local variables
+!
+ALLOCATE(ZZREF(SIZE(PSFTH,1),SIZE(PSFTH,2),NLEV_COUPLE))
+ALLOCATE(ZTA(SIZE(PSFTH,1),SIZE(PSFTH,2),NLEV_COUPLE))
+ALLOCATE(ZRVA(SIZE(PSFTH,1),SIZE(PSFTH,2),NLEV_COUPLE))
+ALLOCATE(ZQA(SIZE(PSFTH,1),SIZE(PSFTH,2),NLEV_COUPLE))
+ALLOCATE(ZPA(SIZE(PSFTH,1),SIZE(PSFTH,2),NLEV_COUPLE))
+ALLOCATE(ZEXNA(SIZE(PSFTH,1),SIZE(PSFTH,2),NLEV_COUPLE))
+ALLOCATE(ZTHA(SIZE(PSFTH,1),SIZE(PSFTH,2),NLEV_COUPLE))
+ALLOCATE(ZUA(SIZE(PSFTH,1),SIZE(PSFTH,2),NLEV_COUPLE))
+ALLOCATE(ZVA(SIZE(PSFTH,1),SIZE(PSFTH,2),NLEV_COUPLE))
+ALLOCATE(ZU(SIZE(PSFTH,1),SIZE(PSFTH,2),NLEV_COUPLE))
+ALLOCATE(ZV(SIZE(PSFTH,1),SIZE(PSFTH,2),NLEV_COUPLE))
+ALLOCATE(ZWIND(SIZE(PSFTH,1),SIZE(PSFTH,2),NLEV_COUPLE))
+ALLOCATE(ZRHOA(SIZE(PSFTH,1),SIZE(PSFTH,2),NLEV_COUPLE))
+IF(CTURB/='NONE') ALLOCATE(ZTKE(SIZE(PSFTH,1),SIZE(PSFTH,2),NLEV_COUPLE))
+ALLOCATE(ZDIR(SIZE(PSFTH,1),SIZE(PSFTH,2),NLEV_COUPLE))
+ALLOCATE(ZALFA(SIZE(PSFTH,1),SIZE(PSFTH,2),NLEV_COUPLE))
+ALLOCATE(ZU2D(SIZE(PSFTH,1),SIZE(PSFTH,2),NLEV_COUPLE))
+ALLOCATE(ZV2D(SIZE(PSFTH,1),SIZE(PSFTH,2),NLEV_COUPLE))
+!
+GSTATPROF_SURF = ( LPROFILER .AND. LDIAG_SURFRAD_PROF ) .OR. ( LSTATION .AND. LDIAG_SURFRAD_STAT )
!
!-------------------------------------------------------------------------------
!
@@ -438,51 +525,78 @@ END IF
! 1.2 Horizontal wind direction (rad from N clockwise)
! -------------------------
!
-ZU2D(:,:,:)=MXF(XUT(:,:,IKB:IKB))
-ZV2D(:,:,:)=MYF(XVT(:,:,IKB:IKB))
+ZU2D(:,:,:)=MXF(XUT(:,:,IKB:(IKB+NLEV_COUPLE-1)))
+ZV2D(:,:,:)=MYF(XVT(:,:,IKB:(IKB+NLEV_COUPLE-1)))
!
!* angle between Y axis and wind (rad., clockwise)
!
ZALFA = 0.
-WHERE(ZU2D(:,:,1)/=0. .OR. ZV2D(:,:,1)/=0.)
- ZALFA(:,:)=ATAN2(ZU2D(:,:,1),ZV2D(:,:,1))
-END WHERE
-WHERE(ZALFA(:,:)<0.) ZALFA(:,:) = ZALFA(:,:) + 2. * XPI
-!
-!* angle between North and wind (rad., clockwise)
!
-IF (.NOT. LCARTESIAN) THEN
- ZDIR = ( (XRPK*(XLON(:,:)-XLON0)) - XBETA ) * XPI/180. + ZALFA
+DO ILEV=1,NLEV_COUPLE
+ !
+ WHERE(ZU2D(:,:,ILEV)/=0. .OR. ZV2D(:,:,ILEV)/=0.)
+ ZALFA(:,:,ILEV)=ATAN2(ZU2D(:,:,ILEV),ZV2D(:,:,ILEV))
+ END WHERE
+ !
+ WHERE(ZALFA(:,:,ILEV)<0.) ZALFA(:,:,ILEV) = ZALFA(:,:,ILEV) + 2. * XPI
+ !
+ !* angle between North and wind (rad., clockwise)
+ !
+ IF (.NOT. LCARTESIAN) THEN
+ ZDIR(:,:,ILEV) = ( (XRPK*(XLON(:,:)-XLON0)) - XBETA ) * XPI/180. + ZALFA(:,:,ILEV)
+ ELSE
+ ZDIR(:,:,ILEV) = - XBETA * XPI/180. + ZALFA(:,:,ILEV)
+ ENDIF
+ !
+ ! 1.3 Rotate the wind
+ ! Only for the first forcing level, used for friction force direction.
+ ! ---------------
+ !
+ IF (ILEV.EQ.1) THEN
+ !
+ CALL ROTATE_WIND(D,XUT,XVT,XWT, &
+ XDIRCOSXW, XDIRCOSYW, XDIRCOSZW, &
+ XCOSSLOPE,XSINSLOPE, &
+ XDXX,XDYY,XDZZ, &
+ ZUA(:,:,ILEV),ZVA(:,:,ILEV) )
+ !
+ ELSE
+ !
+ ZUA(:,:,ILEV) = XUT(:,:,IKB+ILEV-1)
+ ZVA(:,:,ILEV) = XVT(:,:,IKB+ILEV-1)
+ !
+ ENDIF
+ !
+ ! 1.4 zonal and meridian components of the wind parallel to the slope
+ ! ---------------------------------------------------------------
+ !
+ ZWIND(:,:,ILEV) = SQRT( ZUA(:,:,ILEV)**2 + ZVA(:,:,ILEV)**2 )
+ !
+ ZU(:,:,ILEV) = ZWIND(:,:,ILEV) * SIN(ZDIR(:,:,ILEV))
+ ZV(:,:,ILEV) = ZWIND(:,:,ILEV) * COS(ZDIR(:,:,ILEV))
+ !
+ENDDO
+ !
+ ! 1.5 Horizontal interpolation of the thermodynamic fields
+ ! -------------------------------------------------
+ !
+ ! This horizontal interpolation is only made if the forcing is located at the first level
+ !
+IF (NLEV_COUPLE.EQ.1) THEN
+ !
+ CALL NORMAL_INTERPOL(XTHT,ZRV,XPABST, &
+ XDIRCOSXW, XDIRCOSYW, XDIRCOSZW, &
+ XCOSSLOPE,XSINSLOPE, &
+ XDXX,XDYY,XDZZ, &
+ ZTHA(:,:,1),ZRVA(:,:,1),ZEXNA(:,:,1) )
+ !
ELSE
- ZDIR = - XBETA * XPI/180. + ZALFA
-END IF
-!
-!
-! 1.3 Rotate the wind
-! ---------------
-!
-CALL ROTATE_WIND( D, XUT, XVT, XWT, &
- XDIRCOSXW, XDIRCOSYW, XDIRCOSZW, &
- XCOSSLOPE, XSINSLOPE, &
- XDXX, XDYY, XDZZ, &
- ZUA, ZVA )
-!
-! 1.4 zonal and meridian components of the wind parallel to the slope
-! ---------------------------------------------------------------
-!
-ZWIND(:,:) = SQRT( ZUA**2 + ZVA**2 )
-!
-ZU(:,:) = ZWIND(:,:) * SIN(ZDIR)
-ZV(:,:) = ZWIND(:,:) * COS(ZDIR)
-!
-! 1.5 Horizontal interpolation the thermodynamic fields
-! -------------------------------------------------
-!
-CALL NORMAL_INTERPOL(XTHT,ZRV,XPABST, &
- XDIRCOSXW, XDIRCOSYW, XDIRCOSZW, &
- XCOSSLOPE,XSINSLOPE, &
- XDXX,XDYY,XDZZ, &
- ZTHA,ZRVA,ZEXNA )
+ !
+ ZEXNA (:,:,1:NLEV_COUPLE) = (XPABST(:,:,IKB:(IKB+NLEV_COUPLE-1))/XP00) ** (XRD/XCPD)
+ ZTHA (:,:,1:NLEV_COUPLE) = XTHT(:,:,IKB:(IKB+NLEV_COUPLE-1))
+ ZRVA (:,:,1:NLEV_COUPLE) = ZRV (:,:,IKB:(IKB+NLEV_COUPLE-1))
+ !
+ENDIF
!
DEALLOCATE(ZRV)
!
@@ -490,8 +604,7 @@ DEALLOCATE(ZRV)
! 1.6 Pressure and Exner function
! ---------------------------
!
-!
-ZPA(:,:) = XP00 * ZEXNA(:,:) **(XCPD/XRD)
+ZPA(:,:,:) = XP00 * ZEXNA(:,:,:) ** (XCPD/XRD)
!
ZEXNS(:,:) = 0.5 * ( (XPABST(:,:,IKB-1)/XP00)**(XRD/XCPD) &
+(XPABST(:,:,IKB )/XP00)**(XRD/XCPD) &
@@ -501,23 +614,22 @@ ZPS(:,:) = XP00 * ZEXNS(:,:) **(XCPD/XRD)
! 1.7 humidity in kg/m3 from the mixing ratio
! ---------------------------------------
!
-!
-ZQA(:,:) = ZRVA(:,:) * XRHODREF(:,:,IKB)
-!
+ZQA(:,:,:) = ZRVA(:,:,:) * XRHODREF(:,:,IKB:(IKB+NLEV_COUPLE-1))
!
! 1.8 Temperature from the potential temperature
! ------------------------------------------
!
-!
-ZTA(:,:) = ZTHA(:,:) * ZEXNA(:,:)
-!
+ZTA(:,:,:) = ZTHA(:,:,:) * ZEXNA(:,:,:)
!
! 1.9 Air density
! -----------
!
-ZRHOA(:,:) = ZPA(:,:)/(XRD * ZTA(:,:) * ((1. + (XRD/XRV)*ZRVA(:,:))/ &
- (1. + ZRVA(:,:))))
+ZRHOA(:,:,:) = ZPA(:,:,:)/(XRD * ZTA(:,:,:) * &
+ ((1. + (XRD/XRV)*ZRVA(:,:,:)) / (1. + ZRVA(:,:,:))))
!
+! Subgrid turbulent kinetic energy
+!
+IF(CTURB/='NONE') ZTKE(:,:,:) = XTKET(:,:,IKB:(IKB+NLEV_COUPLE-1))
!
! 1.10 Precipitations
! --------------
@@ -554,8 +666,39 @@ END IF
! 1.12 Forcing level
! -------------
!
-ZZREF(:,:) = 0.5*( XZZ(:,:,IKB+1)-XZZ(:,:,IKB) )*XDIRCOSZW(:,:)
-!
+! A smooth transition between vertical height above ground and
+! distance to the surface is implemented here.
+! We assume that for katabatic winds located in the first meters above
+! ground, the distance to the surface is the most relevant whereas
+! for most other processes it will be the vertical distance to the surface
+!
+DO ILEV=1,NLEV_COUPLE
+ !
+ ! Height above ground of w-levels
+ !
+ ZAGLW_ILEV (:,:) = XZZ(:,:,JPVEXT+ILEV ) - XZZ(:,:,1+JPVEXT)
+ ZAGLW_ILEVP1 (:,:) = XZZ(:,:,JPVEXT+ILEV+1) - XZZ(:,:,1+JPVEXT)
+ !
+ ! Height above ground of scalar variables and (u,v)
+ !
+ ZAGLSCAL_ILEV(:,:) = 0.5 * ( ZAGLW_ILEV(:,:) + ZAGLW_ILEVP1(:,:) )
+ !
+ ! Distance to the inclined surface and vertical distance
+ !
+ ZZREF_DIST(:,:) = ZAGLSCAL_ILEV(:,:) * XDIRCOSZW(:,:)
+ !
+ ZZREF_VERT(:,:) = ZAGLSCAL_ILEV(:,:)
+ !
+ ! Scaling between 5 m and 20 m height
+ !
+ ZWEIGHT_VERT(:,:) = MIN(1.0,MAX(ZZREF_VERT(:,:)-5.0,0.0)/15.0)
+ !
+ IF (MAXVAL(ZWEIGHT_VERT).GT.1.0) STOP ("Wrong weight")
+ IF (MINVAL(ZWEIGHT_VERT).LT.0.0) STOP ("Wrong weight")
+ !
+ ZZREF(:,:,ILEV) = ZWEIGHT_VERT(:,:) * ZZREF_VERT(:,:) + (1.0 - ZWEIGHT_VERT(:,:)) * ZZREF_DIST(:,:)
+ !
+ENDDO
!
! 1.13 CO2 concentration (kg/m3)
! -----------------
@@ -592,6 +735,7 @@ ELSE
YSV_SURF(:) = CSV(1:NSV)
ENDIF
!
+!
!-------------------------------------------------------------------------------
!
!* 2. Call to surface monitor with 2D variables
@@ -630,18 +774,19 @@ END IF
#endif
!
! Call to surface schemes
-!
-CALL COUPLING_SURF_ATM_n(YSURF_CUR,'MESONH', 'E',ZTIMEC, &
- XTSTEP, TDTCUR%nyear, TDTCUR%nmonth, TDTCUR%nday, TDTCUR%xtime, &
- IDIM1D,KSV_SURF,SIZE(XSW_BANDS), &
- ZP_TSUN, ZP_ZENITH,ZP_ZENITH, ZP_AZIM, &
- ZP_ZREF, ZP_ZREF, ZP_ZS, ZP_U, ZP_V, ZP_QA, ZP_TA, ZP_RHOA, ZP_SV, ZP_CO2, YSV_SURF, &
- ZP_RAIN, ZP_SNOW, ZP_LW, ZP_DIR_SW, ZP_SCA_SW, XSW_BANDS, ZP_PS, ZP_PA, &
- ZP_SFTQ, ZP_SFTH, ZP_SFTS, ZP_SFCO2, ZP_SFU, ZP_SFV, &
- ZP_TSRAD, ZP_DIR_ALB, ZP_SCA_ALB, ZP_EMIS, ZP_TSURF, ZP_Z0, ZP_Z0H, ZP_QSURF, &
- ZP_PEW_A_COEF, ZP_PEW_B_COEF, &
- ZP_PET_A_COEF, ZP_PEQ_A_COEF, ZP_PET_B_COEF, ZP_PEQ_B_COEF,ZP_ZWS, &
- 'OK' )
+!
+CALL COUPLING_SURF_ATM_MULTI_LEVEL_n(YSURF_CUR,'MESONH', 'E',ZTIMEC, XTSTEP, &
+ TDTCUR%nyear, TDTCUR%nmonth, TDTCUR%nday, TDTCUR%xtime, &
+ IDIM1D,KSV_SURF,SIZE(XSW_BANDS), NLEV_COUPLE, ZP_TSUN, ZP_ZENITH,ZP_ZENITH, &
+ ZP_AZIM, ZP_ZREF, ZP_ZREF, ZP_ZS, ZP_U, ZP_V, ZP_QA, ZP_TA, ZP_RHOA, ZP_SV, &
+ ZP_CO2, ZP_ZIMPWET, ZP_ZIMPDRY, YSV_SURF, &
+ ZP_RAIN, ZP_SNOW, ZP_LW, ZP_DIR_SW, ZP_SCA_SW, XSW_BANDS, &
+ ZP_PS, ZP_PA, ZP_TKE, ZP_SFTQ, ZP_SFTQ_SURF, ZP_SFTQ_WALL, ZP_SFTQ_ROOF, &
+ ZP_SFTH, ZP_SFTH_SURF, ZP_SFTH_WALL, ZP_SFTH_ROOF, ZP_CD_ROOF, ZP_SFTS, &
+ ZP_SFCO2, ZP_SFU, ZP_SFV, ZP_TSRAD, ZP_DIR_ALB, ZP_SCA_ALB, ZP_EMIS, ZP_TSURF, &
+ ZP_Z0, ZP_Z0H, ZP_QSURF, ZP_PEW_A_COEF, ZP_PEW_B_COEF, ZP_PET_A_COEF, &
+ ZP_PEQ_A_COEF, ZP_PET_B_COEF, ZP_PEQ_B_COEF, ZP_ZWS, 'OK' )
+
!
#ifdef CPLOASIS
IF (LOASIS) THEN
@@ -657,11 +802,15 @@ IF (LOASIS) THEN
END IF
#endif
!
-IF (CPROGRAM=='DIAG ' .OR. LDIAG_IN_RUN) THEN
- CALL DIAG_SURF_ATM_n(YSURF_CUR,'MESONH')
- CALL MNHGET_SURF_PARAM_n( PRN = ZP_RN, PH = ZP_H, PLE = ZP_LE, PLEI = ZP_LEI, &
- PGFLUX = ZP_GFLUX, PT2M = ZP_T2M, PQ2M = ZP_Q2M, PHU2M = ZP_HU2M, &
- PZON10M = ZP_ZON10M, PMER10M = ZP_MER10M )
+IF ( CPROGRAM == 'DIAG' .OR. GSTATPROF_SURF ) THEN
+ CALL DIAG_SURF_ATM_n( YSURF_CUR, 'MESONH' )
+ IF ( CPROGRAM == 'DIAG' ) THEN
+ CALL MNHGET_SURF_PARAM_n(PZON10M=ZP_ZON10M, PMER10M=ZP_MER10M)
+ ELSE
+ CALL MNHGET_SURF_PARAM_n( PRN=ZP_RN, PH=ZP_H, PLE=ZP_LE, PLEI=ZP_LEI, &
+ PGFLUX=ZP_GFLUX, PT2M=ZP_T2M, PQ2M=ZP_Q2M, PHU2M=ZP_HU2M, &
+ PZON10M=ZP_ZON10M, PMER10M=ZP_MER10M )
+ END IF
END IF
!
! Transform 1D output fields into 2D:
@@ -671,7 +820,7 @@ CALL UNSHAPE_SURF(IDIM1,IDIM2)
!------------------------!
! COUPLING WITH FOREFIRE !
!------------------------!
-
+
IF ( LFOREFIRE ) THEN
CALL FOREFIRE_DUMP_FIELDS_n(XUT, XVT, XWT, XSVT&
, XTHT, XRT(:,:,:,1), XPABST, XTKET&
@@ -695,15 +844,16 @@ FF_TIME = FF_TIME + XTSTEP
!
! Friction of components along slope axes (U: largest local slope axis, V: zero slope axis)
!
-!
PSFU(:,:) = 0.
PSFV(:,:) = 0.
!
-WHERE (ZSFU(:,:)/=XUNDEF_SFX .AND. ZWIND(:,:)>0.)
- PSFU(:,:) = - SQRT(ZSFU**2+ZSFV**2) * ZUA(:,:) / ZWIND(:,:) / XRHODREF(:,:,IKB)
- PSFV(:,:) = - SQRT(ZSFU**2+ZSFV**2) * ZVA(:,:) / ZWIND(:,:) / XRHODREF(:,:,IKB)
+WHERE (ZSFU(:,:)/=XUNDEF_SFX .AND. ZWIND(:,:,1)>0.)
+ PSFU(:,:) = - SQRT(ZSFU**2+ZSFV**2) * ZUA(:,:,1) / ZWIND(:,:,1) / XRHODREF(:,:,IKB)
+ PSFV(:,:) = - SQRT(ZSFU**2+ZSFV**2) * ZVA(:,:,1) / ZWIND(:,:,1) / XRHODREF(:,:,IKB)
END WHERE
!
+PCD_ROOF(:,:) = ZCD_ROOF(:,:)
+!
!* 2.1 Blaze Fire Model
! ----------------
@@ -862,13 +1012,49 @@ IF (LBLAZE) THEN
END IF
!* conversion from H (W/m2) to w'Theta'
!
-PSFTH(:,:) = ZSFTH(:,:) / XCPD / XRHODREF(:,:,IKB)
-!
-!
-!* conversion from water flux (kg/m2/s) to w'rv'
-!
-PSFRV(:,:) = ZSFTQ(:,:) / XRHODREF(:,:,IKB)
-!
+! Unit conversions:
+!
+!* H: (W/m2) to w'Theta'
+!
+!* Water flux: (kg/m2/s) to w'rv'
+!
+IF (LFLUXBLDG) THEN
+ !
+ ! Robert: Here the wall and roof fluxes are substracted from the surface fluxes
+ ! since they will be applied in drag_bld.F90
+ !
+ PSFTH(:,:) = ( ZSFTH(:,:) - ZSFTH_WALL(:,:) - ZSFTH_ROOF(:,:) ) / XCPD / XRHODREF(:,:,IKB)
+ PSFRV(:,:) = ( ZSFTQ(:,:) - ZSFTQ_WALL(:,:) - ZSFTQ_ROOF(:,:) ) / XRHODREF(:,:,IKB)
+ !
+ ! Wall and roof fluxes are written on separate variables
+ !
+ PSFTH_WALL(:,:) = ZSFTH_WALL(:,:) / XCPD / XRHODREF(:,:,IKB)
+ PSFTH_ROOF(:,:) = ZSFTH_ROOF(:,:) / XCPD / XRHODREF(:,:,IKB)
+ !
+ PSFRV_WALL(:,:) = ZSFTQ_WALL(:,:) / XRHODREF(:,:,IKB)
+ PSFRV_ROOF(:,:) = ZSFTQ_ROOF(:,:) / XRHODREF(:,:,IKB)
+ !
+ ! Test conservation of fluxes
+ !
+ IF (MAXVAL(ABS(ZSFTH(:,:)/XCPD/XRHODREF(:,:,IKB) - PSFTH(:,:) - PSFTH_WALL(:,:)&
+ - PSFTH_ROOF(:,:))).GT.1.0E-6) STOP ("Wrong H flux partition")
+ IF (MAXVAL(ABS(ZSFTQ(:,:)/XRHODREF(:,:,IKB) - PSFRV(:,:) - PSFRV_WALL(:,:)&
+ - PSFRV_ROOF(:,:))).GT.1.0E-6) STOP ("Wrong Q flux partition")
+ !
+ELSE
+ !
+ ! Otherwise the full surface fluxes are taken
+ !
+ PSFTH(:,:) = ZSFTH(:,:) / XCPD / XRHODREF(:,:,IKB)
+ PSFRV(:,:) = ZSFTQ(:,:) / XRHODREF(:,:,IKB)
+ !
+ PSFTH_WALL(:,:) = 0.0
+ PSFTH_ROOF(:,:) = 0.0
+ !
+ PSFRV_WALL(:,:) = 0.0
+ PSFRV_ROOF(:,:) = 0.0
+ !
+ENDIF
!
!* conversion from scalar flux (kg/m2/s) to w'rsv'
!
@@ -923,11 +1109,11 @@ END IF
!
IF (LBLOWSNOW) THEN
DO JSV=NSV_SNWBEG,NSV_SNWEND
- PSFSV(:,:,JSV) = ZSFTS(:,:,JSV)/ (ZRHOA(:,:))
+ PSFSV(:,:,JSV) = ZSFTS(:,:,JSV)/ (ZRHOA(:,:,1))
END DO
!* Update tendency for blowing snow 2D fields
DO JSV=1,(NBLOWSNOW_2D)
- XRSNWCANOS(:,:,JSV) = ZBLOWSNOW_2D(:,:,JSV)*XRHODJ(:,:,IKB)/(XTSTEP*ZRHOA(:,:))
+ XRSNWCANOS(:,:,JSV) = ZBLOWSNOW_2D(:,:,JSV)*XRHODJ(:,:,IKB)/(XTSTEP*ZRHOA(:,:,1))
END DO
ELSE
@@ -969,53 +1155,61 @@ CALL CLEANLIST_ll(TZFIELDSURF_ll)
! -----------
!
!
-IF (LDIAG_IN_RUN) THEN
- !
+IF ( CPROGRAM == 'DIAG' .OR. GSTATPROF_SURF ) THEN
XCURRENT_SFCO2(:,:) = ZSFCO2(:,:)
- XCURRENT_DSTAOD(:,:)=0.0
- XCURRENT_SLTAOD(:,:)=0.0
- IF (CRAD/='NONE') THEN
- XCURRENT_LWD (:,:) = XFLALWD(:,:)
- XCURRENT_SWD (:,:) = SUM(XDIRSRFSWD(:,:,:)+XSCAFLASWD(:,:,:),DIM=3)
- XCURRENT_LWU (:,:) = XLWU(:,:,IKB)
- XCURRENT_SWU (:,:) = XSWU(:,:,IKB)
- XCURRENT_SWDIR(:,:) = SUM(XDIRSRFSWD,DIM=3)
- XCURRENT_SWDIFF(:,:) = SUM(XSCAFLASWD(:,:,:),DIM=3)
- DO JK=IKB,IKE
- IKRAD = JK - 1
- DO JJ=IJB,IJE
- DO JI=IIB,IIE
- XCURRENT_DSTAOD(JI,JJ)=XCURRENT_DSTAOD(JI,JJ)+XAER(JI,JJ,IKRAD,3)
- XCURRENT_SLTAOD(JI,JJ)=XCURRENT_SLTAOD(JI,JJ)+XAER(JI,JJ,IKRAD,2)
- ENDDO
- ENDDO
- ENDDO
+ IF ( CRAD /= 'NONE' ) THEN
+ XCURRENT_LWD (:,:) = XFLALWD(:,:)
+ XCURRENT_SWD (:,:) = SUM( XDIRSRFSWD(:,:,:) + XSCAFLASWD(:,:,:), DIM=3 )
+ XCURRENT_LWU (:,:) = XLWU(:,:,IKB)
+ XCURRENT_SWU (:,:) = XSWU(:,:,IKB)
+ IF ( GSTATPROF_SURF .AND. CPROGRAM /= 'DIAG' ) THEN
+ XCURRENT_SWDIR(:,:) = SUM( XDIRSRFSWD(:,:,:), DIM=3 )
+ XCURRENT_SWDIFF(:,:) = SUM( XSCAFLASWD(:,:,:), DIM=3 )
+ XCURRENT_DSTAOD(:,:) = 0.0
+ XCURRENT_SLTAOD(:,:) = 0.0
+ DO JK=IKB,IKE
+ IKRAD = JK - 1
+ DO JJ = IJB, IJE
+ DO JI = IIB, IIE
+ XCURRENT_DSTAOD(JI,JJ) = XCURRENT_DSTAOD(JI,JJ) + XAER(JI,JJ,IKRAD,3)
+ XCURRENT_SLTAOD(JI,JJ) = XCURRENT_SLTAOD(JI,JJ) + XAER(JI,JJ,IKRAD,2)
+ END DO
+ END DO
+ END DO
+ END IF
END IF
-!
NULLIFY(TZFIELDSURF_ll)
- CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_RN, 'GROUND_PARAM_n::XCURRENT_RN' )
- CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_H, 'GROUND_PARAM_n::XCURRENT_H' )
- CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_LE, 'GROUND_PARAM_n::XCURRENT_LE' )
- CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_LEI, 'GROUND_PARAM_n::XCURRENT_LEI' )
- CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_GFLUX, 'GROUND_PARAM_n::XCURRENT_GFLUX' )
- CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_SWD, 'GROUND_PARAM_n::XCURRENT_SWD' )
- CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_SWU, 'GROUND_PARAM_n::XCURRENT_SWU' )
- CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_LWD, 'GROUND_PARAM_n::XCURRENT_LWD' )
- CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_LWU, 'GROUND_PARAM_n::XCURRENT_LWU' )
- CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_SWDIR, 'GROUND_PARAM_n::XCURRENT_SWDIR' )
- CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_SWDIFF, 'GROUND_PARAM_n::XCURRENT_SWDIFF' )
- CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_T2M, 'GROUND_PARAM_n::XCURRENT_T2M' )
- CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_Q2M, 'GROUND_PARAM_n::XCURRENT_Q2M' )
- CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_HU2M, 'GROUND_PARAM_n::XCURRENT_HU2M' )
- CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_ZON10M, 'GROUND_PARAM_n::XCURRENT_ZON10M' )
- CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_MER10M, 'GROUND_PARAM_n::XCURRENT_MER10M' )
- CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_DSTAOD, 'GROUND_PARAM_n::XCURRENT_DSTAOD' )
- CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_SLTAOD, 'GROUND_PARAM_n::XCURRENT_SLTAOD' )
- CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_ZWS, 'GROUND_PARAM_n::XCURRENT_ZWS' )
- CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_SFCO2, 'GROUND_PARAM_n::XCURRENT_SFCO2' )
+
+ CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_SFCO2, 'GROUND_PARAM_n::XCURRENT_SFCO2' )
+ IF ( CRAD /= 'NONE' ) THEN
+ CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_LWD, 'GROUND_PARAM_n::XCURRENT_LWD' )
+ CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_SWD, 'GROUND_PARAM_n::XCURRENT_SWD' )
+ CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_LWU, 'GROUND_PARAM_n::XCURRENT_LWU' )
+ CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_SWU, 'GROUND_PARAM_n::XCURRENT_SWU' )
+ IF ( GSTATPROF_SURF .AND. CPROGRAM /= 'DIAG' ) THEN
+ CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_SWDIR, 'GROUND_PARAM_n::XCURRENT_SWDIR' )
+ CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_SWDIFF, 'GROUND_PARAM_n::XCURRENT_SWDIFF' )
+ CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_DSTAOD, 'GROUND_PARAM_n::XCURRENT_DSTAOD' )
+ CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_SLTAOD, 'GROUND_PARAM_n::XCURRENT_SLTAOD' )
+ END IF
+ END IF
+ CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_ZON10M, 'GROUND_PARAM_n::XCURRENT_ZON10M' )
+ CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_MER10M, 'GROUND_PARAM_n::XCURRENT_MER10M' )
+ IF ( GSTATPROF_SURF .AND. CPROGRAM /= 'DIAG' ) THEN
+ CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_RN, 'GROUND_PARAM_n::XCURRENT_RN' )
+ CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_H, 'GROUND_PARAM_n::XCURRENT_H' )
+ CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_LE, 'GROUND_PARAM_n::XCURRENT_LE' )
+ CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_LEI, 'GROUND_PARAM_n::XCURRENT_LEI' )
+ CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_GFLUX, 'GROUND_PARAM_n::XCURRENT_GFLUX' )
+ CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_T2M, 'GROUND_PARAM_n::XCURRENT_T2M' )
+ CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_Q2M, 'GROUND_PARAM_n::XCURRENT_Q2M' )
+ CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_HU2M, 'GROUND_PARAM_n::XCURRENT_HU2M' )
+ END IF
+ ! CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_ZWS, 'GROUND_PARAM_n::XCURRENT_ZWS' )
CALL UPDATE_HALO_ll(TZFIELDSURF_ll,IINFO_ll)
CALL CLEANLIST_ll(TZFIELDSURF_ll)
+ !
END IF
!
IF (LBLAZE) THEN
@@ -1037,16 +1231,23 @@ INTEGER, DIMENSION(1) :: ISHAPE_1
!
ISHAPE_1 = (/KDIM1D/)
!
+! Variables that are coupled at multiple levels
+!
+ALLOCATE(ZP_ZREF (KDIM1D,NLEV_COUPLE))
+ALLOCATE(ZP_U (KDIM1D,NLEV_COUPLE))
+ALLOCATE(ZP_V (KDIM1D,NLEV_COUPLE))
+ALLOCATE(ZP_QA (KDIM1D,NLEV_COUPLE))
+ALLOCATE(ZP_TA (KDIM1D,NLEV_COUPLE))
+ALLOCATE(ZP_PA (KDIM1D,NLEV_COUPLE))
+ALLOCATE(ZP_RHOA (KDIM1D,NLEV_COUPLE))
+ALLOCATE(ZP_TKE (KDIM1D,NLEV_COUPLE))
+!
+! 2D Variables and variables that are coupled at the surface only
+!
ALLOCATE(ZP_TSUN (KDIM1D))
ALLOCATE(ZP_ZENITH (KDIM1D))
ALLOCATE(ZP_AZIM (KDIM1D))
-ALLOCATE(ZP_ZREF (KDIM1D))
ALLOCATE(ZP_ZS (KDIM1D))
-ALLOCATE(ZP_U (KDIM1D))
-ALLOCATE(ZP_V (KDIM1D))
-ALLOCATE(ZP_QA (KDIM1D))
-ALLOCATE(ZP_TA (KDIM1D))
-ALLOCATE(ZP_RHOA (KDIM1D))
ALLOCATE(ZP_SV (KDIM1D,KSV_SURF))
ALLOCATE(ZP_CO2 (KDIM1D))
ALLOCATE(ZP_RAIN (KDIM1D))
@@ -1055,11 +1256,19 @@ ALLOCATE(ZP_LW (KDIM1D))
ALLOCATE(ZP_DIR_SW (KDIM1D,SIZE(XDIRSRFSWD,3)))
ALLOCATE(ZP_SCA_SW (KDIM1D,SIZE(XSCAFLASWD,3)))
ALLOCATE(ZP_PS (KDIM1D))
-ALLOCATE(ZP_PA (KDIM1D))
ALLOCATE(ZP_ZWS (KDIM1D))
-
-ALLOCATE(ZP_SFTQ (KDIM1D))
-ALLOCATE(ZP_SFTH (KDIM1D))
+!
+! 2D SURFEX output fields
+!
+ALLOCATE(ZP_SFTQ (KDIM1D))
+ALLOCATE(ZP_SFTQ_SURF (KDIM1D))
+ALLOCATE(ZP_SFTQ_WALL (KDIM1D))
+ALLOCATE(ZP_SFTQ_ROOF (KDIM1D))
+ALLOCATE(ZP_SFTH (KDIM1D))
+ALLOCATE(ZP_SFTH_SURF (KDIM1D))
+ALLOCATE(ZP_SFTH_WALL (KDIM1D))
+ALLOCATE(ZP_SFTH_ROOF (KDIM1D))
+ALLOCATE(ZP_CD_ROOF (KDIM1D))
ALLOCATE(ZP_SFU (KDIM1D))
ALLOCATE(ZP_SFV (KDIM1D))
ALLOCATE(ZP_SFTS (KDIM1D,KSV_SURF))
@@ -1072,17 +1281,21 @@ ALLOCATE(ZP_TSURF (KDIM1D))
ALLOCATE(ZP_Z0 (KDIM1D))
ALLOCATE(ZP_Z0H (KDIM1D))
ALLOCATE(ZP_QSURF (KDIM1D))
-ALLOCATE(ZP_RN (KDIM1D))
-ALLOCATE(ZP_H (KDIM1D))
-ALLOCATE(ZP_LE (KDIM1D))
-ALLOCATE(ZP_LEI (KDIM1D))
-ALLOCATE(ZP_GFLUX (KDIM1D))
-ALLOCATE(ZP_T2M (KDIM1D))
-ALLOCATE(ZP_Q2M (KDIM1D))
-ALLOCATE(ZP_HU2M (KDIM1D))
-ALLOCATE(ZP_ZON10M (KDIM1D))
-ALLOCATE(ZP_MER10M (KDIM1D))
-
+IF ( GSTATPROF_SURF ) THEN
+ ALLOCATE(ZP_RN (KDIM1D))
+ ALLOCATE(ZP_H (KDIM1D))
+ ALLOCATE(ZP_LE (KDIM1D))
+ ALLOCATE(ZP_LEI (KDIM1D))
+ ALLOCATE(ZP_GFLUX (KDIM1D))
+ ALLOCATE(ZP_T2M (KDIM1D))
+ ALLOCATE(ZP_Q2M (KDIM1D))
+ ALLOCATE(ZP_HU2M (KDIM1D))
+END IF
+IF ( CPROGRAM == 'DIAG' .OR. GSTATPROF_SURF ) THEN
+ ALLOCATE(ZP_ZON10M (KDIM1D))
+ ALLOCATE(ZP_MER10M (KDIM1D))
+END IF
+!
!* explicit coupling only
ALLOCATE(ZP_PEW_A_COEF (KDIM1D))
ALLOCATE(ZP_PEW_B_COEF (KDIM1D))
@@ -1090,22 +1303,30 @@ ALLOCATE(ZP_PET_A_COEF (KDIM1D))
ALLOCATE(ZP_PEQ_A_COEF (KDIM1D))
ALLOCATE(ZP_PET_B_COEF (KDIM1D))
ALLOCATE(ZP_PEQ_B_COEF (KDIM1D))
-
-ZP_TSUN(:) = RESHAPE(ZTSUN(IIB:IIE,IJB:IJE), ISHAPE_1)
-ZP_TA(:) = RESHAPE(ZTA(IIB:IIE,IJB:IJE), ISHAPE_1)
-ZP_QA(:) = RESHAPE(ZQA(IIB:IIE,IJB:IJE), ISHAPE_1)
-ZP_RHOA(:) = RESHAPE(ZRHOA(IIB:IIE,IJB:IJE), ISHAPE_1)
-ZP_U(:) = RESHAPE(ZU(IIB:IIE,IJB:IJE), ISHAPE_1)
-ZP_V(:) = RESHAPE(ZV(IIB:IIE,IJB:IJE), ISHAPE_1)
-ZP_PS(:) = RESHAPE(ZPS(IIB:IIE,IJB:IJE), ISHAPE_1)
-ZP_PA(:) = RESHAPE(ZPA(IIB:IIE,IJB:IJE), ISHAPE_1)
-ZP_ZS(:) = RESHAPE(XZS(IIB:IIE,IJB:IJE), ISHAPE_1)
-ZP_CO2(:) = RESHAPE(ZCO2(IIB:IIE,IJB:IJE), ISHAPE_1)
-ZP_SNOW(:) = RESHAPE(ZSNOW(IIB:IIE,IJB:IJE), ISHAPE_1)
-ZP_RAIN(:) = RESHAPE(ZRAIN(IIB:IIE,IJB:IJE), ISHAPE_1)
-ZP_ZREF(:) = RESHAPE(ZZREF(IIB:IIE,IJB:IJE), ISHAPE_1)
-ZP_ZWS(:) = RESHAPE(XZWS(IIB:IIE,IJB:IJE), ISHAPE_1)
-
+!
+! 2D variables or surface only
+!
+ZP_TSUN(:) = RESHAPE(ZTSUN(IIB:IIE,IJB:IJE), ISHAPE_1)
+ZP_PS(:) = RESHAPE(ZPS(IIB:IIE,IJB:IJE), ISHAPE_1)
+ZP_ZS(:) = RESHAPE(XZS(IIB:IIE,IJB:IJE), ISHAPE_1)
+ZP_CO2(:) = RESHAPE(ZCO2(IIB:IIE,IJB:IJE), ISHAPE_1)
+ZP_SNOW(:) = RESHAPE(ZSNOW(IIB:IIE,IJB:IJE), ISHAPE_1)
+ZP_RAIN(:) = RESHAPE(ZRAIN(IIB:IIE,IJB:IJE), ISHAPE_1)
+ZP_ZWS(:) = RESHAPE(XZWS(IIB:IIE,IJB:IJE), ISHAPE_1)
+!
+! Variables that are coupled on multiple levels
+!
+DO JLAYER=1,NLEV_COUPLE
+ ZP_ZREF(:,JLAYER) = RESHAPE(ZZREF(IIB:IIE,IJB:IJE,JLAYER), ISHAPE_1)
+ ZP_PA(:,JLAYER) = RESHAPE(ZPA(IIB:IIE,IJB:IJE,JLAYER), ISHAPE_1)
+ ZP_TA(:,JLAYER) = RESHAPE(ZTA(IIB:IIE,IJB:IJE,JLAYER), ISHAPE_1)
+ ZP_QA(:,JLAYER) = RESHAPE(ZQA(IIB:IIE,IJB:IJE,JLAYER), ISHAPE_1)
+ ZP_RHOA(:,JLAYER) = RESHAPE(ZRHOA(IIB:IIE,IJB:IJE,JLAYER), ISHAPE_1)
+ IF(CTURB/='NONE') ZP_TKE(:,JLAYER) = RESHAPE(ZTKE(IIB:IIE,IJB:IJE,JLAYER), ISHAPE_1)
+ ZP_U(:,JLAYER) = RESHAPE(ZU(IIB:IIE,IJB:IJE,JLAYER), ISHAPE_1)
+ ZP_V(:,JLAYER) = RESHAPE(ZV(IIB:IIE,IJB:IJE,JLAYER), ISHAPE_1)
+END DO
+!
DO JLAYER=1,NSV
ZP_SV(:,JLAYER) = RESHAPE(XSVT(IIB:IIE,IJB:IJE,IKB,JLAYER), ISHAPE_1)
END DO
@@ -1118,29 +1339,29 @@ END IF
!
!chemical conversion : from part/part to molec./m3
DO JLAYER=NSV_CHEMBEG,NSV_CHEMEND
- ZP_SV(:,JLAYER) = ZP_SV(:,JLAYER) * XAVOGADRO * ZP_RHOA(:) / XMD
+ ZP_SV(:,JLAYER) = ZP_SV(:,JLAYER) * XAVOGADRO * ZP_RHOA(:,1) / XMD
END DO
DO JLAYER=NSV_AERBEG,NSV_AEREND
- ZP_SV(:,JLAYER) = ZP_SV(:,JLAYER) * XAVOGADRO * ZP_RHOA(:) / XMD
+ ZP_SV(:,JLAYER) = ZP_SV(:,JLAYER) * XAVOGADRO * ZP_RHOA(:,1) / XMD
END DO
!dust conversion : from part/part to kg/m3
DO JLAYER=NSV_DSTBEG,NSV_DSTEND
- ZP_SV(:,JLAYER) = ZP_SV(:,JLAYER) * XMOLARWEIGHT_DUST* ZP_RHOA(:) / XMD
+ ZP_SV(:,JLAYER) = ZP_SV(:,JLAYER) * XMOLARWEIGHT_DUST* ZP_RHOA(:,1) / XMD
END DO
!sea salt conversion : from part/part to kg/m3
DO JLAYER=NSV_SLTBEG,NSV_SLTEND
- ZP_SV(:,JLAYER) = ZP_SV(:,JLAYER) * XMOLARWEIGHT_SALT* ZP_RHOA(:) / XMD
+ ZP_SV(:,JLAYER) = ZP_SV(:,JLAYER) * XMOLARWEIGHT_SALT* ZP_RHOA(:,1) / XMD
END DO
!
!blowing snow conversion : from kg(snow)/kg(dry air) to kg(snow)/m3
DO JLAYER=NSV_SNWBEG,NSV_SNWEND
- ZP_SV(:,JLAYER) = ZP_SV(:,JLAYER) * ZP_RHOA(:)
+ ZP_SV(:,JLAYER) = ZP_SV(:,JLAYER) * ZP_RHOA(:,1)
END DO
IF(LBLOWSNOW) THEN ! Convert 2D blowing snow fields
! from kg(snow)/kg(dry air) to kg(snow)/m3
DO JLAYER=(NSV+1),KSV_SURF
- ZP_SV(:,JLAYER) = ZP_SV(:,JLAYER) * ZP_RHOA(:)
+ ZP_SV(:,JLAYER) = ZP_SV(:,JLAYER) * ZP_RHOA(:,1)
END DO
END IF
!
@@ -1170,18 +1391,35 @@ ISHAPE_2 = (/KDIM1,KDIM2/)
!
! Arguments in call to surface:
!
-ZSFTH = XUNDEF_SFX
-ZSFTQ = XUNDEF_SFX
+ZSFTH = XUNDEF_SFX
+ZSFTH_SURF = XUNDEF_SFX
+ZSFTH_WALL = XUNDEF_SFX
+ZSFTH_ROOF = XUNDEF_SFX
+ZCD_ROOF = XUNDEF_SFX
+ZSFTQ = XUNDEF_SFX
+ZSFTQ_SURF = XUNDEF_SFX
+ZSFTQ_WALL = XUNDEF_SFX
+ZSFTQ_ROOF = XUNDEF_SFX
+!
IF (NSV>0) ZSFTS = XUNDEF_SFX
ZSFCO2 = XUNDEF_SFX
ZSFU = XUNDEF_SFX
ZSFV = XUNDEF_SFX
!
-ZSFTH (IIB:IIE,IJB:IJE) = RESHAPE(ZP_SFTH(:), ISHAPE_2)
-ZSFTQ (IIB:IIE,IJB:IJE) = RESHAPE(ZP_SFTQ(:), ISHAPE_2)
+ZSFTH (IIB:IIE,IJB:IJE) = RESHAPE(ZP_SFTH(:), ISHAPE_2)
+ZSFTH_SURF (IIB:IIE,IJB:IJE) = RESHAPE(ZP_SFTH_SURF(:), ISHAPE_2)
+ZSFTH_WALL (IIB:IIE,IJB:IJE) = RESHAPE(ZP_SFTH_WALL(:), ISHAPE_2)
+ZSFTH_ROOF (IIB:IIE,IJB:IJE) = RESHAPE(ZP_SFTH_ROOF(:), ISHAPE_2)
+ZCD_ROOF (IIB:IIE,IJB:IJE) = RESHAPE(ZP_CD_ROOF(:), ISHAPE_2)
+ZSFTQ (IIB:IIE,IJB:IJE) = RESHAPE(ZP_SFTQ(:), ISHAPE_2)
+ZSFTQ_SURF (IIB:IIE,IJB:IJE) = RESHAPE(ZP_SFTQ_SURF(:), ISHAPE_2)
+ZSFTQ_WALL (IIB:IIE,IJB:IJE) = RESHAPE(ZP_SFTQ_WALL(:), ISHAPE_2)
+ZSFTQ_ROOF (IIB:IIE,IJB:IJE) = RESHAPE(ZP_SFTQ_ROOF(:), ISHAPE_2)
+!
DO JLAYER=1,SIZE(PSFSV,3)
ZSFTS (IIB:IIE,IJB:IJE,JLAYER) = RESHAPE(ZP_SFTS(:,JLAYER), ISHAPE_2)
END DO
+!
ZSFCO2 (IIB:IIE,IJB:IJE) = RESHAPE(ZP_SFCO2(:), ISHAPE_2)
ZSFU (IIB:IIE,IJB:IJE) = RESHAPE(ZP_SFU(:), ISHAPE_2)
ZSFV (IIB:IIE,IJB:IJE) = RESHAPE(ZP_SFV(:), ISHAPE_2)
@@ -1195,7 +1433,7 @@ IF(LBLOWSNOW) THEN
END DO
END IF
!
-IF (LDIAG_IN_RUN) THEN
+IF ( GSTATPROF_SURF .AND. CPROGRAM /= 'DIAG' ) THEN
XCURRENT_RN (IIB:IIE,IJB:IJE) = RESHAPE(ZP_RN(:), ISHAPE_2)
XCURRENT_H (IIB:IIE,IJB:IJE) = RESHAPE(ZP_H (:), ISHAPE_2)
XCURRENT_LE (IIB:IIE,IJB:IJE) = RESHAPE(ZP_LE(:), ISHAPE_2)
@@ -1204,10 +1442,12 @@ IF (LDIAG_IN_RUN) THEN
XCURRENT_T2M (IIB:IIE,IJB:IJE) = RESHAPE(ZP_T2M(:), ISHAPE_2)
XCURRENT_Q2M (IIB:IIE,IJB:IJE) = RESHAPE(ZP_Q2M(:), ISHAPE_2)
XCURRENT_HU2M (IIB:IIE,IJB:IJE) = RESHAPE(ZP_HU2M(:), ISHAPE_2)
+END IF
+IF ( GSTATPROF_SURF .OR. CPROGRAM == 'DIAG' ) THEN
XCURRENT_ZON10M (IIB:IIE,IJB:IJE) = RESHAPE(ZP_ZON10M(:), ISHAPE_2)
XCURRENT_MER10M (IIB:IIE,IJB:IJE) = RESHAPE(ZP_MER10M(:), ISHAPE_2)
- XCURRENT_ZWS (IIB:IIE,IJB:IJE) = RESHAPE(ZP_ZWS(:), ISHAPE_2)
-ENDIF
+ ! XCURRENT_ZWS (IIB:IIE,IJB:IJE) = RESHAPE(ZP_ZWS(:), ISHAPE_2)
+END IF
!
DO JLAYER=1,SIZE(PDIR_ALB,3)
PDIR_ALB(IIB:IIE,IJB:IJE,JLAYER) = RESHAPE(ZP_DIR_ALB(:,JLAYER), ISHAPE_2)
@@ -1224,6 +1464,7 @@ DEALLOCATE(ZP_V )
DEALLOCATE(ZP_QA )
DEALLOCATE(ZP_TA )
DEALLOCATE(ZP_RHOA )
+DEALLOCATE(ZP_TKE )
DEALLOCATE(ZP_SV )
DEALLOCATE(ZP_CO2 )
DEALLOCATE(ZP_RAIN )
@@ -1234,9 +1475,16 @@ DEALLOCATE(ZP_SCA_SW )
DEALLOCATE(ZP_PS )
DEALLOCATE(ZP_PA )
DEALLOCATE(ZP_ZWS )
-
-DEALLOCATE(ZP_SFTQ )
-DEALLOCATE(ZP_SFTH )
+!
+DEALLOCATE(ZP_SFTQ )
+DEALLOCATE(ZP_SFTQ_SURF)
+DEALLOCATE(ZP_SFTQ_WALL)
+DEALLOCATE(ZP_SFTQ_ROOF)
+DEALLOCATE(ZP_SFTH )
+DEALLOCATE(ZP_SFTH_SURF)
+DEALLOCATE(ZP_SFTH_WALL)
+DEALLOCATE(ZP_SFTH_ROOF)
+DEALLOCATE(ZP_CD_ROOF)
DEALLOCATE(ZP_SFTS )
DEALLOCATE(ZP_SFCO2 )
DEALLOCATE(ZP_SFU )
@@ -1245,16 +1493,20 @@ DEALLOCATE(ZP_TSRAD )
DEALLOCATE(ZP_DIR_ALB )
DEALLOCATE(ZP_SCA_ALB )
DEALLOCATE(ZP_EMIS )
-DEALLOCATE(ZP_RN )
-DEALLOCATE(ZP_H )
-DEALLOCATE(ZP_LE )
-DEALLOCATE(ZP_LEI )
-DEALLOCATE(ZP_GFLUX )
-DEALLOCATE(ZP_T2M )
-DEALLOCATE(ZP_Q2M )
-DEALLOCATE(ZP_HU2M )
-DEALLOCATE(ZP_ZON10M )
-DEALLOCATE(ZP_MER10M )
+IF ( GSTATPROF_SURF ) THEN
+ DEALLOCATE(ZP_RN )
+ DEALLOCATE(ZP_H )
+ DEALLOCATE(ZP_LE )
+ DEALLOCATE(ZP_LEI )
+ DEALLOCATE(ZP_GFLUX )
+ DEALLOCATE(ZP_T2M )
+ DEALLOCATE(ZP_Q2M )
+ DEALLOCATE(ZP_HU2M )
+END IF
+IF ( CPROGRAM == 'DIAG' .OR. GSTATPROF_SURF ) THEN
+ DEALLOCATE(ZP_ZON10M )
+ DEALLOCATE(ZP_MER10M )
+END IF
DEALLOCATE(ZP_PEW_A_COEF )
DEALLOCATE(ZP_PEW_B_COEF )
diff --git a/src/mesonh/ext/ice4_sedimentation_split_momentum.f90 b/src/mesonh/ext/ice4_sedimentation_split_momentum.f90
deleted file mode 100644
index 8b137891791fe96927ad78e64b0aad7bded08bdc..0000000000000000000000000000000000000000
--- a/src/mesonh/ext/ice4_sedimentation_split_momentum.f90
+++ /dev/null
@@ -1 +0,0 @@
-
diff --git a/src/mesonh/ext/ice_adjust_bis.f90 b/src/mesonh/ext/ice_adjust_bis.f90
index e530d5c21f91b7e143b2d7240f669e4df7c181bd..1046304293aeb1838a0f7d5a52659ea2282f69d3 100644
--- a/src/mesonh/ext/ice_adjust_bis.f90
+++ b/src/mesonh/ext/ice_adjust_bis.f90
@@ -65,8 +65,8 @@ END MODULE MODI_ICE_ADJUST_BIS
!* 0. DECLARATIONS
! ------------
!
-USE MODD_CST, ONLY : XCPD, XRD, XP00, CST
-USE MODD_NEB_n, ONLY : NEBN
+USE MODD_CST, ONLY: XCPD, XRD, XP00, CST
+USE MODD_NEB_n, ONLY: NEBN
!
USE MODI_COMPUTE_FUNCTION_THERMO
USE MODI_THLRT_FROM_THRVRCRI
diff --git a/src/mesonh/ext/ini_budget.f90 b/src/mesonh/ext/ini_budget.f90
index 2e61b72bed99db11509810ea930150f476d25f4d..a5ed1e2d4eb85a0fc8a6255941442b5bd135bbc3 100644
--- a/src/mesonh/ext/ini_budget.f90
+++ b/src/mesonh/ext/ini_budget.f90
@@ -106,7 +106,7 @@ end subroutine Budget_preallocate
OHORELAX_UVWTH,OHORELAX_RV,OHORELAX_RC,OHORELAX_RR, &
OHORELAX_RI,OHORELAX_RS, OHORELAX_RG, OHORELAX_RH,OHORELAX_TKE, &
OHORELAX_SV, OVE_RELAX, ove_relax_grd, OCHTRANS, &
- ONUDGING,ODRAGTREE,ODEPOTREE, OAERO_EOL, &
+ ONUDGING,ODRAGTREE,ODEPOTREE, ODRAGBLDG, OAERO_EOL, &
HRAD,HDCONV,HSCONV,HTURB,HTURBDIM,HCLOUD )
! #################################################################
!
@@ -208,8 +208,10 @@ end subroutine Budget_preallocate
! P. Wautelet 02/03/2021: budgets: add terms for blowing snow
! P. Wautelet 04/03/2021: budgets: add terms for drag due to buildings
! P. Wautelet 17/03/2021: choose source terms for budgets with character strings instead of multiple integer variables
+! 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
@@ -229,6 +231,7 @@ use modd_dyn_n, only: xtstep, locean
use modd_elec_descr, only: linductive, lrelax2fw_ion
use modd_field, only: TYPEREAL
use modd_fire_n, only: lblaze
+use modd_neb_n, only: lsubg_cond
use modd_nsv, only: nsv_aerbeg, nsv_aerend, nsv_aerdepbeg, nsv_aerdepend, nsv_c2r2beg, nsv_c2r2end, &
nsv_chembeg, nsv_chemend, nsv_chicbeg, nsv_chicend, nsv_csbeg, nsv_csend, &
nsv_dstbeg, nsv_dstend, nsv_dstdepbeg, nsv_dstdepend, nsv_elecbeg, nsv_elecend, &
@@ -255,7 +258,6 @@ use modd_param_lima, only: laero_mass_lima => laero_mass, lacti_lima => lacti,
nmom_c, nmom_r, nmom_i, nmom_s, nmom_g, nmom_h, nmod_ccn, nmod_ifn, nmod_imm
use modd_ref, only: lcouples
use modd_salt, only: lsalt
-use modd_neb_n, only: lsubg_cond
use modd_viscosity, only: lvisc, lvisc_r, lvisc_sv, lvisc_th, lvisc_uvw
USE MODE_ll
@@ -302,6 +304,7 @@ LOGICAL, INTENT(IN) :: OCHTRANS ! switch to activate convective
LOGICAL, INTENT(IN) :: ONUDGING ! switch to activate nudging
LOGICAL, INTENT(IN) :: ODRAGTREE ! switch to activate vegetation drag
LOGICAL, INTENT(IN) :: ODEPOTREE ! switch to activate droplet deposition on tree
+LOGICAL, INTENT(IN) :: ODRAGBLDG ! switch to activate building drag
LOGICAL, INTENT(IN) :: OAERO_EOL ! switch to activate wind turbine wake
CHARACTER (LEN=*), INTENT(IN) :: HRAD ! type of the radiation scheme
CHARACTER (LEN=*), INTENT(IN) :: HDCONV ! type of the deep convection scheme
@@ -1038,6 +1041,11 @@ if ( lbu_rth ) then
tzsource%lavailable = lblaze
call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+ tzsource%cmnhname = 'DRAGB'
+ tzsource%clongname = 'heat released by buildings'
+ tzsource%lavailable = ldragbldg
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
tzsource%cmnhname = 'VTURB'
tzsource%clongname = 'vertical turbulent diffusion'
tzsource%lavailable = hturb == 'TKEL'
@@ -1246,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'
@@ -1256,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'
@@ -1273,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 )
@@ -1463,6 +1471,11 @@ if ( tbudgets(NBUDGET_RV)%lenabled ) then
tzsource%lavailable = hdconv == 'KAFR' .OR. hsconv == 'KAFR'
call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+ tzsource%cmnhname = 'DRAGB'
+ tzsource%clongname = 'vapor released by buildings'
+ tzsource%lavailable = ldragbldg
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
tzsource%cmnhname = 'BLAZE'
tzsource%clongname = 'blaze fire model contribution'
tzsource%lavailable = lblaze
@@ -1574,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'
@@ -1584,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'
@@ -1601,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 )
@@ -1729,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'
@@ -1769,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'
@@ -1823,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'
@@ -1879,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 )
@@ -1982,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'
@@ -2041,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'
@@ -2108,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 )
@@ -2224,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'
@@ -2367,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 )
@@ -2468,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'
@@ -2558,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 )
@@ -2657,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'
@@ -2766,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 )
@@ -2927,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 )
@@ -3749,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.
@@ -3767,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.
@@ -3784,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'
@@ -3792,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.
@@ -3852,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'
@@ -3860,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
@@ -3928,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.
@@ -3980,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.
@@ -3987,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'
@@ -3995,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
@@ -4043,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'
@@ -4053,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.
@@ -4106,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.
@@ -4121,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.
@@ -4128,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'
@@ -4155,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'
@@ -4168,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.
@@ -4185,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'
@@ -4193,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/mesonh/ext/ini_cturb.f90 b/src/mesonh/ext/ini_cturb.f90
deleted file mode 100644
index 8b137891791fe96927ad78e64b0aad7bded08bdc..0000000000000000000000000000000000000000
--- a/src/mesonh/ext/ini_cturb.f90
+++ /dev/null
@@ -1 +0,0 @@
-
diff --git a/src/mesonh/ext/ini_elecn.f90 b/src/mesonh/ext/ini_elecn.f90
index e00ea14d3a6f0eff266625c09fc945a1c7805d80..339e30c483b7869fc8ff62913a8a165a350d342b 100644
--- a/src/mesonh/ext/ini_elecn.f90
+++ b/src/mesonh/ext/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_ARGSLIST_ll, ONLY: LIST_ll
+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 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/mesonh/ext/ini_flash_geom_elec.f90 b/src/mesonh/ext/ini_flash_geom_elec.f90
index 3c5faece3492d78a958b5bfe54b815164611abde..e543b5ca95a9e6419e3f8278622c7ce3a331b107 100644
--- a/src/mesonh/ext/ini_flash_geom_elec.f90
+++ b/src/mesonh/ext/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/mesonh/ext/ini_lb.f90 b/src/mesonh/ext/ini_lb.f90
index faa09698bf58497f08539e7305b5f0fc0d01487c..f55708c99157899111d3fb33e0b2df4aaca35f96 100644
--- a/src/mesonh/ext/ini_lb.f90
+++ b/src/mesonh/ext/ini_lb.f90
@@ -139,7 +139,6 @@ SUBROUTINE INI_LB(TPINIFILE,OLSOURCE,KSV, &
!
!* 0. DECLARATIONS
!
-USE MODD_TURB_n, ONLY: XTKEMIN
USE MODD_CONF, ONLY: LCPL_AROME
use modd_field, only: NMNHDIM_UNKNOWN, tfieldmetadata, TYPELOG, TYPEREAL
USE MODD_IO, ONLY: TFILEDATA
@@ -151,6 +150,7 @@ USE MODD_NSV, ONLY: NSV, NSV_CS, NSV_CSBEG, NSV_CSEND, NSV_LIMA_BEG,
NSV_SNWBEG, NSV_SNWEND, NSV_USER, TSVLIST
USE MODD_PARAMETERS, ONLY: JPHEXT, JPSVNAMELGTMAX, NLONGNAMELGTMAX, NMNHNAMELGTMAX
USE MODD_PARAM_LIMA, ONLY: NMOD_CCN, NMOD_IFN
+USE MODD_TURB_n, ONLY: XTKEMIN
!
USE MODE_IO_FIELD_READ, only: IO_Field_read, IO_Field_read_lb
USE MODE_MSG
diff --git a/src/mesonh/ext/ini_micron.f90 b/src/mesonh/ext/ini_micron.f90
index a4934ed55d020c7cdee8d443fa663083e790f54d..091b69f685fdca492605011e460cab3b1a783a07 100644
--- a/src/mesonh/ext/ini_micron.f90
+++ b/src/mesonh/ext/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/mesonh/ext/ini_modeln.f90 b/src/mesonh/ext/ini_modeln.f90
index edbb56091a02f205040239abed144d7a789e5473..790a248208cddd4b6386ca33a76c2a999e210393 100644
--- a/src/mesonh/ext/ini_modeln.f90
+++ b/src/mesonh/ext/ini_modeln.f90
@@ -292,8 +292,11 @@ END MODULE MODI_INI_MODEL_n
! S. Riette 04/2020: XHL* fields
! F. Auguste 02/2021: add IBM
! T.Nigel 02/2021: add turbulence recycling
-! J.L.Redelsperger 06/2011: OCEAN case
-! A. Costes 12/2021: Blaze fire model
+! 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
+! C. Barthe 03/2023: if cloud electricity is activated, both ini_micron and ini_elecn are called
!---------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -332,6 +335,7 @@ USE MODD_DEF_EDDY_FLUX_n ! for VT and WT fluxes
USE MODD_DEF_EDDYUV_FLUX_n ! FOR UV
USE MODD_DIAG_FLAG, only: LCHEMDIAG, CSPEC_BU_DIAG
USE MODD_DIM_n
+USE MODD_DRAGBLDG_n
USE MODD_DRAG_n
USE MODD_DRAGTREE_n
USE MODD_DUST
@@ -367,6 +371,7 @@ USE MODD_MEAN_FIELD
USE MODD_MEAN_FIELD_n
USE MODD_METRICS_n
USE MODD_MNH_SURFEX_n
+USE MODD_NEB_n, only: LSUBG_COND, LSTATNW
USE MODD_NESTING, only: CDAD_NAME, NDAD, NDT_2_WAY, NDTRATIO, NDXRATIO_ALL, NDYRATIO_ALL
USE MODD_NSV
USE MODD_NSV
@@ -399,13 +404,15 @@ USE MODD_SURF_PAR, only: XUNDEF_SFX => XUNDEF
USE MODD_TIME
USE MODD_TIME_n
USE MODD_TURB_n
-USE MODD_NEB_n, only: LSUBG_COND, LSTATNW
USE MODD_VAR_ll, only: IP
USE MODE_GATHER_ll
USE MODE_INI_AIRCRAFT_BALLOON, only: INI_AIRCRAFT_BALLOON
use mode_ini_budget, only: Budget_preallocate, Ini_budget
+USE MODE_INI_MFSHALL, ONLY: INI_MFSHALL
USE MODE_INI_ONE_WAY_n
+USE MODE_INIT_AEROSOL_PROPERTIES, ONLY: INIT_AEROSOL_PROPERTIES
+USE MODE_INI_TURB, ONLY: INI_TURB
USE MODE_IO
USE MODE_IO_FIELD_READ, only: IO_Field_read
USE MODE_IO_FILE, only: IO_File_open
@@ -444,8 +451,6 @@ USE MODI_INI_LES_N
USE MODI_INI_LG
USE MODI_INI_LW_SETUP
USE MODI_INI_MICRO_n
-USE MODE_INI_TURB, ONLY: INI_TURB
-USE MODE_INI_MFSHALL, ONLY: INI_MFSHALL
USE MODI_INI_POSPROFILER_n
USE MODI_INI_RADIATIONS
USE MODI_INI_RADIATIONS_ECMWF
@@ -455,7 +460,6 @@ USE MODI_INI_SPAWN_LS_n
USE MODI_INI_SURF_RAD
USE MODI_INI_SURFSTATION_n
USE MODI_INI_SW_SETUP
-USE MODE_INIT_AEROSOL_PROPERTIES, ONLY: INIT_AEROSOL_PROPERTIES
#ifdef MNH_FOREFIRE
USE MODI_INIT_FOREFIRE_n
#endif
@@ -525,9 +529,6 @@ INTEGER :: IIU_B,IJU_B
INTEGER :: IIU_SXP2_YP1_Z_ll,IJU_SXP2_YP1_Z_ll,IKU_SXP2_YP1_Z_ll
!
REAL, DIMENSION(:,:), ALLOCATABLE :: ZCO2 ! CO2 concentration near the surface
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZSEA ! sea fraction
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZTOWN ! town fraction
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZBARE ! bare soil fraction
!
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZDIR_ALB ! direct albedo
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZSCA_ALB ! diffuse albedo
@@ -778,6 +779,17 @@ IF (LMEAN_FIELD) THEN
ALLOCATE(XTKEM_MEAN(0,0,0))
END IF
ALLOCATE(XPABSM_MEAN(IIU,IJU,IKU)) ; XPABSM_MEAN = 0.0
+ ALLOCATE(XQ_MEAN(IIU,IJU,IKU)) ; XQ_MEAN = 0.0
+ ALLOCATE(XRH_W_MEAN(IIU,IJU,IKU)) ; XRH_W_MEAN = 0.0
+ ALLOCATE(XRH_I_MEAN(IIU,IJU,IKU)) ; XRH_I_MEAN = 0.0
+ ALLOCATE(XRH_P_MEAN(IIU,IJU,IKU)) ; XRH_P_MEAN = 0.0
+ ALLOCATE(XRH_W_MAXCOL_MEAN(IIU,IJU)) ; XRH_W_MAXCOL_MEAN = 0.0
+ ALLOCATE(XRH_I_MAXCOL_MEAN(IIU,IJU)) ; XRH_I_MAXCOL_MEAN = 0.0
+ ALLOCATE(XRH_P_MAXCOL_MEAN(IIU,IJU)) ; XRH_P_MAXCOL_MEAN = 0.0
+ ALLOCATE(XWIFF_MEAN(IIU,IJU,IKU)) ; XWIFF_MEAN = 0.0
+ ALLOCATE(XWIDD_MEAN(IIU,IJU,IKU)) ; XWIDD_MEAN = 0.0
+ ALLOCATE(XWIFF_MAX (IIU,IJU,IKU)) ; XWIFF_MAX = 0.0
+ ALLOCATE(XWIDD_MAX (IIU,IJU,IKU)) ; XWIDD_MAX = 0.0
!
ALLOCATE(XU2_M2(IIU,IJU,IKU)) ; XU2_M2 = 0.0
!
@@ -1832,7 +1844,7 @@ IF ( CBUTYPE /= "NONE" .AND. NBUMOD == KMI ) THEN
LHORELAX_UVWTH,LHORELAX_RV, LHORELAX_RC,LHORELAX_RR, &
LHORELAX_RI,LHORELAX_RS,LHORELAX_RG, LHORELAX_RH,LHORELAX_TKE, &
LHORELAX_SV, LVE_RELAX, LVE_RELAX_GRD, &
- LCHTRANS,LNUDGING,LDRAGTREE,LDEPOTREE,LMAIN_EOL, &
+ LCHTRANS,LNUDGING,LDRAGTREE,LDEPOTREE,LDRAGBLDG,LMAIN_EOL, &
CRAD,CDCONV,CSCONV,CTURB,CTURBDIM,CCLOUD )
END IF
!
@@ -2209,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 )
@@ -2226,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
!
!-------------------------------------------------------------------------------
@@ -2642,17 +2653,6 @@ IF (CRAD == 'ECMW') THEN
!* get cover mask for aerosols
!
IF (CPROGRAM=='MESONH' .OR. CPROGRAM=='DIAG ') THEN
- ALLOCATE(ZSEA(IIU,IJU))
- ALLOCATE(ZTOWN(IIU,IJU))
- ALLOCATE(ZBARE(IIU,IJU))
- IF (CSURF=='EXTE') THEN
- CALL GOTO_SURFEX(KMI)
- CALL MNHGET_SURF_PARAM_n(PSEA=ZSEA,PTOWN=ZTOWN,PBARE=ZBARE)
- ELSE
- ZSEA (:,:) = 1.
- ZTOWN(:,:) = 0.
- ZBARE(:,:) = 0.
- END IF
!
IF ( CAOP=='EXPL' .AND. LDUST .AND. KMI==1) THEN
ALLOCATE( XEXT_COEFF_WVL_LKT_DUST( NMAX_RADIUS_LKT_DUST, NMAX_SIGMA_LKT_DUST, NMAX_WVL_SW_DUST ) )
@@ -2670,9 +2670,8 @@ IF (CRAD == 'ECMW') THEN
!
CALL INI_RADIATIONS_ECMWF (XZHAT,XPABST,XTHT,XTSRAD,XLAT,XLON,TDTCUR,TDTEXP, &
CLW,NDLON,NFLEV,NFLUX,NRAD,NSWB_OLD,CAER,NAER,NSTATM, &
- XSTATM,ZSEA,ZTOWN,ZBARE,XOZON, XAER,XDST_WL, LSUBG_COND )
+ XSTATM, XOZON, XAER,XDST_WL, LSUBG_COND )
!
- DEALLOCATE(ZSEA,ZTOWN,ZBARE)
ALLOCATE (XAER_CLIM(SIZE(XAER,1),SIZE(XAER,2),SIZE(XAER,3),SIZE(XAER,4)))
XAER_CLIM(:,:,:,:) =XAER(:,:,:,:)
!
@@ -2683,23 +2682,11 @@ ELSE IF (CRAD == 'ECRA') THEN
!* get cover mask for aerosols
!
IF (CPROGRAM=='MESONH' .OR. CPROGRAM=='DIAG ') THEN
- ALLOCATE(ZSEA(IIU,IJU))
- ALLOCATE(ZTOWN(IIU,IJU))
- ALLOCATE(ZBARE(IIU,IJU))
- IF (CSURF=='EXTE') THEN
- CALL GOTO_SURFEX(KMI)
- CALL MNHGET_SURF_PARAM_n(PSEA=ZSEA,PTOWN=ZTOWN,PBARE=ZBARE)
- ELSE
- ZSEA (:,:) = 1.
- ZTOWN(:,:) = 0.
- ZBARE(:,:) = 0.
- END IF
!
CALL INI_RADIATIONS_ECRAD (XZHAT,XPABST,XTHT,XTSRAD,XLAT,XLON,TDTCUR,TDTEXP, &
CLW,NDLON,NFLEV,NFLUX,NRAD,NSWB_OLD,CAER,NAER,NSTATM, &
- XSTATM,ZSEA,ZTOWN,ZBARE,XOZON, XAER,XDST_WL, LSUBG_COND )
+ XSTATM, XOZON, XAER,XDST_WL, LSUBG_COND )
- DEALLOCATE(ZSEA,ZTOWN,ZBARE)
ALLOCATE (XAER_CLIM(SIZE(XAER,1),SIZE(XAER,2),SIZE(XAER,3),SIZE(XAER,4)))
XAER_CLIM(:,:,:,:) = XAER(:,:,:,:)
!
diff --git a/src/mesonh/ext/ini_nsv.f90 b/src/mesonh/ext/ini_nsv.f90
index 0d7358737ad6b6fbc37b3254fb5867691b27b86d..5666ade6a6f912e5718a6566bfe9a70802bfffce 100644
--- a/src/mesonh/ext/ini_nsv.f90
+++ b/src/mesonh/ext/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
@@ -122,8 +125,8 @@ USE MODD_RAIN_C2R2_DESCR, ONLY: C2R2NAMES
USE MODD_SALT, ONLY: CSALTNAMES, CDESLTNAMES, JPSALTORDER, &
LRGFIX_SLT, LSALT, LSLTINIT, LSLTPRES, LDEPOS_SLT, LVARSIG_SLT, NMODE_SLT, YPDESLT_INI, YPSALT_INI
-USE MODE_MSG
USE MODE_LIMA_UPDATE_NSV, ONLY: LIMA_UPDATE_NSV
+USE MODE_MSG
USE MODI_CH_AER_INIT_SOA, ONLY: CH_AER_INIT_SOA
USE MODI_CH_INIT_SCHEME_n, ONLY: CH_INIT_SCHEME_n
@@ -230,39 +233,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 +497,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/mesonh/ext/ini_radar.f90 b/src/mesonh/ext/ini_radar.f90
index efe222510b6882e595a88afd90253a4ce5a7ec2c..671d1f6e9763ed8a2ee69ed0bab08ce1f3ddd18f 100644
--- a/src/mesonh/ext/ini_radar.f90
+++ b/src/mesonh/ext/ini_radar.f90
@@ -214,10 +214,10 @@ CONTAINS
IMPLICIT NONE
- REAL, INTENT(IN) :: PALPHA ! first shape parameter of the dimensionnal distribution
- REAL, INTENT(IN) :: PNU ! second shape parameter of the dimensionnal distribution
- REAL, INTENT(IN) :: PP ! order of the moment
- REAL :: PMOMG ! result: moment of order ZP
+ REAL, INTENT(IN) :: PALPHA ! first shape parameter of the dimensionnal distribution
+ REAL, INTENT(IN) :: PNU ! second shape parameter of the dimensionnal distribution
+ REAL, INTENT(IN) :: PP ! order of the moment
+ REAL :: PMOMG ! result: moment of order ZP
!------------------------------------------------------------------------------
diff --git a/src/mesonh/ext/ini_segn.f90 b/src/mesonh/ext/ini_segn.f90
index 8e034ced7f1cf068fda60861f09b102e8dc4604f..9d78f2b6649056b60c9f99226747fe2176e984b9 100644
--- a/src/mesonh/ext/ini_segn.f90
+++ b/src/mesonh/ext/ini_segn.f90
@@ -179,7 +179,6 @@ USE MODD_LES, ONLY: LES_ASSOCIATE
USE MODD_LUNIT
USE MODD_LUNIT_n, ONLY: CINIFILE_n=> CINIFILE, TINIFILE_n => TINIFILE, CINIFILEPGD_n=> CINIFILEPGD, TLUOUT, LUNIT_MODEL
USE MODD_PARAM_n, ONLY: CSURF
-USE MODD_PARAM_ICE_n
USE MODD_PARAMETERS
USE MODD_REF, ONLY: LBOUSS
!
@@ -323,7 +322,7 @@ CALL DEFAULT_DESFM_n(KMI)
!* 3. READ INITIAL FILE NAME AND OPEN INITIAL FILE
! --------------------------------------------
!
-CALL POSNAM(ILUSEG,'NAM_LUNITN',GFOUND)
+CALL POSNAM( TZFILE_DES, 'NAM_LUNITN', GFOUND )
IF (GFOUND) THEN
CALL INIT_NAM_LUNITn
READ(UNIT=ILUSEG,NML=NAM_LUNITn)
@@ -336,9 +335,9 @@ END IF
IF (CPROGRAM=='MESONH') THEN
IF (KMI.EQ.1) THEN
- CALL POSNAM(ILUSEG,'NAM_CONFZ',GFOUND,ILUOUT)
+ CALL POSNAM( TZFILE_DES, 'NAM_CONFZ', GFOUND )
IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_CONFZ)
- CALL POSNAM(ILUSEG,'NAM_CONFIO',GFOUND,ILUOUT)
+ CALL POSNAM( TZFILE_DES, 'NAM_CONFIO', GFOUND )
IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_CONFIO)
CALL IO_Config_set()
END IF
diff --git a/src/mesonh/ext/ini_tke_eps.f90 b/src/mesonh/ext/ini_tke_eps.f90
index a07160722558475a37baff36ada0a00739bff061..b643f54c394a0801fbe48f28083f8e50e60deff8 100644
--- a/src/mesonh/ext/ini_tke_eps.f90
+++ b/src/mesonh/ext/ini_tke_eps.f90
@@ -93,9 +93,9 @@ END MODULE MODI_INI_TKE_EPS
USE MODD_ARGSLIST_ll, ONLY: LIST_ll
USE MODD_CST, ONLY: XG, XALPHAOC
USE MODD_CTURB, ONLY: XCMFS
-USE MODD_TURB_n, ONLY: XLINI, XCED, XTKEMIN, XCSHF
USE MODD_DYN_n, ONLY: LOCEAN
USE MODD_PARAMETERS, ONLY: JPVEXT
+USE MODD_TURB_n, ONLY: XLINI, XCED, XTKEMIN, XCSHF
!
USE MODE_ll
!
diff --git a/src/mesonh/ext/init_mnh.f90 b/src/mesonh/ext/init_mnh.f90
index 4170ca68e7ebf89b388aa90fee1d25880fd73edd..ad6ea75eb643f6cfb3bca262b6c3f35feb0c5437 100644
--- a/src/mesonh/ext/init_mnh.f90
+++ b/src/mesonh/ext/init_mnh.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2023 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.
@@ -82,17 +82,17 @@ USE MODD_LBC_n, ONLY: CLBCX,CLBCY ! only for spawning purpose
USE MODD_LUNIT
USE MODD_LUNIT_n
USE MODD_MNH_SURFEX_n
+USE MODD_NSV, ONLY: NSV_ASSOCIATE
USE MODD_PARAMETERS
-USE MODD_NSV, ONLY: NSV_ASSOCIATE
!
use mode_field, only: Alloc_field_scalars, Fieldlist_goto_model
+USE MODE_INI_CST, ONLY: INI_CST
USE MODE_IO_FILE, ONLY: IO_File_open
USE MODE_IO_MANAGE_STRUCT, ONLY: IO_File_add2list
USE MODE_ll
USE MODE_MODELN_HANDLER
USE MODE_SPLITTINGZ_ll
!
-USE MODE_INI_CST, ONLY: INI_CST
USE MODI_INI_MODEL_n
USE MODI_INI_SEG_n
USE MODI_INI_SIZE_n
diff --git a/src/mesonh/ext/ion_attach_elec.f90 b/src/mesonh/ext/ion_attach_elec.f90
index cd0fcf1c3eb268b93d7eeceef9161bc5157122aa..80cbb965cc75dbf3272017e5cab94f48397937a9 100644
--- a/src/mesonh/ext/ion_attach_elec.f90
+++ b/src/mesonh/ext/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 : 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/mesonh/ext/latlon_to_xy.f90 b/src/mesonh/ext/latlon_to_xy.f90
index b969a76f470de6daf738ff1ef67b08753224b1ff..6694937f5dab1b7275beab0c16d28de817393170 100644
--- a/src/mesonh/ext/latlon_to_xy.f90
+++ b/src/mesonh/ext/latlon_to_xy.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1995-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1995-2023 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.
@@ -75,6 +75,7 @@ USE MODD_LUNIT
!
USE MODE_FIELD, ONLY: INI_FIELD_LIST
USE MODE_GRIDPROJ
+USE MODE_INI_CST, ONLY: INI_CST
USE MODE_IO, only: IO_Config_set, IO_Init
use MODE_IO_FIELD_READ, only: IO_Field_read
USE MODE_IO_FILE, only: IO_File_close, IO_File_open
@@ -84,7 +85,6 @@ USE MODE_MODELN_HANDLER, ONLY: GOTO_MODEL
USE MODE_POS, ONLY: POSNAM
use MODE_SPLITTINGZ_ll
!
-USE MODE_INI_CST, ONLY: INI_CST
USE MODI_READ_HGRID
USE MODI_VERSION
!
@@ -147,16 +147,14 @@ CALL IO_File_add2list(TZNMLFILE,'LATLON2XY1.nam','NML','READ')
CALL IO_File_open(TZNMLFILE)
INAM=TZNMLFILE%NLU
!
-CALL POSNAM(INAM,'NAM_INIFILE',GFOUND)
+CALL POSNAM( TZNMLFILE, 'NAM_INIFILE', GFOUND )
IF (GFOUND) THEN
READ(UNIT=INAM,NML=NAM_INIFILE)
- PRINT*, ' namelist NAM_INIFILE read'
END IF
!
-CALL POSNAM(INAM,'NAM_CONFIO',GFOUND)
+CALL POSNAM( TZNMLFILE, 'NAM_CONFIO', GFOUND )
IF (GFOUND) THEN
READ(UNIT=INAM,NML=NAM_CONFIO)
- PRINT*, ' namelist NAM_CONFIO read'
END IF
!
CALL IO_Config_set()
diff --git a/src/mesonh/ext/lesn.f90 b/src/mesonh/ext/lesn.f90
index 6376d8360e303dc35c72a93820cace8d7ce6ed44..86b86a3e6e3a0b572e2686f371365d227c0713fb 100644
--- a/src/mesonh/ext/lesn.f90
+++ b/src/mesonh/ext/lesn.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 2000-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2000-2023 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.
@@ -72,6 +72,11 @@ USE MODD_PARAM_ICE_n, ONLY: LDEPOSC,LSEDIC
USE MODD_PARAM_C2R2, ONLY: LDEPOC,LSEDC
USE MODD_PARAM_LIMA, ONLY : MSEDC=>LSEDC
!
+USE MODE_BL_DEPTH_DIAG
+USE MODE_FILL_DIMPHYEX, ONLY: FILL_DIMPHYEX
+USE MODE_ll
+USE MODE_MODELN_HANDLER
+!
USE MODI_SHUMAN
USE MODI_GRADIENT_M
USE MODI_GRADIENT_U
@@ -84,11 +89,6 @@ USE MODI_THL_RT_FROM_TH_R
USE MODI_LES_RES_TR
USE MODI_BUDGET_FLAGS
USE MODI_LES_BUDGET_TEND_n
-USE MODE_BL_DEPTH_DIAG
-!
-USE MODE_ll
-USE MODE_MODELN_HANDLER
-USE MODE_FILL_DIMPHYEX, ONLY: FILL_DIMPHYEX
!
IMPLICIT NONE
!
@@ -878,7 +878,9 @@ END DO
!
IF (NLES_CURRENT_TCOUNT==1) THEN
ALLOCATE(ZZ_LES (IIU,IJU,NLES_K))
+ !ZZ_LES = vertical position of the mass points where data is computed
CALL LES_VER_INT( MZF(XZZ) ,ZZ_LES )
+ !XLES_Z = mean vertical altitude for each level (taking into account the mask)
CALL LES_MEAN_ll ( ZZ_LES, LLES_CURRENT_CART_MASK, XLES_Z )
DEALLOCATE(ZZ_LES)
CALL LES_MEAN_ll ( XZS, LLES_CURRENT_CART_MASK(:,:,1), XLES_ZS )
diff --git a/src/mesonh/ext/mnh2lpdm.f90 b/src/mesonh/ext/mnh2lpdm.f90
index d00036b2e9da0be4bf25c177c9af6c21be11ea69..21d162a5db272761fd00a2bb44882a4775aa63b5 100644
--- a/src/mesonh/ext/mnh2lpdm.f90
+++ b/src/mesonh/ext/mnh2lpdm.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 2002-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2002-2023 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.
@@ -34,6 +34,7 @@ use modd_lunit_n, only: TLUOUT
USE MODD_MNH2LPDM
!
USE MODE_FIELD, ONLY: INI_FIELD_LIST, INI_FIELD_SCALARS
+USE MODE_INI_CST, ONLY: INI_CST
USE MODE_IO, ONLY: IO_Init, IO_Config_set
USE MODE_IO_FILE, ONLY: IO_File_open, IO_File_close
USE MODE_IO_MANAGE_STRUCT, ONLY: IO_File_add2list
@@ -41,7 +42,6 @@ USE MODE_MODELN_HANDLER
use mode_msg
USE MODE_POS
!
-USE MODE_INI_CST, ONLY: INI_CST
USE MODI_MNH2LPDM_ECH
USE MODI_MNH2LPDM_INI
USE MODI_VERSION
@@ -113,7 +113,7 @@ READ(UNIT=IFNML,NML=NAM_TURB)
READ(UNIT=IFNML,NML=NAM_FIC)
print *,'Lecture de NAM_FIC OK.'
-CALL POSNAM(IFNML,'NAM_CONFIO',GFOUND)
+CALL POSNAM( TZNMLFILE, 'NAM_CONFIO', GFOUND )
IF (GFOUND) THEN
READ(UNIT=IFNML,NML=NAM_CONFIO)
END IF
diff --git a/src/mesonh/ext/mnh2lpdm_ini.f90 b/src/mesonh/ext/mnh2lpdm_ini.f90
index a18acfcbec58726cee80ab7c9f92620c6b5c96bd..526bdd08afc6729ad33fab8085ca494e126c0908 100644
--- a/src/mesonh/ext/mnh2lpdm_ini.f90
+++ b/src/mesonh/ext/mnh2lpdm_ini.f90
@@ -46,11 +46,11 @@ USE MODD_TIME_n
!
USE MODE_DATETIME
USE MODE_GRIDPROJ
+USE MODE_INI_CST, ONLY: INI_CST
USE MODE_IO_FILE, only: IO_File_close, IO_File_open
USE MODE_IO_FIELD_READ, only: IO_Field_read
USE MODE_MODELN_HANDLER
!
-USE MODE_INI_CST, ONLY: INI_CST
USE MODI_READ_HGRID
USE MODI_XYTOLATLON
!
diff --git a/src/mesonh/ext/modeln.f90 b/src/mesonh/ext/modeln.f90
index bd57f893d6501adffa2dfd8739dc49bd671ad13d..ee03f74b81d589ed3cb6a0646a9b7f3d26e73215 100644
--- a/src/mesonh/ext/modeln.f90
+++ b/src/mesonh/ext/modeln.f90
@@ -277,11 +277,14 @@ END MODULE MODI_MODEL_n
! T. Nagel 01/02/2021: add turbulence recycling
! P. Wautelet 19/02/2021: add NEGA2 term for SV budgets
! J.L. Redelsperger 03/2021: add Call NHOA_COUPLN (coupling O & A LES version)
+! R. Schoetter 12/2021: multi-level coupling between MesoNH and SURFEX
! A. Costes 12/2021: add Blaze fire model
! C. Barthe 07/04/2022: deallocation of ZSEA
! P. Wautelet 08/12/2022: bugfix if no TDADFILE
! 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
@@ -321,6 +324,7 @@ USE MODD_DYNZD_n
USE MODD_ELEC_DESCR
USE MODD_EOL_MAIN
USE MODD_FIELD_n
+USE MODD_FIRE_n
USE MODD_FRC
USE MODD_FRC_n
USE MODD_GET_n
@@ -340,6 +344,7 @@ USE MODD_MEAN_FIELD
USE MODD_MEAN_FIELD_n
USE MODD_METRICS_n
USE MODD_MNH_SURFEX_n
+USE MODD_NEB_n, ONLY: LSIGMAS, LSUBG_COND, VSIGQSAT
USE MODD_NESTING
USE MODD_NSV
USE MODD_NUDGING_n
@@ -348,10 +353,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
@@ -372,7 +377,6 @@ USE MODD_TIME
USE MODD_TIME_n
USE MODD_TIMEZ
USE MODD_TURB_n
-USE MODD_NEB_n, ONLY: VSIGQSAT, LSIGMAS, LSUBG_COND
USE MODD_TYPE_DATE, ONLY: DATE_TIME
USE MODD_VISCOSITY
!
@@ -397,8 +401,7 @@ USE MODE_ONE_WAY_n
USE MODE_WRITE_AIRCRAFT_BALLOON
use mode_write_les_n, only: Write_les_n
use mode_write_lfifmn_fordiachro_n, only: WRITE_LFIFMN_FORDIACHRO_n
-USE MODE_WRITE_PROFILER_n, ONLY: WRITE_PROFILER_n
-USE MODE_WRITE_STATION_n, ONLY: WRITE_STATION_n
+USE MODE_WRITE_STATPROF_n, ONLY: WRITE_STATPROF_n
!
USE MODI_ADDFLUCTUATIONS
USE MODI_ADVECTION_METSV
@@ -466,7 +469,6 @@ USE MODI_WRITE_LFIFM_n
USE MODI_WRITE_SERIES_n
USE MODI_WRITE_SURF_ATM_N
!
-USE MODD_FIRE_n
IMPLICIT NONE
!
!* 0.1 declarations of arguments
@@ -1031,10 +1033,10 @@ IF ( nfile_backup_current < NBAK_NUMB ) THEN
IF (CSURF=='EXTE') THEN
TFILE_SURFEX => TPBAKFILE
CALL GOTO_SURFEX(IMI)
- CALL WRITE_SURF_ATM_n(YSURF_CUR,'MESONH','ALL',.FALSE.)
+ CALL WRITE_SURF_ATM_n(YSURF_CUR,'MESONH','ALL')
IF ( KTCOUNT > 1) THEN
CALL DIAG_SURF_ATM_n(YSURF_CUR,'MESONH')
- CALL WRITE_DIAG_SURF_ATM_n(YSURF_CUR,'MESONH','ALL')
+ CALL WRITE_DIAG_SURF_ATM_n(YSURF_CUR,'MESONH','ALL', KTCOUNT/nfile_backup_current)
END IF
NULLIFY(TFILE_SURFEX)
END IF
@@ -1468,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)
!
@@ -1663,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, &
@@ -1920,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
@@ -1949,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,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, &
+ 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
@@ -2032,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
!
@@ -2113,7 +2186,7 @@ XT_SPECTRA = XT_SPECTRA + ZTIME2 - ZTIME1 + XTIME_LES_BU + XTIME_LES
! --------------------
!
IF (LMEAN_FIELD) THEN
- CALL MEAN_FIELD(XUT, XVT, XWT, XTHT, XTKET, XPABST, XSVT(:,:,:,1))
+ CALL MEAN_FIELD(XUT, XVT, XWT, XTHT, XTKET, XPABST, XRT(:,:,:,1), XSVT(:,:,:,1))
END IF
!
!-------------------------------------------------------------------------------
@@ -2191,7 +2264,7 @@ END IF
! --------------------------------
!
IF ( LSTATION ) &
- CALL STATION_n( XZZ, XUT, XVT, XWT, XTHT, XRT, XSVT, XTKET, XTSRAD, XPABST )
+ CALL STATION_n( XZZ, XRHODREF, XUT, XVT, XWT, XTHT, XRT, XSVT, XTKET, XTSRAD, XPABST )
!
!---------------------------------------------------------
!
@@ -2271,8 +2344,8 @@ IF (OEXIT) THEN
IF ( .NOT. LIO_NO_WRITE ) THEN
IF (LSERIES) CALL WRITE_SERIES_n(TDIAFILE)
CALL WRITE_AIRCRAFT_BALLOON(TDIAFILE)
- CALL WRITE_STATION_n(TDIAFILE)
- CALL WRITE_PROFILER_n(TDIAFILE)
+ CALL WRITE_STATPROF_n( TDIAFILE, TSTATIONS )
+ CALL WRITE_STATPROF_n( TDIAFILE, TPROFILERS )
call Write_les_n( tdiafile )
#ifdef MNH_IOLFI
CALL MENU_DIACHRO(TDIAFILE,'END')
diff --git a/src/mesonh/ext/modn_param_ice.f90 b/src/mesonh/ext/modn_param_ice.f90
deleted file mode 100644
index 8b137891791fe96927ad78e64b0aad7bded08bdc..0000000000000000000000000000000000000000
--- a/src/mesonh/ext/modn_param_ice.f90
+++ /dev/null
@@ -1 +0,0 @@
-
diff --git a/src/mesonh/ext/modn_turb.f90 b/src/mesonh/ext/modn_turb.f90
deleted file mode 100644
index 8b137891791fe96927ad78e64b0aad7bded08bdc..0000000000000000000000000000000000000000
--- a/src/mesonh/ext/modn_turb.f90
+++ /dev/null
@@ -1 +0,0 @@
-
diff --git a/src/mesonh/ext/modn_turbn.f90 b/src/mesonh/ext/modn_turbn.f90
deleted file mode 100644
index 8b137891791fe96927ad78e64b0aad7bded08bdc..0000000000000000000000000000000000000000
--- a/src/mesonh/ext/modn_turbn.f90
+++ /dev/null
@@ -1 +0,0 @@
-
diff --git a/src/mesonh/ext/nrcolss.f90 b/src/mesonh/ext/nrcolss.f90
deleted file mode 100644
index 4dbeaa1de9d30855774e4761cb6046206225d372..0000000000000000000000000000000000000000
--- a/src/mesonh/ext/nrcolss.f90
+++ /dev/null
@@ -1,316 +0,0 @@
-!MNH_LIC Copyright 1994-2014 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.
-!-----------------------------------------------------------------
-!--------------- special set of characters for RCS information
-!-----------------------------------------------------------------
-! $Source$ $Revision$
-! MASDEV4_7 init 2006/11/23 10:39:56
-!-----------------------------------------------------------------
-! ###################
- MODULE MODI_NRCOLSS
-! ###################
-!
-INTERFACE
-!
- SUBROUTINE NRCOLSS( KND, PALPHAS, PNUS, PALPHAR, PNUR, &
- PESR, PFALLS, PEXFALLS, PFALLEXPS, PFALLR, PEXFALLR,&
- PLBDASMAX, PLBDARMAX, PLBDASMIN, PLBDARMIN, &
- PDINFTY, PNRCOLSS, PAG, PBS, PAS )
-!
-INTEGER, INTENT(IN) :: KND ! Number of discrete size intervals in DS and DR
-!
-REAL, INTENT(IN) :: PALPHAS ! First shape parameter of the aggregates
- ! size distribution (generalized gamma law)
-REAL, INTENT(IN) :: PNUS ! Second shape parameter of the aggregates
- ! size distribution (generalized gamma law)
-REAL, INTENT(IN) :: PALPHAR ! First shape parameter of the rain
- ! size distribution (generalized gamma law)
-REAL, INTENT(IN) :: PNUR ! Second shape parameter of the rain
- ! size distribution (generalized gamma law)
-REAL, INTENT(IN) :: PESR ! Efficiency of aggregates collecting rain
-REAL, INTENT(IN) :: PFALLS ! Fall speed constant of aggregates
-REAL, INTENT(IN) :: PEXFALLS ! Fall speed exponent of aggregates
-REAL, INTENT(IN) :: PFALLEXPS ! Fall speed exponential of aggregates (Thompson 2008)
-REAL, INTENT(IN) :: PFALLR ! Fall speed constant of rain
-REAL, INTENT(IN) :: PEXFALLR ! Fall speed exponent of rain
-REAL, INTENT(IN) :: PLBDASMAX ! Maximun slope of size distribution of aggregates
-REAL, INTENT(IN) :: PLBDARMAX ! Maximun slope of size distribution of rain
-REAL, INTENT(IN) :: PLBDASMIN ! Minimun slope of size distribution of aggregates
-REAL, INTENT(IN) :: PLBDARMIN ! Minimun slope of size distribution of rain
-REAL, INTENT(IN) :: PDINFTY ! Factor to define the largest diameter up to
- ! which the diameter integration is performed
-REAL, INTENT(IN) :: PAG, PBS, PAS
-!
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PNRCOLSS! Scaled fall speed difference in
- ! the mass collection kernel as a
- ! function of LAMBDAX and LAMBDAZ
-!
- END SUBROUTINE NRCOLSS
-!
-END INTERFACE
-!
- END MODULE MODI_NRCOLSS
-! ########################################################################
- SUBROUTINE NRCOLSS( KND, PALPHAS, PNUS, PALPHAR, PNUR, &
- PESR, PFALLS, PEXFALLS, PFALLEXPS, PFALLR, PEXFALLR,&
- PLBDASMAX, PLBDARMAX, PLBDASMIN, PLBDARMIN, &
- PDINFTY, PNRCOLSS, PAG, PBS, PAS )
-! ########################################################################
-!
-!
-!
-!!**** * - Build up a look-up table containing the scaled fall speed
-!! difference between size distributed particles of aggregates and Z
-!!
-!!
-!! PURPOSE
-!! -------
-!! The purpose of this routine is to integrate numerically the scaled fall
-!! speed difference between aggregates and rain for use in collection
-!! kernels FOR CONCENTRATIONS. A first integral of the form
-!!
-!! infty Dz_max
-!! / /
-!! |{| }
-!! |{| E_xz (Dx+Dz)^2 |cxDx^dx-czDz^dz| n(Dz) dDz} n(Dx) dDx
-!! |{| }
-!! / /
-!! 0 Dz_min
-!!
-!! is evaluated and normalised by a second integral of the form
-!!
-!! infty
-!! / /
-!! |{| }
-!! |{| (Dx+Dz)^2 n(Dz) dDz} n(Dx) dDx
-!! |{| }
-!! / /
-!! 0
-!!
-!! The result is stored in a two-dimensional array.
-!!
-!!** METHOD
-!! ------
-!! The free parameters of the size distribution function of aggregates and Z
-!! (slope parameter LAMBDA) are discretized with a geometrical rate in a
-!! specific range
-!! LAMBDA = exp( (Log(LAMBDA_max) - Log(LAMBDA_min))/N_interval )
-!! The two above integrals are performed using the trapezoidal scheme.
-!!
-!! EXTERNAL
-!! --------
-!! MODI_GENERAL_GAMMA: Generalized gamma distribution law
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!! MODD_CST : XPI,XRHOLW
-!! MODD_RAIN_ICE_DESCR: XAS,XAS,XBS
-!!
-!! REFERENCE
-!! ---------
-!! B.S. Ferrier , 1994 : A Double-Moment Multiple-Phase Four-Class
-!! Bulk Ice Scheme,JAS,51,249-280.
-!!
-!! AUTHOR
-!! ------
-!! J.-P. Pinty * Laboratoire d'Aerologie *
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 8/11/95
-!! M. Taufour 03/2022 Adapted from rrcolss for concentration
-!! J. Wurtz 03/2022 New snow characteristics
-!!
-!-------------------------------------------------------------------------------
-!
-!
-!* 0. DECLARATIONS
-! ------------
-!
-!
-USE MODI_GENERAL_GAMMA
-!
-USE MODD_CST
-USE MODD_RAIN_ICE_DESCR_n
-!
-IMPLICIT NONE
-!
-!
-!* 0.1 Declarations of dummy arguments
-! -------------------------------
-!
-!
-INTEGER, INTENT(IN) :: KND ! Number of discrete size intervals in DS and DR
-!
-REAL, INTENT(IN) :: PALPHAS ! First shape parameter of the aggregates
- ! size distribution (generalized gamma law)
-REAL, INTENT(IN) :: PNUS ! Second shape parameter of the aggregates
- ! size distribution (generalized gamma law)
-REAL, INTENT(IN) :: PALPHAR ! First shape parameter of the rain
- ! size distribution (generalized gamma law)
-REAL, INTENT(IN) :: PNUR ! Second shape parameter of the rain
- ! size distribution (generalized gamma law)
-REAL, INTENT(IN) :: PESR ! Efficiency of aggregates collecting rain
-REAL, INTENT(IN) :: PFALLS ! Fall speed constant of aggregates
-REAL, INTENT(IN) :: PEXFALLS ! Fall speed exponent of aggregates
-REAL, INTENT(IN) :: PFALLEXPS ! Fall speed exponential of aggregates (Thompson 2008)
-REAL, INTENT(IN) :: PFALLR ! Fall speed constant of rain
-REAL, INTENT(IN) :: PEXFALLR ! Fall speed exponent of rain
-REAL, INTENT(IN) :: PLBDASMAX ! Maximun slope of size distribution of aggregates
-REAL, INTENT(IN) :: PLBDARMAX ! Maximun slope of size distribution of rain
-REAL, INTENT(IN) :: PLBDASMIN ! Minimun slope of size distribution of aggregates
-REAL, INTENT(IN) :: PLBDARMIN ! Minimun slope of size distribution of rain
-REAL, INTENT(IN) :: PDINFTY ! Factor to define the largest diameter up to
- ! which the diameter integration is performed
-REAL, INTENT(IN) :: PAG, PBS, PAS
-!
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PNRCOLSS! Scaled fall speed difference in
- ! the mass collection kernel as a
- ! function of LAMBDAX and LAMBDAZ
-!
-!
-!* 0.2 Declarations of local variables
-! -------------------------------
-!
-!
-INTEGER :: JLBDAS ! Slope index of the size distribution of aggregates
-INTEGER :: JLBDAR ! Slope index of the size distribution of rain
-INTEGER :: JDS ! Diameter index of a particle of aggregates
-INTEGER :: JDR ! Diameter index of a particle of rain
-!
-INTEGER :: INR ! Number of diameter step for the partial integration
-!
-!
-REAL :: ZLBDAS ! Current slope parameter LAMBDA of aggregates
-REAL :: ZLBDAR ! Current slope parameter LAMBDA of rain
-REAL :: ZDLBDAS ! Growth rate of the slope parameter LAMBDA of aggregates
-REAL :: ZDLBDAR ! Growth rate of the slope parameter LAMBDA of rain
-REAL :: ZDDS ! Integration step of the diameter of aggregates
-REAL :: ZDDSCALR! Integration step of the diameter of rain (scaling integral)
-REAL :: ZDDCOLLR! Integration step of the diameter of rain (fallspe integral)
-REAL :: ZDS ! Current diameter of the particle aggregates
-REAL :: ZDR ! Current diameter of the rain
-REAL :: ZDRMAX ! Maximal diameter of the raindrops where the integration ends
-REAL :: ZCOLLR ! Single integral of the mass weighted fall speed difference
- ! over the spectrum of rain
-REAL :: ZCOLLDRMAX ! Maximum ending point for the partial integral
-REAL :: ZCOLLSR ! Double integral of the mass weighted fall speed difference
- ! over the spectra of aggregates and rain
-REAL :: ZSCALR ! Single integral of the scaling factor over
- ! the spectrum of rain
-REAL :: ZSCALSR ! Double integral of the scaling factor over
- ! the spectra of aggregates and rain
-REAL :: ZFUNC ! Ancillary function
-REAL :: ZCST1
-!
-!
-!-------------------------------------------------------------------------------
-!
-!
-!* 1 COMPUTE THE SCALED VELOCITY DIFFERENCE IN THE MASS
-!* COLLECTION KERNEL,
-! -------------------------------------------------
-!
-!
-!
-!* 1.0 Initialization
-!
-PNRCOLSS(:,:) = 0.0
-ZCST1 = (3.0/XPI)/XRHOLW
-!
-!* 1.1 Compute the growth rate of the slope factors LAMBDA
-!
-ZDLBDAS = EXP( LOG(PLBDASMAX/PLBDASMIN)/REAL(SIZE(PNRCOLSS(:,:),1)-1) )
-ZDLBDAR = EXP( LOG(PLBDARMAX/PLBDARMIN)/REAL(SIZE(PNRCOLSS(:,:),2)-1) )
-!
-!* 1.2 Scan the slope factors LAMBDAX and LAMBDAZ
-!
-DO JLBDAS = 1,SIZE(PNRCOLSS(:,:),1)
- ZLBDAS = PLBDASMIN * ZDLBDAS ** (JLBDAS-1)
-!
-!* 1.3 Compute the diameter steps
-!
- ZDDS = PDINFTY / (REAL(KND) * ZLBDAS)
- DO JLBDAR = 1,SIZE(PNRCOLSS(:,:),2)
- ZLBDAR = PLBDARMIN * ZDLBDAR ** (JLBDAR-1)
-!
-!* 1.4 Initialize the collection integrals
-!
- ZSCALSR = 0.0
- ZCOLLSR = 0.0
-!
-!* 1.5 Compute the diameter steps
-!
- ZDDSCALR = PDINFTY / (REAL(KND) * ZLBDAR)
-!
-!* 1.6 Scan over the diameters DS and DR
-!
- DO JDS = 1,KND-1
- ZDS = ZDDS * REAL(JDS)
- ZSCALR = 0.0
- ZCOLLR = 0.0
- DO JDR = 1,KND-1
- ZDR = ZDDSCALR * REAL(JDR)
-!
-!* 1.7 Compute the normalization factor by integration over the
-! dimensional spectrum of rain
-!
- ZSCALR = ZSCALR + (ZDS+ZDR)**2 * GENERAL_GAMMA(PALPHAR,PNUR,ZLBDAR,ZDR)
- END DO
-!
-!* 1.8 Compute the scaled fall speed difference by partial
-! integration over the dimensional spectrum of rain
-!
- ZFUNC = PAG - PAS*ZDS**(PBS-3.0) ! approximate limit is Ds=240 microns
- IF( ZFUNC>0.0 ) THEN
- ZDRMAX = ZDS*( ZCST1*ZFUNC )**0.3333333
- ELSE
- ZDRMAX = PDINFTY / ZLBDAR
- END IF
- IF( ZDS>1.0E-4 ) THEN ! allow computation if Ds>100 microns
- ! corresponding to a maximal density of the aggregates of XRHOLW
- IF( ZDRMAX >= 0.5*ZDDSCALR ) THEN
- INR = CEILING( ZDRMAX/ZDDSCALR )
- ZDDCOLLR = ZDRMAX / REAL(INR)
- IF (INR>=KND ) THEN
- INR = KND
- ZDDCOLLR = ZDDSCALR
- END IF
- DO JDR = 1,INR-1
- ZDR = ZDDCOLLR * REAL(JDR)
- ZCOLLR = ZCOLLR + (ZDS+ZDR)**2 &
- * PESR * ABS(PFALLS*ZDS**PEXFALLS * EXP(-(PFALLEXPS*ZDS)**PALPHAS)-PFALLR*ZDR**PEXFALLR) &
- * GENERAL_GAMMA(PALPHAR,PNUR,ZLBDAR,ZDR)
- END DO
- ZCOLLDRMAX = (ZDS+ZDRMAX)**2 &
- * PESR * ABS(PFALLS*ZDS**PEXFALLS* EXP(-(PFALLEXPS*ZDS)**PALPHAS)-PFALLR*ZDRMAX**PEXFALLR) &
- * GENERAL_GAMMA(PALPHAR,PNUR,ZLBDAR,ZDRMAX)
- ZCOLLR = (ZCOLLR + 0.5*ZCOLLDRMAX)*(ZDDCOLLR/ZDDSCALR)
-!
-!* 1.9 Compute the normalization factor by integration over the
-! dimensional spectrum of aggregates
-!
- ZFUNC = GENERAL_GAMMA(PALPHAS,PNUS,ZLBDAS,ZDS)
- ZSCALSR = ZSCALSR + ZSCALR * ZFUNC
-!
-!* 1.10 Compute the scaled fall speed difference by integration over
-! the dimensional spectrum of aggregates
-!
- ZCOLLSR = ZCOLLSR + ZCOLLR * ZFUNC
- END IF
-!
-! Otherwise ZDRMAX = 0.0 so the density of the graupel cannot be reached
-! and so PRRCOLSS(JLBDAS,JLBDAR) = 0.0 !
-!
- END IF
- END DO
-!
-!* 1.11 Scale the fall speed difference
-!
- IF( ZSCALSR>0.0 ) PNRCOLSS(JLBDAS,JLBDAR) = ZCOLLSR / ZSCALSR
- END DO
-END DO
-!
-END SUBROUTINE NRCOLSS
diff --git a/src/mesonh/ext/nscolrg.f90 b/src/mesonh/ext/nscolrg.f90
deleted file mode 100644
index 08de78478dc94cb386c188ec3b0d887960c12f43..0000000000000000000000000000000000000000
--- a/src/mesonh/ext/nscolrg.f90
+++ /dev/null
@@ -1,317 +0,0 @@
-!MNH_LIC Copyright 1994-2014 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.
-!-----------------------------------------------------------------
-!--------------- special set of characters for RCS information
-!-----------------------------------------------------------------
-! $Source$ $Revision$
-! MASDEV4_7 init 2006/11/23 10:43:02
-!-----------------------------------------------------------------
-! ###################
- MODULE MODI_NSCOLRG
-! ###################
-!
-INTERFACE
-!
- SUBROUTINE NSCOLRG( KND, PALPHAS, PZNUS, PALPHAR, PNUR, &
- PESR, PFALLS, PEXFALLS, PFALLEXPS, PFALLR, PEXFALLR,&
- PLBDASMAX, PLBDARMAX, PLBDASMIN, PLBDARMIN, &
- PDINFTY, PNSCOLRG,PAG, PBS, PAS )
-!
-INTEGER, INTENT(IN) :: KND ! Number of discrete size intervals in DS and DR
-!
-REAL, INTENT(IN) :: PALPHAS ! First shape parameter of the aggregates
- ! size distribution (generalized gamma law)
-REAL, INTENT(IN) :: PZNUS ! Second shape parameter of the aggregates
- ! size distribution (generalized gamma law)
-REAL, INTENT(IN) :: PALPHAR ! First shape parameter of the rain
- ! size distribution (generalized gamma law)
-REAL, INTENT(IN) :: PNUR ! Second shape parameter of the rain
- ! size distribution (generalized gamma law)
-REAL, INTENT(IN) :: PESR ! Efficiency of the aggregates collecting rain
-REAL, INTENT(IN) :: PFALLS ! Fall speed constant of the aggregates
-REAL, INTENT(IN) :: PEXFALLS ! Fall speed exponent of the aggregates
-REAL, INTENT(IN) :: PFALLEXPS ! Fall speed exponential constant of the aggregates
-REAL, INTENT(IN) :: PFALLR ! Fall speed constant of rain
-REAL, INTENT(IN) :: PEXFALLR ! Fall speed exponent of rain
-REAL, INTENT(IN) :: PLBDASMAX ! Maximun slope of size distribution of the aggregates
-REAL, INTENT(IN) :: PLBDARMAX ! Maximun slope of size distribution of rain
-REAL, INTENT(IN) :: PLBDASMIN ! Minimun slope of size distribution of the aggregates
-REAL, INTENT(IN) :: PLBDARMIN ! Minimun slope of size distribution of rain
-REAL, INTENT(IN) :: PDINFTY ! Factor to define the largest diameter up to
- ! which the diameter integration is performed
-REAL, INTENT(IN) :: PAG, PBS, PAS
-!
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PNSCOLRG! Scaled fall speed difference in
- ! the mass collection kernel as a
- ! function of LAMBDAX and LAMBDAZ
-!
- END SUBROUTINE NSCOLRG
-!
-END INTERFACE
-!
- END MODULE MODI_NSCOLRG
-! ########################################################################
- SUBROUTINE NSCOLRG( KND, PALPHAS, PZNUS, PALPHAR, PNUR, &
- PESR, PFALLS, PEXFALLS, PFALLEXPS, PFALLR, PEXFALLR,&
- PLBDASMAX, PLBDARMAX, PLBDASMIN, PLBDARMIN, &
- PDINFTY, PNSCOLRG,PAG, PBS, PAS )
-! ########################################################################
-!
-!
-!
-!!**** * - Build up a look-up table containing the scaled fall speed
-!! difference between size distributed particles of the aggregates and Z
-!!
-!!
-!! PURPOSE
-!! -------
-!! The purpose of this routine is to integrate numerically the scaled fall
-!! speed difference between aggregates and rain for use in collection
-!! kernels. A first integral of the form
-!!
-!! infty Dz_max
-!! / /
-!! |{| }
-!! |{| E_xz (Dx+Dz)^2 |cxDx^dx-czDz^dz| n(Dz) dDz} n(Dx) dDx
-!! |{| }
-!! / /
-!! 0 Dz_min
-!!
-!! is evaluated and normalised by a second integral of the form
-!!
-!! infty
-!! / /
-!! |{| }
-!! |{| (Dx+Dz)^2 n(Dz) dDz} n(Dx) dDx
-!! |{| }
-!! / /
-!! 0
-!!
-!! The result is stored in a two-dimensional array.
-!!
-!!** METHOD
-!! ------
-!! The free parameters of the size distribution function of the aggregates
-!! and Z (slope parameter LAMBDA) are discretized with a geometrical rate
-!! in a specific range
-!! LAMBDA = exp( (Log(LAMBDA_max) - Log(LAMBDA_min))/N_interval )
-!! The two above integrals are performed using the trapezoidal scheme.
-!!
-!! EXTERNAL
-!! --------
-!! MODI_GENERAL_GAMMA: Generalized gamma distribution law
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!! MODD_CST : XPI,XRHOLW
-!! MODD_RAIN_ICE_DESCR: XAS,XAS,XBS
-!!
-!! REFERENCE
-!! ---------
-!! B.S. Ferrier , 1994 : A Double-Moment Multiple-Phase Four-Class
-!! Bulk Ice Scheme,JAS,51,249-280.
-!!
-!! AUTHOR
-!! ------
-!! J.-P. Pinty * Laboratoire d'Aerologie *
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 8/11/95
-!! M. Taufour 03/2022 Adapted from rscolrg for concentration
-!! J. Wurtz 03/2022 New snow characteristics
-!!
-!-------------------------------------------------------------------------------
-!
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODI_GENERAL_GAMMA
-!
-USE MODD_CST
-USE MODD_RAIN_ICE_DESCR_n
-!
-IMPLICIT NONE
-!
-!* 0.1 Declarations of dummy arguments
-! -------------------------------
-!
-!
-INTEGER, INTENT(IN) :: KND ! Number of discrete size intervals in DS and DR
-!
-REAL, INTENT(IN) :: PALPHAS ! First shape parameter of the aggregates
- ! size distribution (generalized gamma law)
-REAL, INTENT(IN) :: PZNUS ! Second shape parameter of the aggregates
- ! size distribution (generalized gamma law)
-REAL, INTENT(IN) :: PALPHAR ! First shape parameter of the rain
- ! size distribution (generalized gamma law)
-REAL, INTENT(IN) :: PNUR ! Second shape parameter of the rain
- ! size distribution (generalized gamma law)
-REAL, INTENT(IN) :: PESR ! Efficiency of the aggregates collecting rain
-REAL, INTENT(IN) :: PFALLS ! Fall speed constant of the aggregates
-REAL, INTENT(IN) :: PEXFALLS ! Fall speed exponent of the aggregates
-REAL, INTENT(IN) :: PFALLEXPS ! Fall speed exponential constant of the aggregates
-REAL, INTENT(IN) :: PFALLR ! Fall speed constant of rain
-REAL, INTENT(IN) :: PEXFALLR ! Fall speed exponent of rain
-REAL, INTENT(IN) :: PLBDASMAX ! Maximun slope of size distribution of the aggregates
-REAL, INTENT(IN) :: PLBDARMAX ! Maximun slope of size distribution of rain
-REAL, INTENT(IN) :: PLBDASMIN ! Minimun slope of size distribution of the aggregates
-REAL, INTENT(IN) :: PLBDARMIN ! Minimun slope of size distribution of rain
-REAL, INTENT(IN) :: PDINFTY ! Factor to define the largest diameter up to
- ! which the diameter integration is performed
-REAL, INTENT(IN) :: PAG, PBS, PAS
-!
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PNSCOLRG! Scaled fall speed difference in
- ! the mass collection kernel as a
- ! function of LAMBDAX and LAMBDAZ
-!
-!
-!* 0.2 Declarations of local variables
-! -------------------------------
-!
-!
-INTEGER :: JLBDAS ! Slope index of the size distribution of the aggregates
-INTEGER :: JLBDAR ! Slope index of the size distribution of rain
-INTEGER :: JDS ! Diameter index of a particle of the aggregates
-INTEGER :: JDR ! Diameter index of a particle of rain
-!
-INTEGER :: INR ! Number of diameter step for the partial integration
-!
-REAL :: ZLBDAS ! Current slope parameter LAMBDA of the aggregates
-REAL :: ZLBDAR ! Current slope parameter LAMBDA of rain
-REAL :: ZDLBDAS ! Growth rate of the slope parameter LAMBDA of the aggregates
-REAL :: ZDLBDAR ! Growth rate of the slope parameter LAMBDA of rain
-REAL :: ZDDS ! Integration step of the diameter of the aggregates
-REAL :: ZDDSCALR! Integration step of the diameter of rain (scaling integral)
-REAL :: ZDDCOLLR! Integration step of the diameter of rain (fallspe integral)
-REAL :: ZDS ! Current diameter of the particle aggregates
-REAL :: ZDR ! Current diameter of the raindrops
-REAL :: ZDRMIN ! Minimal diameter of the raindrops where the integration starts
-REAL :: ZDRMAX ! Maximal diameter of the raindrops where the integration ends
-REAL :: ZCOLLR ! Single integral of the mass weighted fall speed difference
- ! over the spectrum of rain
-REAL :: ZCOLLDRMIN ! Minimum ending point for the partial integral
-REAL :: ZCOLLSR ! Double integral of the mass weighted fall speed difference
- ! over the spectra of the aggregates and rain
-REAL :: ZSCALR ! Single integral of the scaling factor over
- ! the spectrum of rain
-REAL :: ZSCALSR ! Double integral of the scaling factor over
- ! the spectra of the aggregates and rain
-REAL :: ZFUNC ! Ancillary function
-REAL :: ZCST1
-!
-!
-!-------------------------------------------------------------------------------
-!
-!
-!* 1 COMPUTE THE SCALED VELOCITY DIFFERENCE IN THE MASS
-!* COLLECTION KERNEL,
-! -------------------------------------------------
-!
-!
-!* 1.0 Initialization
-!
-PNSCOLRG(:,:) = 0.0
-ZCST1 = (3.0/XPI)/XRHOLW
-!
-!* 1.1 Compute the growth rate of the slope factors LAMBDA
-!
-ZDLBDAR = EXP( LOG(PLBDARMAX/PLBDARMIN)/REAL(SIZE(PNSCOLRG(:,:),1)-1) )
-ZDLBDAS = EXP( LOG(PLBDASMAX/PLBDASMIN)/REAL(SIZE(PNSCOLRG(:,:),2)-1) )
-!
-!* 1.2 Scan the slope factors LAMBDAX and LAMBDAZ
-!
-DO JLBDAR = 1,SIZE(PNSCOLRG(:,:),1)
- ZLBDAR = PLBDARMIN * ZDLBDAR ** (JLBDAR-1)
- ZDRMAX = PDINFTY / ZLBDAR
-!
-!* 1.3 Compute the diameter steps
-!
- ZDDSCALR = PDINFTY / (REAL(KND) * ZLBDAR)
- DO JLBDAS = 1,SIZE(PNSCOLRG(:,:),2)
- ZLBDAS = PLBDASMIN * ZDLBDAS ** (JLBDAS-1)
-!
-!* 1.4 Initialize the collection integrals
-!
- ZSCALSR = 0.0
- ZCOLLSR = 0.0
-!
-!* 1.5 Compute the diameter steps
-!
- ZDDS = PDINFTY / (REAL(KND) * ZLBDAS)
-!
-!* 1.6 Scan over the diameters DS and DR
-!
- DO JDS = 1,KND-1
- ZDS = ZDDS * REAL(JDS)
- ZSCALR = 0.0
- ZCOLLR = 0.0
- DO JDR = 1,KND-1
- ZDR = ZDDSCALR * REAL(JDR)
-!
-!* 1.7 Compute the normalization factor by integration over the
-! dimensional spectrum of rain
-!
- ZSCALR = ZSCALR + (ZDS+ZDR)**2 * GENERAL_GAMMA(PALPHAR,PNUR,ZLBDAR,ZDR)
- END DO
-!
-!* 1.8 Compute the scaled fall speed difference by partial
-! integration over the dimensional spectrum of rain
-!
- ZFUNC = PAG - PAS*ZDS**(PBS-3.0) ! approximate limit is Ds=240 microns
- IF( ZFUNC>0.0 ) THEN
- ZDRMIN = ZDS*( ZCST1*ZFUNC )**0.3333333
- ELSE
- ZDRMIN = 0.0
- END IF
- IF( ZDS>1.0E-4 ) THEN ! allow computation if Ds>100 microns
- ! corresponding to a maximal density of the aggregates of XRHOLW
- IF( (ZDRMAX-ZDRMIN) >= 0.5*ZDDSCALR ) THEN
- INR = CEILING( (ZDRMAX-ZDRMIN)/ZDDSCALR )
- ZDDCOLLR = (ZDRMAX-ZDRMIN) / REAL(INR)
- DO JDR = 1,INR-1
- ZDR = ZDDCOLLR * REAL(JDR) + ZDRMIN
- ZCOLLR = ZCOLLR + (ZDS+ZDR)**2 &
- * GENERAL_GAMMA(PALPHAR,PNUR,ZLBDAR,ZDR) &
- * PESR * ABS(PFALLS*ZDS**PEXFALLS*EXP(-(ZDS*PFALLEXPS)**PALPHAS)-PFALLR*ZDR**PEXFALLR)
- END DO
- IF( ZDRMIN>0.0 ) THEN
- ZCOLLDRMIN = (ZDS+ZDRMIN)**2 &
- * GENERAL_GAMMA(PALPHAR,PNUR,ZLBDAR,ZDRMIN) &
- * PESR * ABS(PFALLS*ZDS**PEXFALLS*EXP(-(ZDS*PFALLEXPS)**PALPHAS)-PFALLR*ZDRMIN**PEXFALLR)
- ELSE
- ZCOLLDRMIN = 0.0
- END IF
- ZCOLLR = (ZCOLLR + 0.5*ZCOLLDRMIN)*(ZDDCOLLR/ZDDSCALR)
-!
-!* 1.9 Compute the normalization factor by integration over the
-! dimensional spectrum of the aggregates
-!
- ZFUNC = GENERAL_GAMMA(PALPHAS,PZNUS,ZLBDAS,ZDS) ! MTaufour : !*(ZDS**PEXMASSS)
- ZSCALSR = ZSCALSR + ZSCALR * ZFUNC
-!
-!* 1.10 Compute the scaled fall speed difference by integration over
-! the dimensional spectrum of the aggregates
-!
- ZCOLLSR = ZCOLLSR + ZCOLLR * ZFUNC
-!
-! Otherwise ZDRMIN>ZDRMAX so PRRCOLSS(JLBDAS,JLBDAR) = 0.0 !
-!
- END IF
-!
-! Otherwise ZDRMAX = 0.0 so the density of the graupel cannot be reached
-! and so PRRCOLSS(JLBDAS,JLBDAR) = 0.0 !
-!
- END IF
- END DO
-!
-!* 1.10 Scale the fall speed difference
-!
- IF( ZSCALSR>0.0 ) PNSCOLRG(JLBDAR,JLBDAS) = ZCOLLSR / ZSCALSR
- END DO
-END DO
-!
-END SUBROUTINE NSCOLRG
diff --git a/src/mesonh/ext/phys_paramn.f90 b/src/mesonh/ext/phys_paramn.f90
index d1c53a2defe126e82caf00d1c7efce45c8b37bf0..e059ad37163b5e80aa6e8468f9646269b7dc73a3 100644
--- a/src/mesonh/ext/phys_paramn.f90
+++ b/src/mesonh/ext/phys_paramn.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1995-2022 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1995-2023 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.
@@ -237,15 +237,17 @@ END MODULE MODI_PHYS_PARAM_n
! C. Lac 11/2019: correction in the drag formula and application to building in addition to tree
! F. Auguste 02/2021: add IBM
! JL Redelsperger 03/2021: add the SW flux penetration for Ocean model case
+! R. Schoetter 12/2021: multi-level coupling between MesoNH and SURFEX
! 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
! ------------
!
-USE MODD_ADV_n, ONLY : XRTKEMS
+USE MODD_ADV_n, ONLY : XRTKEMS
USE MODD_AIRCRAFT_BALLOON, ONLY: LFLYER
USE MODD_ARGSLIST_ll, ONLY : LIST_ll
USE MODD_BLOWSNOW, ONLY : LBLOWSNOW,XRSNOW
@@ -290,6 +292,7 @@ USE MODD_LSFIELD_n
USE MODD_LUNIT_n
USE MODD_METRICS_n
USE MODD_MNH_SURFEX_n
+USE MODD_NEB_n, ONLY: NEBN
USE MODD_NESTING, ONLY : XWAY,NDAD, NDXRATIO_ALL, NDYRATIO_ALL
USE MODD_NSV, ONLY : NSV, NSV_LGBEG, NSV_LGEND, &
NSV_SLTBEG,NSV_SLTEND,NSV_SLT,&
@@ -300,7 +303,7 @@ USE MODD_OCEANH
USE MODD_OUT_n
USE MODD_PARAM_C2R2, ONLY : LSEDC
USE MODD_PARAMETERS
-USE MODD_PARAM_ICE_n, ONLY : LSEDIC
+USE MODD_PARAM_ICE_n, ONLY : LSEDIC
USE MODD_PARAM_KAFR_n
USE MODD_PARAM_LIMA, ONLY : MSEDC => LSEDC, XRTMIN_LIMA=>XRTMIN
USE MODD_PARAM_MFSHALL_n, ONLY: CMF_CLOUD
@@ -312,7 +315,7 @@ USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
USE MODD_PRECIP_n
use modd_precision, only: MNHTIME
USE MODD_RADIATIONS_n
-USE MODD_RAIN_ICE_DESCR_n, ONLY: XRTMIN
+USE MODD_RAIN_ICE_DESCR_n, ONLY: XRTMIN
USE MODD_REF, ONLY: LCOUPLES
USE MODD_REF_n
USE MODD_SALT
@@ -323,7 +326,6 @@ USE MODD_TIME_n
USE MODD_TIME, ONLY : TDTEXP ! Ajout PP
USE MODD_TURB_FLUX_AIRCRAFT_BALLOON, ONLY : XTHW_FLUX, XRCW_FLUX, XSVW_FLUX
USE MODD_TURB_n
-USE MODD_NEB_n, ONLY: NEBN
USE MODE_AERO_PSD
use mode_budget, only: Budget_store_end, Budget_store_init
@@ -387,6 +389,12 @@ REAL, DIMENSION(:,:), ALLOCATABLE :: ZSFRV ! surface flux of vapor
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZSFSV ! surface flux of scalars
REAL, DIMENSION(:,:), ALLOCATABLE :: ZSFCO2! surface flux of CO2
!
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZSFTH_WALL
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZSFTH_ROOF
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZCD_ROOF
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZSFRV_WALL
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZSFRV_ROOF
+!
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZDIR_ALB ! direct albedo
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZSCA_ALB ! diffuse albedo
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZEMIS ! emissivity
@@ -492,7 +500,7 @@ IKB = 1 + JPVEXT
IKE = IKU - JPVEXT
!
CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
-CALL FILL_DIMPHYEX(YLDIMPHYEX, SIZE(XTHT,1), SIZE(XTHT,2), SIZE(XTHT,3),.TRUE., NLES_TIMES)
+CALL FILL_DIMPHYEX( YLDIMPHYEX, SIZE(XTHT,1), SIZE(XTHT,2), SIZE(XTHT,3), LTURB=.TRUE., KLES_TIMES=NLES_TIMES, KLES_K=NLES_K )
!
ZTIME1 = 0.0_MNHTIME
ZTIME2 = 0.0_MNHTIME
@@ -511,6 +519,12 @@ ALLOCATE(ZSFRV (IIU,IJU))
ALLOCATE(ZSFSV (IIU,IJU,NSV))
ALLOCATE(ZSFCO2(IIU,IJU))
!
+ALLOCATE(ZSFTH_WALL (IIU,IJU))
+ALLOCATE(ZSFTH_ROOF (IIU,IJU))
+ALLOCATE(ZCD_ROOF (IIU,IJU))
+ALLOCATE(ZSFRV_WALL (IIU,IJU))
+ALLOCATE(ZSFRV_ROOF (IIU,IJU))
+!
!* if XWAY(son)=2 save surface fields before radiation or convective scheme
! calls
!
@@ -1265,8 +1279,8 @@ IF (CSURF=='EXTE') THEN
DEALLOCATE( ZSAVE_INPRC,ZSAVE_PRCONV,ZSAVE_PRSCONV)
DEALLOCATE( ZSAVE_DIRFLASWD,ZSAVE_SCAFLASWD,ZSAVE_DIRSRFSWD)
END IF
- CALL GROUND_PARAM_n(YLDIMPHYEX,ZSFTH, ZSFRV, ZSFSV, ZSFCO2, ZSFU, ZSFV, &
- ZDIR_ALB, ZSCA_ALB, ZEMIS, ZTSRAD, KTCOUNT, TPFILE )
+ CALL GROUND_PARAM_n(YLDIMPHYEX,ZSFTH, ZSFTH_WALL, ZSFTH_ROOF, ZCD_ROOF, ZSFRV, ZSFRV_WALL, ZSFRV_ROOF, &
+ ZSFSV, ZSFCO2, ZSFU, ZSFV, ZDIR_ALB, ZSCA_ALB, ZEMIS, ZTSRAD, KTCOUNT, TPFILE )
!
IF (LIBM) THEN
WHERE(XIBM_LS(:,:,IKB,1).GT.-XIBM_EPSI)
@@ -1303,6 +1317,11 @@ IF (CSURF=='EXTE') THEN
ELSE ! case no SURFEX (CSURF logical)
ZSFSV = 0.
ZSFCO2 = 0.
+ ZSFTH_WALL = 0.
+ ZSFTH_ROOF = 0.
+ ZCD_ROOF = 0.
+ ZSFRV_WALL = 0.
+ ZSFRV_ROOF = 0.
IF (.NOT.LOCEAN) THEN
ZSFTH = 0.
ZSFRV = 0.
@@ -1368,11 +1387,53 @@ ZTIME1 = ZTIME2
XTIME_BU_PROCESS = 0.
XTIME_LES_BU_PROCESS = 0.
!
+CALL ADD2DFIELD_ll(TZFIELDS_ll,ZSFTH_WALL, 'PHYS_PARAM_n::ZSFTH_WALL')
+CALL ADD2DFIELD_ll(TZFIELDS_ll,ZSFTH_ROOF, 'PHYS_PARAM_n::ZSFTH_ROOF')
+CALL ADD2DFIELD_ll(TZFIELDS_ll,ZCD_ROOF, 'PHYS_PARAM_n::ZCD_ROOF')
+CALL ADD2DFIELD_ll(TZFIELDS_ll,ZSFRV_WALL, 'PHYS_PARAM_n::ZSFRV_WALL')
+CALL ADD2DFIELD_ll(TZFIELDS_ll,ZSFRV_ROOF, 'PHYS_PARAM_n::ZSFRV_ROOF')
+!
+IF ( CLBCX(1) /= "CYCL" .AND. LWEST_ll()) THEN
+ ZSFTH_WALL(IIB-1,:)=ZSFTH_WALL(IIB,:)
+ ZSFTH_ROOF(IIB-1,:)=ZSFTH_ROOF(IIB,:)
+ ZCD_ROOF (IIB-1,:)=ZCD_ROOF(IIB,:)
+ ZSFRV_WALL(IIB-1,:)=ZSFRV_WALL(IIB,:)
+ ZSFRV_ROOF(IIB-1,:)=ZSFRV_ROOF(IIB,:)
+ENDIF
+!
+IF ( CLBCX(2) /= "CYCL" .AND. LEAST_ll()) THEN
+ ZSFTH_WALL(IIE+1,:)=ZSFTH_WALL(IIE,:)
+ ZSFTH_ROOF(IIE+1,:)=ZSFTH_ROOF(IIE,:)
+ ZCD_ROOF(IIE+1,:) =ZCD_ROOF(IIE,:)
+ ZSFRV_WALL(IIE+1,:)=ZSFRV_WALL(IIE,:)
+ ZSFRV_ROOF(IIE+1,:)=ZSFRV_ROOF(IIE,:)
+ENDIF
+!
+IF ( CLBCY(1) /= "CYCL" .AND. LSOUTH_ll()) THEN
+ ZSFTH_WALL(:,IJB-1)=ZSFTH_WALL(:,IJB)
+ ZSFTH_ROOF(:,IJB-1)=ZSFTH_ROOF(:,IJB)
+ ZCD_ROOF(:,IJB-1) =ZCD_ROOF(:,IJB)
+ ZSFRV_WALL(:,IJB-1)=ZSFRV_WALL(:,IJB)
+ ZSFRV_ROOF(:,IJB-1)=ZSFRV_ROOF(:,IJB)
+ENDIF
+!
+IF ( CLBCY(2) /= "CYCL" .AND. LNORTH_ll()) THEN
+ ZSFTH_WALL(:,IJE+1)=ZSFTH_WALL(:,IJE)
+ ZSFTH_ROOF(:,IJE+1)=ZSFTH_ROOF(:,IJE)
+ ZCD_ROOF(:,IJE+1)=ZCD_ROOF(:,IJE)
+ ZSFRV_WALL(:,IJE+1)=ZSFRV_WALL(:,IJE)
+ ZSFRV_ROOF(:,IJE+1)=ZSFRV_ROOF(:,IJE)
+ENDIF
+!
+!
IF (LDRAGTREE) CALL DRAG_VEG( XTSTEP, XUT, XVT, XTKET, LDEPOTREE, XVDEPOTREE, &
CCLOUD, XPABST, XTHT, XRT, XSVT, XRHODJ, XZZ, &
XRUS, XRVS, XRTKES, XRRS, XRSVS )
!
-IF (LDRAGBLDG) CALL DRAG_BLD( XTSTEP, XUT, XVT, XTKET, XRHODJ, XZZ, XRUS, XRVS, XRTKES )
+IF (LDRAGBLDG) CALL DRAG_BLD ( XTSTEP, XUT, XVT, XTKET, XPABST, XTHT, XRT, XSVT, &
+ XRHODJ, XZZ, XRUS, XRVS, XRTKES, XRTHS, XRRS, &
+ ZSFTH_WALL, ZSFTH_ROOF, ZCD_ROOF, ZSFRV_WALL, &
+ ZSFRV_ROOF )
!
CALL SECOND_MNH2(ZTIME2)
!
@@ -1570,7 +1631,7 @@ IF(LLEONARD) THEN
ZHGRAD(:,:,:,5) = GX_M_M(XRT(:,:,:,1), XDXX,XDZZ,XDZX,1,IKU,1)
ZHGRAD(:,:,:,6) = GY_M_M(XRT(:,:,:,1), XDXX,XDZZ,XDZX,1,IKU,1)
END IF
- CALL TURB( CST,CSTURB, TBUCONF, TURBN, NEBN, YLDIMPHYEX,TLES, &
+ CALL TURB( CST,CSTURB, TBUCONF, TURBN, NEBN, YLDIMPHYEX, TLES, &
NRR, NRRL, NRRI, CLBCX, CLBCY, IGRADIENTS, NHALO, NTURBSPLIT, &
LCLOUDMODIFLM, NSV, NSV_LGBEG, NSV_LGEND, &
NSV_LIMA_NR, NSV_LIMA_NS, NSV_LIMA_NG, NSV_LIMA_NH, &
@@ -1578,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, &
@@ -1693,6 +1754,11 @@ DEALLOCATE(ZSFRV )
DEALLOCATE(ZSFSV )
DEALLOCATE(ZSFCO2)
!
+DEALLOCATE(ZSFTH_WALL )
+DEALLOCATE(ZSFTH_ROOF )
+DEALLOCATE(ZCD_ROOF )
+DEALLOCATE(ZSFRV_WALL )
+DEALLOCATE(ZSFRV_ROOF )
!-------------------------------------------------------------------------------
!
END SUBROUTINE PHYS_PARAM_n
diff --git a/src/mesonh/ext/prep_ideal_case.f90 b/src/mesonh/ext/prep_ideal_case.f90
index 9b4c61fad08449e598520f875e4975d227713bc4..25eac5bc19829db1276abb1fb4def279fa28d9b8 100644
--- a/src/mesonh/ext/prep_ideal_case.f90
+++ b/src/mesonh/ext/prep_ideal_case.f90
@@ -361,7 +361,7 @@ USE MODD_LUNIT, ONLY: TLUOUT0, TOUTDATAFILE
USE MODD_LUNIT_n
USE MODD_IO, ONLY: TFILE_DUMMY, TFILE_OUTPUTLISTING
USE MODD_CONF_n
-USE MODD_NSV, ONLY: NSV
+USE MODD_NSV, ONLY: NSV, NSV_ASSOCIATE
use modd_precision, only: LFIINT, MNHREAL_MPI, MNHTIME
!
USE MODN_BLANK_n
@@ -656,6 +656,7 @@ CALL ALLOC_FIELD_SCALARS()
CALL TBUCONF_ASSOCIATE()
CALL LES_ASSOCIATE()
CALL DEFAULT_DESFM_n(1)
+CALL NSV_ASSOCIATE()
!
CSURF = "NONE"
!
@@ -686,35 +687,35 @@ NLUPRE=TZEXPREFILE%NLU
!* 3.2 read in NLUPRE the namelist informations
!
WRITE(NLUOUT,FMT=*) 'attempt to read ',TRIM(TZEXPREFILE%CNAME),' file'
-CALL POSNAM(NLUPRE,'NAM_REAL_PGD',GFOUND,NLUOUT)
+CALL POSNAM( TZEXPREFILE, 'NAM_REAL_PGD', GFOUND )
IF (GFOUND) READ(UNIT=NLUPRE,NML=NAM_REAL_PGD)
!
!
-CALL POSNAM(NLUPRE,'NAM_CONF_PRE',GFOUND,NLUOUT)
+CALL POSNAM( TZEXPREFILE, 'NAM_CONF_PRE', GFOUND )
IF (GFOUND) READ(UNIT=NLUPRE,NML=NAM_CONF_PRE)
!JUANZ
-CALL POSNAM(NLUPRE,'NAM_CONFZ',GFOUND,NLUOUT)
+CALL POSNAM( TZEXPREFILE, 'NAM_CONFZ', GFOUND )
IF (GFOUND) READ(UNIT=NLUPRE,NML=NAM_CONFZ)
!JUANZ
-CALL POSNAM(NLUPRE,'NAM_CONFIO',GFOUND,NLUOUT)
+CALL POSNAM( TZEXPREFILE, 'NAM_CONFIO', GFOUND )
IF (GFOUND) READ(UNIT=NLUPRE,NML=NAM_CONFIO)
CALL IO_Config_set()
-CALL POSNAM(NLUPRE,'NAM_GRID_PRE',GFOUND,NLUOUT)
+CALL POSNAM( TZEXPREFILE, 'NAM_GRID_PRE', GFOUND )
IF (GFOUND) READ(UNIT=NLUPRE,NML=NAM_GRID_PRE)
-CALL POSNAM(NLUPRE,'NAM_GRIDH_PRE',GFOUND,NLUOUT)
+CALL POSNAM( TZEXPREFILE, 'NAM_GRIDH_PRE', GFOUND )
IF (GFOUND) READ(UNIT=NLUPRE,NML=NAM_GRIDH_PRE)
-CALL POSNAM(NLUPRE,'NAM_VPROF_PRE',GFOUND,NLUOUT)
+CALL POSNAM( TZEXPREFILE, 'NAM_VPROF_PRE', GFOUND )
IF (GFOUND) READ(UNIT=NLUPRE,NML=NAM_VPROF_PRE)
-CALL POSNAM(NLUPRE,'NAM_BLANKN',GFOUND,NLUOUT)
+CALL POSNAM( TZEXPREFILE, 'NAM_BLANKN', GFOUND )
CALL INIT_NAM_BLANKn
IF (GFOUND) THEN
READ(UNIT=NLUPRE,NML=NAM_BLANKn)
CALL UPDATE_NAM_BLANKn
END IF
-CALL READ_PRE_IDEA_NAM_n(NLUPRE,NLUOUT)
-CALL POSNAM(NLUPRE,'NAM_AERO_PRE',GFOUND,NLUOUT)
+CALL READ_PRE_IDEA_NAM_n( TZEXPREFILE )
+CALL POSNAM( TZEXPREFILE, 'NAM_AERO_PRE', GFOUND )
IF (GFOUND) READ(UNIT=NLUPRE,NML=NAM_AERO_PRE)
-CALL POSNAM(NLUPRE,'NAM_IBM_LSF' ,GFOUND,NLUOUT)
+CALL POSNAM( TZEXPREFILE, 'NAM_IBM_LSF', GFOUND )
IF (GFOUND) READ(UNIT=NLUPRE,NML=NAM_IBM_LSF )
!
CALL INI_FIELD_LIST()
diff --git a/src/mesonh/ext/prep_nest_pgd.f90 b/src/mesonh/ext/prep_nest_pgd.f90
index 4a2352d7736938047c49746ff2bfb416e4357fb1..3a60cde0d23908e3acc16274fb73dd62ae64a1ae 100644
--- a/src/mesonh/ext/prep_nest_pgd.f90
+++ b/src/mesonh/ext/prep_nest_pgd.f90
@@ -112,6 +112,7 @@ USE MODD_VAR_ll, ONLY: NPROC, IP, NMNH_COMM_WORLD
!
use mode_field, only: Ini_field_list
USE MODE_FINALIZE_MNH, only: FINALIZE_MNH
+USE MODE_INI_CST, ONLY: INI_CST
USE MODE_IO, only: IO_Init, IO_Pack_set
USE MODE_IO_FIELD_READ, only: IO_Field_read
USE MODE_IO_FIELD_WRITE, only: IO_Field_write, IO_Header_write
@@ -134,7 +135,6 @@ USE MODI_READ_HGRID
USE MODI_RETRIEVE1_NEST_INFO_n
USE MODI_VERSION
USE MODI_WRITE_PGD_SURF_ATM_N
-USE MODE_INI_CST, ONLY: INI_CST
!
IMPLICIT NONE
!
diff --git a/src/mesonh/ext/prep_pgd.f90 b/src/mesonh/ext/prep_pgd.f90
index 41c4a13988d5a89107b90a04cc434da82ca0bb7d..172959a983513db9261d327d47019cbca0189b30 100644
--- a/src/mesonh/ext/prep_pgd.f90
+++ b/src/mesonh/ext/prep_pgd.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1995-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1995-2023 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.
@@ -96,6 +96,7 @@ USE MODD_SPAWN, ONLY : NDXRATIO,NDYRATIO,NXSIZE,NYSIZE,NXOR,NYOR
!
use mode_field, only: Ini_field_list
USE MODE_FINALIZE_MNH, only: FINALIZE_MNH
+USE MODE_INI_CST, ONLY: INI_CST
USE MODE_IO, only: IO_Config_set, IO_Init
USE MODE_IO_FIELD_WRITE, only: IO_Field_write, IO_Header_write
USE MODE_IO_FILE, only: IO_File_close, IO_File_open
@@ -125,7 +126,6 @@ USE MODE_MPPDB
USE MODI_EXTEND_GRID_ON_HALO
!
USE MODN_CONFIO, ONLY : NAM_CONFIO
-USE MODE_INI_CST, ONLY: INI_CST
!
IMPLICIT NONE
!
@@ -191,23 +191,23 @@ IF (IRESP.NE.0 ) THEN
ENDIF
!JUAN
-CALL POSNAM(ILUNAM,'NAM_PGDFILE',GFOUND)
+CALL POSNAM( TZNMLFILE, 'NAM_PGDFILE', GFOUND )
IF (GFOUND) READ(UNIT=ILUNAM,NML=NAM_PGDFILE)
-CALL POSNAM(ILUNAM,'NAM_ZSFILTER',GFOUND)
+CALL POSNAM( TZNMLFILE, 'NAM_ZSFILTER', GFOUND )
IF (GFOUND) READ(UNIT=ILUNAM,NML=NAM_ZSFILTER)
-CALL POSNAM(ILUNAM,'NAM_SLEVE',GFOUND)
+CALL POSNAM( TZNMLFILE, 'NAM_SLEVE', GFOUND )
IF (GFOUND) READ(UNIT=ILUNAM,NML=NAM_SLEVE)
!JUANZ
-CALL POSNAM(ILUNAM,'NAM_CONFZ',GFOUND)
+CALL POSNAM( TZNMLFILE, 'NAM_CONFZ', GFOUND )
IF (GFOUND) READ(UNIT=ILUNAM,NML=NAM_CONFZ)
-CALL POSNAM(ILUNAM,'NAM_CONF_PGD',GFOUND)
+CALL POSNAM( TZNMLFILE, 'NAM_CONF_PGD', GFOUND )
IF (GFOUND) THEN
NHALO_MNH = NHALO_CONF_MNH
READ(UNIT=ILUNAM,NML=NAM_CONF_PGD)
NHALO_CONF_MNH = NHALO_MNH
ENDIF
!JUANZ
-CALL POSNAM(ILUNAM,'NAM_CONFIO',GFOUND)
+CALL POSNAM( TZNMLFILE, 'NAM_CONFIO', GFOUND )
IF (GFOUND) READ(UNIT=ILUNAM,NML=NAM_CONFIO)
CALL IO_Config_set()
!
diff --git a/src/mesonh/ext/prep_real_case.f90 b/src/mesonh/ext/prep_real_case.f90
index f71ccb8c4fb2cbfc1a31ef32393e13b5a4e717fe..1384ee51335ecc3041e304e4fe35d2ce1e6f6786 100644
--- a/src/mesonh/ext/prep_real_case.f90
+++ b/src/mesonh/ext/prep_real_case.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1995-2022 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1995-2023 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.
@@ -430,6 +430,7 @@ USE MODD_MNH_SURFEX_n
USE MODD_NESTING
USE MODD_NSV
USE MODD_PARAMETERS
+USE MODD_PARAM_LIMA, ONLY: PARAM_LIMA_INIT, NMOD_CCN, NMOD_IFN
USE MODD_PARAM_n
USE MODD_PREP_REAL
USE MODD_REF_n
@@ -445,6 +446,7 @@ use mode_field, only: Alloc_field_scalars, Ini_field_list, Ini_field_
USE MODE_FINALIZE_MNH, only: FINALIZE_MNH
USE MODE_GRIDCART
USE MODE_GRIDPROJ
+USE MODE_INI_CST, ONLY: INI_CST
USE MODE_IO, only: IO_Init
USE MODE_IO_FIELD_READ, only: IO_Field_read
USE MODE_IO_FIELD_WRITE, only: IO_Header_write
@@ -500,8 +502,6 @@ USE MODI_WRITE_LFIFM_n
!
USE MODN_CONF, ONLY: JPHEXT , NHALO
USE MODN_CONFZ
-USE MODD_PARAM_LIMA, ONLY: PARAM_LIMA_INIT, NMOD_CCN, NMOD_IFN
-USE MODE_INI_CST, ONLY: INI_CST
!
IMPLICIT NONE
!
@@ -673,9 +673,9 @@ CALL INI_CST
IPRE_REAL1 = TZPRE_REAL1FILE%NLU
!
CALL INIT_NMLVAR
-CALL POSNAM(IPRE_REAL1,'NAM_REAL_CONF',GFOUND,ILUOUT0)
+CALL POSNAM( TZPRE_REAL1FILE, 'NAM_REAL_CONF', GFOUND )
IF (GFOUND) READ(IPRE_REAL1,NAM_REAL_CONF)
-CALL PARAM_LIMA_INIT(CPROGRAM, IPRE_REAL1, .FALSE., ILUOUT0, .FALSE., .TRUE., .FALSE., 0)
+CALL PARAM_LIMA_INIT(CPROGRAM, TZPRE_REAL1FILE, .FALSE., ILUOUT0, .FALSE., .TRUE., .FALSE., 0)
!
CALL INI_FIELD_LIST()
!
@@ -744,18 +744,18 @@ XANGCONV0=0. ; XANGCONV1000=0. ; XANGCONV2000=0.
CDADATMFILE=' ' ; CDADBOGFILE=' '
!
CALL INIT_NMLVAR
-CALL POSNAM(IPRE_REAL1,'NAM_REAL_CONF',GFOUND,ILUOUT0)
+CALL POSNAM( TZPRE_REAL1FILE, 'NAM_REAL_CONF', GFOUND )
IF (GFOUND) READ(IPRE_REAL1,NAM_REAL_CONF)
-CALL POSNAM(IPRE_REAL1,'NAM_HURR_CONF',GFOUND,ILUOUT0)
+CALL POSNAM( TZPRE_REAL1FILE, 'NAM_HURR_CONF', GFOUND )
IF (GFOUND) READ(IPRE_REAL1,NAM_HURR_CONF)
-CALL POSNAM(IPRE_REAL1,'NAM_CH_CONF',GFOUND,ILUOUT0)
+CALL POSNAM( TZPRE_REAL1FILE, 'NAM_CH_CONF', GFOUND )
IF (GFOUND) READ(UNIT=IPRE_REAL1,NML=NAM_CH_CONF)
CALL UPDATE_MODD_FROM_NMLVAR
-CALL POSNAM(IPRE_REAL1,'NAM_AERO_CONF',GFOUND,ILUOUT0)
+CALL POSNAM( TZPRE_REAL1FILE, 'NAM_AERO_CONF', GFOUND )
IF (GFOUND) READ(IPRE_REAL1,NAM_AERO_CONF)
-CALL POSNAM(IPRE_REAL1,'NAM_CONFZ',GFOUND,ILUOUT0)
+CALL POSNAM( TZPRE_REAL1FILE, 'NAM_CONFZ', GFOUND )
IF (GFOUND) READ(UNIT=IPRE_REAL1,NML=NAM_CONFZ)
-CALL POSNAM(IPRE_REAL1,'NAM_IBM_LSF' ,GFOUND,ILUOUT0)
+CALL POSNAM( TZPRE_REAL1FILE, 'NAM_IBM_LSF' , GFOUND )
IF (GFOUND) READ(UNIT=IPRE_REAL1,NML=NAM_IBM_LSF)
!
GAERINIT = LAERINIT
@@ -808,7 +808,7 @@ END IF
!
!IF(LEN_TRIM(YCHEMFILE)>0)THEN
! ! read again Nam_aero_conf
-! CALL POSNAM(IPRE_REAL1,'NAM_AERO_CONF',GFOUND,ILUOUT0)
+! CALL POSNAM( TZPRE_REAL1FILE, 'NAM_AERO_CONF', GFOUND )
! IF (GFOUND) READ(IPRE_REAL1,NAM_AERO_CONF)
! IF(YCHEMFILETYPE=='GRIBEX') &
! CALL READ_ALL_DATA_GRIB_CASE('CHEM',TZPRE_REAL1FILE,YCHEMFILE,TPGDFILE,ZHORI,NVERB,LDUMMY_REAL)
@@ -842,7 +842,7 @@ END IF
!
IF(LEN_TRIM(YCHEMFILE)>0)THEN
! read again Nam_aero_conf
- CALL POSNAM(IPRE_REAL1,'NAM_AERO_CONF',GFOUND,ILUOUT0)
+ CALL POSNAM( TZPRE_REAL1FILE, 'NAM_AERO_CONF', GFOUND )
IF (GFOUND) READ(IPRE_REAL1,NAM_AERO_CONF)
IF(YCHEMFILETYPE=='GRIBEX') &
CALL READ_ALL_DATA_GRIB_CASE('CHEM',TZPRE_REAL1FILE,YCHEMFILE,TPGDFILE,ZHORI,NVERB,LDUMMY_REAL)
diff --git a/src/mesonh/ext/prep_surfex.f90 b/src/mesonh/ext/prep_surfex.f90
index 6c3c81277095e0087f0f7d63a998dbade6008a07..749c598448269419aed5db6a646c7839e5296bed 100644
--- a/src/mesonh/ext/prep_surfex.f90
+++ b/src/mesonh/ext/prep_surfex.f90
@@ -45,6 +45,7 @@ USE MODD_TIME_n, ONLY : TDTCUR
!
use mode_field, only: Ini_field_list, Ini_field_scalars
USE MODE_FINALIZE_MNH, only: FINALIZE_MNH
+USE MODE_INI_CST, ONLY: INI_CST
USE MODE_IO, only: IO_Init
USE MODE_IO_FIELD_READ, only: IO_Field_read
USE MODE_IO_FIELD_WRITE, only: IO_Field_write, IO_Header_write
@@ -59,7 +60,6 @@ USE MODI_OPEN_PRC_FILES
USE MODI_PREP_SURF_MNH
USE MODI_READ_ALL_NAMELISTS
USE MODI_VERSION
-USE MODE_INI_CST, ONLY: INI_CST
!
IMPLICIT NONE
!
diff --git a/src/mesonh/ext/profilern.f90 b/src/mesonh/ext/profilern.f90
index 9a8b3f6690b14b87aab81805d67c413139149fb6..425ddf294fe45f0831ace0799a09e9cdf660735d 100644
--- a/src/mesonh/ext/profilern.f90
+++ b/src/mesonh/ext/profilern.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 2002-2022 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2002-2023 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.
@@ -83,52 +83,25 @@ END MODULE MODI_PROFILER_n
! + bugfix: put values in variables in this case
! + move some operations outside a do loop
! P. Wautelet 04/2022: restructure profilers for better performance, reduce memory usage and correct some problems/bugs
+! P. Wautelet 01/06/2023: deduplicate code => moved to modd/mode_sensors.f90
! --------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_CST, ONLY: XCPD, XG, XLAM_CRAD, XLIGHTSPEED, XP00, XPI, XRD, XRHOLW, XRV, XTT
-USE MODD_DIAG_IN_RUN
+USE MODD_ALLPROFILER_n, ONLY: LDIAG_SURFRAD_PROF
+USE MODD_CST, ONLY: XCPD, XG, XP00, XPI, XRD, XRV
+USE MODD_DIAG_IN_RUN, ONLY: XCURRENT_TKE_DISS
USE MODD_GRID, ONLY: XBETA, XLON0, XRPK
-USE MODD_NSV, ONLY: NSV_C2R2, NSV_C2R2BEG, NSV_LIMA_NC, NSV_LIMA_NI, NSV_LIMA_NR
+USE MODD_NSV, ONLY: NSV_C2R2BEG, NSV_LIMA_NC, NSV_LIMA_NR, NSV_LIMA_NI
USE MODD_PARAMETERS, ONLY: JPVEXT, XUNDEF
-USE MODD_PARAM_ICE_n, ONLY: LSNOW_T_I => LSNOW_T
-USE MODD_PARAM_LIMA, ONLY: LSNOW_T_L => LSNOW_T, &
- XALPHAR_L => XALPHAR, XNUR_L => XNUR, XALPHAS_L => XALPHAS, XNUS_L => XNUS, &
- XALPHAG_L => XALPHAG, XNUG_L => XNUG, XALPHAI_L => XALPHAI, XNUI_L => XNUI, &
- XRTMIN_L => XRTMIN, XALPHAC_L => XALPHAC, XNUC_L => XNUC
-USE MODD_PARAM_LIMA_COLD, ONLY: XDI_L => XDI, XLBEXI_L => XLBEXI, XLBI_L => XLBI, XAI_L => XAI, XBI_L => XBI, XC_I_L => XC_I, &
- XLBEXS_L => XLBEXS, XLBS_L => XLBS, XCCS_L => XCCS, &
- XAS_L => XAS, XBS_L => XBS, XCXS_L => XCXS, &
- XLBDAS_MAX_L => XLBDAS_MAX, XLBDAS_MIN_L => XLBDAS_MIN, &
- XNS_L => XNS, XTRANS_MP_GAMMAS_L=>XTRANS_MP_GAMMAS
-USE MODD_PARAM_LIMA_MIXED, ONLY: XDG_L => XDG, XLBEXG_L => XLBEXG, XLBG_L => XLBG, XCCG_L => XCCG, &
- XAG_L => XAG, XBG_L => XBG, XCXG_L => XCXG, XCG_L => XCG
-USE MODD_PARAM_LIMA_WARM, ONLY: XLBEXR_L => XLBEXR, XLBR_L => XLBR, XBR_L => XBR, XAR_L => XAR, &
- XBC_L => XBC, XAC_L => XAC
-USE MODD_PARAM_n, ONLY: CCLOUD, CRAD, CSURF
+USE MODD_PARAM_n, ONLY: CCLOUD, CRAD
USE MODD_PROFILER_n
-USE MODD_RAIN_ICE_DESCR_n, ONLY: XALPHAR_I => XALPHAR, XNUR_I => XNUR, XLBEXR_I => XLBEXR, &
- XLBR_I => XLBR, XCCR_I => XCCR, XBR_I => XBR, XAR_I => XAR, &
- XALPHAC_I => XALPHAC, XNUC_I => XNUC, &
- XLBC_I => XLBC, XBC_I => XBC, XAC_I => XAC, &
- XALPHAC2_I => XALPHAC2, XNUC2_I => XNUC2, &
- XALPHAS_I => XALPHAS, XNUS_I => XNUS, XLBEXS_I => XLBEXS, &
- XLBS_I => XLBS, XCCS_I => XCCS, XAS_I => XAS, XBS_I => XBS, XCXS_I => XCXS, &
- XALPHAG_I => XALPHAG, XNUG_I => XNUG, XDG_I => XDG, XLBEXG_I => XLBEXG, &
- XLBG_I => XLBG, XCCG_I => XCCG, XAG_I => XAG, XBG_I => XBG, XCXG_I => XCXG, XCG_I => XCG, &
- XALPHAI_I => XALPHAI, XNUI_I => XNUI, XDI_I => XDI, XLBEXI_I => XLBEXI, &
- XLBI_I => XLBI, XAI_I => XAI, XBI_I => XBI, XC_I_I => XC_I, &
- XNS_I => XNS, XRTMIN_I => XRTMIN, XCONC_LAND, XCONC_SEA, &
- XLBDAS_MAX_I => XLBDAS_MAX, XLBDAS_MIN_I => XLBDAS_MIN, &
- XTRANS_MP_GAMMAS_I => XTRANS_MP_GAMMAS
!
USE MODE_FGAU, ONLY: GAULAG
-USE MODE_FSCATTER, ONLY: BHMIE, QEPSI, QEPSW, MG, MOMG
USE MODE_MSG
-USE MODE_STATPROF_TOOLS, ONLY: STATPROF_INSTANT, STATPROF_INTERP_2D, STATPROF_INTERP_3D, &
- STATPROF_INTERP_3D_U, STATPROF_INTERP_3D_V
+USE MODE_SENSOR, ONLY: Sensor_rare_compute, Sensor_wc_compute
+USE MODE_STATPROF_TOOLS, ONLY: STATPROF_DIAG_SURFRAD
!
USE MODI_GPS_ZENITH_GRID
USE MODI_WATER_SUM
@@ -160,15 +133,13 @@ REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PSEA ! for radar
! 0.2 declaration of local variables
!
!
-INTEGER, PARAMETER :: JPTS_GAULAG = 9 ! number of points for Gauss-Laguerre quadrature
-!
INTEGER :: IKB
INTEGER :: IKE
INTEGER :: IKU
!
!
-REAL, DIMENSION(SIZE(PSV,1),SIZE(PSV,2),SIZE(PSV,3),SIZE(PSV,4)) :: ZWORK
-REAL, DIMENSION(SIZE(PSV,1),SIZE(PSV,2),SIZE(PSV,3),SIZE(PAER,4)) :: ZWORK2
+REAL, DIMENSION(SIZE(PSV,1),SIZE(PSV,2),SIZE(PSV,3),SIZE(PSV,4)) :: ZWORK
+REAL, DIMENSION(SIZE(PSV,1),SIZE(PSV,2),SIZE(PSV,3),SIZE(PAER,4)) :: ZWORK2
!
INTEGER :: IN ! time index
INTEGER :: JSV ! loop counter
@@ -209,26 +180,6 @@ REAL,DIMENSION(SIZE(PTH,1),SIZE(PTH,2),SIZE(PTH,3)) :: ZVISIGUL, ZVISIKUN
REAL :: ZK1,ZK2,ZK3 ! k1, k2 and K3 atmospheric refractivity constants
REAL :: ZRDSRV ! XRD/XRV
!
-! specific to cloud radar
-INTEGER :: JLOOP ! loop counter
-REAL, DIMENSION(SIZE(PR,3)) :: ZTEMPZ! vertical profile of temperature
-REAL, DIMENSION(SIZE(PR,3)) :: ZRHODREFZ ! vertical profile of dry air density of the reference state
-REAL, DIMENSION(SIZE(PR,3)) :: ZCIT ! pristine ice concentration
-REAL, DIMENSION(SIZE(PR,3)) :: ZCCI,ZCCR,ZCCC ! ICE,RAIN CLOUD concentration (LIMA)
-REAL, DIMENSION(SIZE(PR,3),SIZE(PR,4)+1) :: ZRZ ! vertical profile of hydrometeor mixing ratios
-REAL :: ZA, ZB, ZCC, ZCX, ZALPHA, ZNS, ZNU, ZLB, ZLBEX, ZRHOHYD ! generic microphysical parameters
-INTEGER :: JJ ! loop counter for quadrature
-COMPLEX :: QMW,QMI,QM,QB,QEPSIW,QEPSWI ! dielectric parameter
-REAL :: ZAETOT,ZAETMP,ZREFLOC,ZQSCA,ZQBACK,ZQEXT ! temporary scattering parameters
-REAL,DIMENSION(:),ALLOCATABLE :: ZAELOC,ZZMZ ! temporary arrays
-REAL :: ZLBDA ! slope distribution parameter
-REAL :: ZDELTA_EQUIV ! mass-equivalent Gauss-Laguerre point
-REAL :: ZFW ! liquid fraction
-REAL :: ZFPW ! weight for mixed-phase reflectivity
-REAL :: ZN ! number concentration
-REAL,DIMENSION(:),ALLOCATABLE :: ZX,ZW ! Gauss-Laguerre points and weights
-REAL,DIMENSION(:),ALLOCATABLE :: ZRTMIN ! local values for XRTMIN
-LOGICAL :: GCALC
!----------------------------------------------------------------------------
!
!* 2. PRELIMINARIES
@@ -254,15 +205,13 @@ IKE = IKU-JPVEXT
!* 3.4 instant of storage
! ------------------
!
-CALL STATPROF_INSTANT( TPROFILERS_TIME, IN )
-IF ( IN < 1 ) RETURN !No profiler storage at this time step
+IF ( .NOT. TPROFILERS_TIME%STORESTEP_CHECK_AND_SET( IN ) ) RETURN !No profiler storage at this time step
!
!----------------------------------------------------------------------------
!
!* 8. DATA RECORDING
! --------------
!
-!PW: TODO: ne faire le calcul que si necessaire (presence de profileurs locaux,...)
ZTEMP(:,:,:)=PTH(:,:,:)*(PP(:,:,:)/ XP00) **(XRD/XCPD)
! Theta_v
ZTHV(:,:,:) = PTH(:,:,:) / (1.+WATER_SUM(PR(:,:,:,:)))*(1.+PR(:,:,:,1)/ZRDSRV)
@@ -287,12 +236,14 @@ IF ( CCLOUD /= 'NONE' .AND. CCLOUD /= 'REVE' ) THEN
END IF
!
PROFILER: DO JP = 1, NUMBPROFILER_LOC
- ZZ(:) = STATPROF_INTERP_3D( TPROFILERS(JP), PZ )
- ZRHOD(:) = STATPROF_INTERP_3D( TPROFILERS(JP), PRHODREF )
- ZPRES(:) = STATPROF_INTERP_3D( TPROFILERS(JP), PP )
- ZU_PROFILER(:) = STATPROF_INTERP_3D_U( TPROFILERS(JP), PU )
- ZV_PROFILER(:) = STATPROF_INTERP_3D_V( TPROFILERS(JP), PV )
- ZGAM = (XRPK * (TPROFILERS(JP)%XLON - XLON0) - XBETA)*(XPI/180.)
+ TPROFILERS(JP)%NSTORE_CUR = IN
+
+ ZZ(:) = TPROFILERS(JP)%INTERP_HOR_FROM_MASSPOINT( PZ )
+ ZRHOD(:) = TPROFILERS(JP)%INTERP_HOR_FROM_MASSPOINT( PRHODREF )
+ ZPRES(:) = TPROFILERS(JP)%INTERP_HOR_FROM_MASSPOINT( PP )
+ ZU_PROFILER(:) = TPROFILERS(JP)%INTERP_HOR_FROM_UPOINT( PU )
+ ZV_PROFILER(:) = TPROFILERS(JP)%INTERP_HOR_FROM_VPOINT( PV )
+ ZGAM = (XRPK * (TPROFILERS(JP)%XLON_CUR - XLON0) - XBETA)*(XPI/180.)
ZFF(:) = SQRT(ZU_PROFILER(:)**2 + ZV_PROFILER(:)**2)
DO JK=1,IKU
IF (ZU_PROFILER(JK) >=0. .AND. ZV_PROFILER(JK) > 0.) &
@@ -307,15 +258,15 @@ PROFILER: DO JP = 1, NUMBPROFILER_LOC
ZDD(JK) = XUNDEF
END DO
! GPS IWV and ZTD
- XZS_GPS=TPROFILERS(JP)%XZ
+ XZS_GPS=TPROFILERS(JP)%XZ_CUR
IF ( ABS( ZZ(IKB)-XZS_GPS ) < 150 ) THEN ! distance between real and model orography ok
- ZRV(:) = STATPROF_INTERP_3D( TPROFILERS(JP), PR(:,:,:,1) )
- ZT(:) = STATPROF_INTERP_3D( TPROFILERS(JP), ZTEMP )
+ ZRV(:) = TPROFILERS(JP)%INTERP_HOR_FROM_MASSPOINT( PR(:,:,:,1) )
+ ZT(:) = TPROFILERS(JP)%INTERP_HOR_FROM_MASSPOINT( ZTEMP )
ZE(:) = ZPRES(:)*ZRV(:)/(ZRDSRV+ZRV(:))
- ZTV(:) = STATPROF_INTERP_3D( TPROFILERS(JP), ZTEMPV )
- ZZTD_PROFILER = STATPROF_INTERP_2D( TPROFILERS(JP), ZZTD )
- ZZHD_PROFILER = STATPROF_INTERP_2D( TPROFILERS(JP), ZZHD )
- ZZWD_PROFILER = STATPROF_INTERP_2D( TPROFILERS(JP), ZZWD )
+ ZTV(:) = TPROFILERS(JP)%INTERP_HOR_FROM_MASSPOINT( ZTEMPV )
+ ZZTD_PROFILER = TPROFILERS(JP)%INTERP_HOR_FROM_MASSPOINT( ZZTD )
+ ZZHD_PROFILER = TPROFILERS(JP)%INTERP_HOR_FROM_MASSPOINT( ZZHD )
+ ZZWD_PROFILER = TPROFILERS(JP)%INTERP_HOR_FROM_MASSPOINT( ZZWD )
ZIWV = 0.
DO JK=IKB,IKE
ZIWV=ZIWV+ZRHOD(JK)*ZRV(JK)*(ZZ(JK+1)-ZZ(JK))
@@ -372,312 +323,39 @@ PROFILER: DO JP = 1, NUMBPROFILER_LOC
TPROFILERS(JP)%XZWD(IN)= XUNDEF
TPROFILERS(JP)%XZHD(IN)= XUNDEF
END IF
- TPROFILERS(JP)%XZON (IN,:) = ZU_PROFILER(:) * COS(ZGAM) + ZV_PROFILER(:) * SIN(ZGAM)
- TPROFILERS(JP)%XMER (IN,:) = - ZU_PROFILER(:) * SIN(ZGAM) + ZV_PROFILER(:) * COS(ZGAM)
- TPROFILERS(JP)%XFF (IN,:) = ZFF(:)
- TPROFILERS(JP)%XDD (IN,:) = ZDD(:)
- TPROFILERS(JP)%XW (IN,:) = STATPROF_INTERP_3D( TPROFILERS(JP), PW )
- TPROFILERS(JP)%XTH (IN,:) = STATPROF_INTERP_3D( TPROFILERS(JP), PTH )
- TPROFILERS(JP)%XTHV (IN,:) = STATPROF_INTERP_3D( TPROFILERS(JP), ZTHV )
- IF ( CCLOUD == 'C2R2' .OR. CCLOUD == 'KHKO' ) TPROFILERS(JP)%XVISIGUL(IN,:) = STATPROF_INTERP_3D( TPROFILERS(JP), ZVISIGUL )
- IF ( CCLOUD /= 'NONE' .AND. CCLOUD /= 'REVE' ) TPROFILERS(JP)%XVISIKUN(IN,:) = STATPROF_INTERP_3D( TPROFILERS(JP), ZVISIKUN )
- TPROFILERS(JP)%XZZ (IN,:) = ZZ(:)
- TPROFILERS(JP)%XRHOD(IN,:) = ZRHOD(:)
- IF ( CCLOUD == 'ICE3' .OR. CCLOUD == 'ICE4' ) &
- TPROFILERS(JP)%XCIZ(IN,:) = STATPROF_INTERP_3D( TPROFILERS(JP), PCIT )
-! add RARE
- ! initialization CRARE and CRARE_ATT + LWC and IWC
- TPROFILERS(JP)%XCRARE(IN,:) = 0.
- TPROFILERS(JP)%XCRARE_ATT(IN,:) = 0.
- TPROFILERS(JP)%XLWCZ (IN,:) = 0.
- TPROFILERS(JP)%XIWCZ (IN,:) = 0.
- IF (CCLOUD=="LIMA" .OR. CCLOUD=="ICE3" ) THEN ! only for ICE3 and LIMA
- TPROFILERS(JP)%XLWCZ (IN,:) = STATPROF_INTERP_3D( TPROFILERS(JP), (PR(:,:,:,2)+PR(:,:,:,3))*PRHODREF(:,:,:) )
- TPROFILERS(JP)%XIWCZ (IN,:) = STATPROF_INTERP_3D( TPROFILERS(JP), (PR(:,:,:,4)+PR(:,:,:,5)+PR(:,:,:,6))*PRHODREF(:,:,:) )
- ZTEMPZ(:)=STATPROF_INTERP_3D( TPROFILERS(JP), ZTEMP(:,:,:) )
- ZRHODREFZ(:)=STATPROF_INTERP_3D( TPROFILERS(JP), PRHODREF(:,:,:) )
- ZCIT(:)=STATPROF_INTERP_3D( TPROFILERS(JP), PCIT(:,:,:) )
- IF (CCLOUD=="LIMA") THEN
- ZCCI(:)=STATPROF_INTERP_3D( TPROFILERS(JP), PSV(:,:,:,NSV_LIMA_NI) )
- ZCCR(:)=STATPROF_INTERP_3D( TPROFILERS(JP), PSV(:,:,:,NSV_LIMA_NR) )
- ZCCC(:)=STATPROF_INTERP_3D( TPROFILERS(JP), PSV(:,:,:,NSV_LIMA_NC) )
- END IF
- DO JLOOP=3,6
- ZRZ(:,JLOOP)=STATPROF_INTERP_3D( TPROFILERS(JP), PR(:,:,:,JLOOP) )
- END DO
- IF (CSURF=="EXTE") THEN
- DO JK=1,IKU
- ZRZ(JK,2)=STATPROF_INTERP_2D( TPROFILERS(JP), PR(:,:,JK,2)*PSEA(:,:) ) ! becomes cloud mixing ratio over sea
- ZRZ(JK,7)=STATPROF_INTERP_2D( TPROFILERS(JP), PR(:,:,JK,2)*(1.-PSEA(:,:)) ) ! becomes cloud mixing ratio over land
- END DO
- ELSE
- ZRZ(:,2)=STATPROF_INTERP_3D( TPROFILERS(JP), PR(:,:,:,2) )
- ZRZ(:,7)=0.
- END IF
- ALLOCATE(ZAELOC(IKU))
- !
- ZAELOC(:)=0.
- ! initialization of quadrature points and weights
- ALLOCATE(ZX(JPTS_GAULAG),ZW(JPTS_GAULAG))
- CALL GAULAG(JPTS_GAULAG,ZX,ZW) ! for integration over diameters
- ! initialize minimum values
- ALLOCATE(ZRTMIN(SIZE(PR,4)+1))
- IF (CCLOUD == 'LIMA') THEN
- ZRTMIN(2)=XRTMIN_L(2) ! cloud water over sea
- ZRTMIN(3)=XRTMIN_L(3)
- ZRTMIN(4)=XRTMIN_L(4)
- ZRTMIN(5)=1E-10
- ZRTMIN(6)=XRTMIN_L(6)
- ZRTMIN(7)=XRTMIN_L(2) ! cloud water over land
- ELSE
- ZRTMIN(2)=XRTMIN_I(2) ! cloud water over sea
- ZRTMIN(3)=XRTMIN_I(3)
- ZRTMIN(4)=XRTMIN_I(4)
- ZRTMIN(5)=1E-10
- ZRTMIN(6)=XRTMIN_I(6)
- ZRTMIN(7)=XRTMIN_I(2) ! cloud water over land
- END IF
- ! compute cloud radar reflectivity from vertical profiles of temperature
- ! and mixing ratios
- DO JK=1,IKU
- QMW=SQRT(QEPSW(ZTEMPZ(JK),XLIGHTSPEED/XLAM_CRAD))
- QMI=SQRT(QEPSI(ZTEMPZ(JK),XLIGHTSPEED/XLAM_CRAD))
- DO JLOOP=2,7
- IF (CCLOUD == 'LIMA') THEN
- GCALC=(ZRZ(JK,JLOOP)>ZRTMIN(JLOOP).AND.(JLOOP.NE.4.OR.ZCCI(JK)>0.).AND.&
- (JLOOP.NE.3.OR.ZCCR(JK)>0.).AND.((JLOOP.NE.2.AND.JLOOP.NE.7).OR.ZCCC(JK)>0.))
- ELSE
- GCALC=(ZRZ(JK,JLOOP)>ZRTMIN(JLOOP).AND.(JLOOP.NE.4.OR.ZCIT(JK)>0.))
- END IF
- IF (GCALC) THEN
- SELECT CASE(JLOOP)
- CASE(2) ! cloud water over sea
- IF (CCLOUD == 'LIMA') THEN
- ZA=XAC_L
- ZB=XBC_L
- ZCC=ZCCC(JK)*ZRHODREFZ(JK)
- ZCX=0.
- ZALPHA=XALPHAC_L
- ZNU=XNUC_L
- ZLBEX=1.0/(ZCX-ZB)
- ZLB=( ZA*ZCC*MOMG(ZALPHA,ZNU,ZB) )**(-ZLBEX)
- ELSE
- ZA=XAC_I
- ZB=XBC_I
- ZCC=XCONC_SEA
- ZCX=0.
- ZALPHA=XALPHAC2_I
- ZNU=XNUC2_I
- ZLBEX=1.0/(ZCX-ZB)
- ZLB=( ZA*ZCC*MOMG(ZALPHA,ZNU,ZB) )**(-ZLBEX)
- END IF
- CASE(3) ! rain water
- IF (CCLOUD == 'LIMA') THEN
- ZA=XAR_L
- ZB=XBR_L
- ZCC=ZCCR(JK)*ZRHODREFZ(JK)
- ZCX=0.
- ZALPHA=XALPHAR_L
- ZNU=XNUR_L
- ZLBEX=1.0/(ZCX-ZB)
- ZLB=( ZA*ZCC*MOMG(ZALPHA,ZNU,ZB) )**(-ZLBEX)
- ELSE
- ZA=XAR_I
- ZB=XBR_I
- ZCC=XCCR_I
- ZCX=-1.
- ZALPHA=XALPHAR_I
- ZNU=XNUR_I
- ZLB=XLBR_I
- ZLBEX=XLBEXR_I
- END IF
- CASE(4) ! pristine ice
- IF (CCLOUD == 'LIMA') THEN
- ZA=XAI_L
- ZB=XBI_L
- ZCC=ZCCI(JK)*ZRHODREFZ(JK)
- ZCX=0.
- ZALPHA=XALPHAI_L
- ZNU=XNUI_L
- ZLBEX=1.0/(ZCX-ZB)
- ZLB=( ZA*ZCC*MOMG(ZALPHA,ZNU,ZB) )**(-ZLBEX) ! because ZCC not included in XLBI
- ZFW=0
- ELSE
- ZA=XAI_I
- ZB=XBI_I
- ZCC=ZCIT(JK)
- ZCX=0.
- ZALPHA=XALPHAI_I
- ZNU=XNUI_I
- ZLBEX=XLBEXI_I
- ZLB=XLBI_I*ZCC**(-ZLBEX) ! because ZCC not included in XLBI
- ZFW=0
- END IF
- CASE(5) ! snow
- IF (CCLOUD == 'LIMA') THEN
- ZA=XAS_L
- ZB=XBS_L
- ZCC=XCCS_L
- ZCX=XCXS_L
- ZALPHA=XALPHAS_L
- ZNU=XNUS_L
- ZNS=XNS_L
- ZLB=XLBS_L
- ZLBEX=XLBEXS_L
- ZFW=0
- ELSE
- ZA=XAS_I
- ZB=XBS_I
- ZCC=XCCS_I
- ZCX=XCXS_I
- ZALPHA=XALPHAS_I
- ZNU=XNUS_I
- ZNS=XNS_I
- ZLB=XLBS_I
- ZLBEX=XLBEXS_I
- ZFW=0
- END IF
- CASE(6) ! graupel
- !If temperature between -10 and 10B0C and Mr and Mg over min
- !threshold: melting graupel
- ! with liquid water fraction Fw=Mr/(Mr+Mg) else dry graupel
- ! (Fw=0)
- IF( ZTEMPZ(JK) > XTT-10 .AND. ZTEMPZ(JK) < XTT+10 &
- .AND. ZRZ(JK,3) > ZRTMIN(3) ) THEN
- ZFW=ZRZ(JK,3)/(ZRZ(JK,3)+ZRZ(JK,JLOOP))
- ELSE
- ZFW=0
- END IF
- IF (CCLOUD == 'LIMA') THEN
- ZA=XAG_L
- ZB=XBG_L
- ZCC=XCCG_L
- ZCX=XCXG_L
- ZALPHA=XALPHAG_L
- ZNU=XNUG_L
- ZLB=XLBG_L
- ZLBEX=XLBEXG_L
- ELSE
- ZA=XAG_I
- ZB=XBG_I
- ZCC=XCCG_I
- ZCX=XCXG_I
- ZALPHA=XALPHAG_I
- ZNU=XNUG_I
- ZLB=XLBG_I
- ZLBEX=XLBEXG_I
- END IF
- CASE(7) ! cloud water over land
- IF (CCLOUD == 'LIMA') THEN
- ZA=XAC_L
- ZB=XBC_L
- ZCC=ZCCC(JK)*ZRHODREFZ(JK)
- ZCX=0.
- ZALPHA=XALPHAC_L
- ZNU=XNUC_L
- ZLBEX=1.0/(ZCX-ZB)
- ZLB=( ZA*ZCC*MOMG(ZALPHA,ZNU,ZB) )**(-ZLBEX)
- ELSE
- ZA=XAC_I
- ZB=XBC_I
- ZCC=XCONC_LAND
- ZCX=0.
- ZALPHA=XALPHAC_I
- ZNU=XNUC_I
- ZLBEX=1.0/(ZCX-ZB)
- ZLB=( ZA*ZCC*MOMG(ZALPHA,ZNU,ZB) )**(-ZLBEX)
- END IF
- END SELECT
- IF ( JLOOP == 5 .AND. CCLOUD=='LIMA'.AND.LSNOW_T_L ) THEN
- IF (ZTEMPZ(JK)>XTT-10.) THEN
- ZLBDA = MAX(MIN(XLBDAS_MAX_L, 10**(14.554-0.0423*ZTEMPZ(JK))),XLBDAS_MIN_L)*XTRANS_MP_GAMMAS_L
- ELSE
- ZLBDA = MAX(MIN(XLBDAS_MAX_L, 10**(6.226-0.0106*ZTEMPZ(JK))),XLBDAS_MIN_L)*XTRANS_MP_GAMMAS_L
- END IF
- ZN=ZNS*ZRHODREFZ(JK)*ZRZ(JK,JLOOP)*ZLBDA**ZB
- ELSE IF (JLOOP.EQ.5 .AND. (CCLOUD=='ICE3'.AND.LSNOW_T_I) ) THEN
- IF (ZTEMPZ(JK)>XTT-10.) THEN
- ZLBDA = MAX(MIN(XLBDAS_MAX_I, 10**(14.554-0.0423*ZTEMPZ(JK))),XLBDAS_MIN_I)*XTRANS_MP_GAMMAS_I
- ELSE
- ZLBDA = MAX(MIN(XLBDAS_MAX_I, 10**(6.226-0.0106*ZTEMPZ(JK))),XLBDAS_MIN_I)*XTRANS_MP_GAMMAS_I
- END IF
- ZN=ZNS*ZRHODREFZ(JK)*ZRZ(JK,JLOOP)*ZLBDA**ZB
- ELSE
- ZLBDA=ZLB*(ZRHODREFZ(JK)*ZRZ(JK,JLOOP))**ZLBEX
- ZN=ZCC*ZLBDA**ZCX
- END IF
- ZREFLOC=0.
- ZAETMP=0.
- DO JJ=1,JPTS_GAULAG ! Gauss-Laguerre quadrature
- ZDELTA_EQUIV=ZX(JJ)**(1./ZALPHA)/ZLBDA
- SELECT CASE(JLOOP)
- CASE(2,3,7)
- QM=QMW
- CASE(4,5,6)
- ! pristine ice, snow, dry graupel
- ZRHOHYD=MIN(6.*ZA*ZDELTA_EQUIV**(ZB-3.)/XPI,.92*XRHOLW)
- QM=sqrt(MG(QMI**2,CMPLX(1,0),ZRHOHYD/.92/XRHOLW))
- ! water inclusions in ice in air
- QEPSWI=MG(QMW**2,QM**2,ZFW)
- ! ice in air inclusions in water
- QEPSIW=MG(QM**2,QMW**2,1.-ZFW)
- !MG weighted rule (Matrosov 2008)
- IF(ZFW .LT. 0.37) THEN
- ZFPW=0
- ELSE IF(ZFW .GT. 0.63) THEN
- ZFPW=1
- ELSE
- ZFPW=(ZFW-0.37)/(0.63-0.37)
- ENDIF
- QM=sqrt(QEPSWI*(1.-ZFPW)+QEPSIW*ZFPW)
- END SELECT
- CALL BHMIE(XPI/XLAM_CRAD*ZDELTA_EQUIV,QM,ZQEXT,ZQSCA,ZQBACK)
- ZREFLOC=ZREFLOC+ZQBACK*ZX(JJ)**(ZNU-1)*ZDELTA_EQUIV**2*ZW(JJ)
- ZAETMP =ZAETMP +ZQEXT *ZX(JJ)**(ZNU-1)*ZDELTA_EQUIV**2*ZW(JJ)
- END DO
- ZREFLOC=ZREFLOC*(XLAM_CRAD/XPI)**4*ZN/(4.*GAMMA(ZNU)*.93)
- ZAETMP=ZAETMP * XPI *ZN/(4.*GAMMA(ZNU))
- TPROFILERS(JP)%XCRARE(IN,JK)=TPROFILERS(JP)%XCRARE(IN,JK)+ZREFLOC
- ZAELOC(JK)=ZAELOC(JK)+ZAETMP
- END IF
- END DO
- END DO
- ! apply attenuation
- ALLOCATE(ZZMZ(IKU))
- ZZMZ = ZZ(:) ! STATPROF_INTERP_3D( TPROFILERS(JP), ZZM(:,:,:) )
-! ZZMZ(1)=ZZM_STAT
- ! zenith
- ZAETOT=1.
- DO JK = 2,IKU
- ! attenuation from ZAELOC(JK) and ZAELOC(JK-1)
- ZAETOT=ZAETOT*EXP(-(ZAELOC(JK-1)+ZAELOC(JK))*(ZZMZ(JK)-ZZMZ(JK-1)))
- TPROFILERS(JP)%XCRARE_ATT(IN,JK)=TPROFILERS(JP)%XCRARE(IN,JK)*ZAETOT
- END DO
- DEALLOCATE(ZZMZ,ZAELOC)
- ! m^3 b mm^6/m^3 b dBZ
- WHERE(TPROFILERS(JP)%XCRARE(IN,:)>0)
- TPROFILERS(JP)%XCRARE(IN,:)=10.*LOG10(1.E18*TPROFILERS(JP)%XCRARE(IN,:))
- ELSEWHERE
- TPROFILERS(JP)%XCRARE(IN,:)=XUNDEF
- END WHERE
- WHERE(TPROFILERS(JP)%XCRARE_ATT(IN,:)>0)
- TPROFILERS(JP)%XCRARE_ATT(IN,:)=10.*LOG10(1.E18*TPROFILERS(JP)%XCRARE_ATT(IN,:))
- ELSEWHERE
- TPROFILERS(JP)%XCRARE_ATT(IN,:)=XUNDEF
- END WHERE
- DEALLOCATE(ZX,ZW,ZRTMIN)
- END IF ! end LOOP ICE3
-! end add RARE
-!!
- TPROFILERS(JP)%XP (IN,:) = STATPROF_INTERP_3D( TPROFILERS(JP), PP )
+ TPROFILERS(JP)%XZON (:,IN) = ZU_PROFILER(:) * COS(ZGAM) + ZV_PROFILER(:) * SIN(ZGAM)
+ TPROFILERS(JP)%XMER (:,IN) = - ZU_PROFILER(:) * SIN(ZGAM) + ZV_PROFILER(:) * COS(ZGAM)
+ TPROFILERS(JP)%XFF (:,IN) = ZFF(:)
+ TPROFILERS(JP)%XDD (:,IN) = ZDD(:)
+ TPROFILERS(JP)%XW (:,IN) = TPROFILERS(JP)%INTERP_HOR_FROM_MASSPOINT( PW )
+ TPROFILERS(JP)%XTH (:,IN) = TPROFILERS(JP)%INTERP_HOR_FROM_MASSPOINT( PTH )
+ TPROFILERS(JP)%XTHV (:,IN) = TPROFILERS(JP)%INTERP_HOR_FROM_MASSPOINT( ZTHV )
+ IF ( CCLOUD == 'C2R2' .OR. CCLOUD == 'KHKO' ) &
+ TPROFILERS(JP)%XVISIGUL(:,IN) = TPROFILERS(JP)%INTERP_HOR_FROM_MASSPOINT( ZVISIGUL )
+ IF ( CCLOUD /= 'NONE' .AND. CCLOUD /= 'REVE' ) &
+ TPROFILERS(JP)%XVISIKUN(:,IN) = TPROFILERS(JP)%INTERP_HOR_FROM_MASSPOINT( ZVISIKUN )
+ TPROFILERS(JP)%XZZ (:,IN) = ZZ(:)
+ TPROFILERS(JP)%XRHOD(:,IN) = ZRHOD(:)
+ IF (CCLOUD=="LIMA") THEN
+ TPROFILERS(JP)%XCIZ(:,IN) = TPROFILERS(JP)%INTERP_HOR_FROM_MASSPOINT( PSV(:,:,:,NSV_LIMA_NI) )
+ TPROFILERS(JP)%XCCZ(:,IN) = TPROFILERS(JP)%INTERP_HOR_FROM_MASSPOINT( PSV(:,:,:,NSV_LIMA_NC) )
+ TPROFILERS(JP)%XCRZ(:,IN) = TPROFILERS(JP)%INTERP_HOR_FROM_MASSPOINT( PSV(:,:,:,NSV_LIMA_NR) )
+ ELSE IF ( CCLOUD=="ICE3" .OR. CCLOUD=="ICE4" ) THEN
+ TPROFILERS(JP)%XCIZ(:,IN) = TPROFILERS(JP)%INTERP_HOR_FROM_MASSPOINT( PCIT )
+ END IF
+
+ CALL Sensor_wc_compute( TPROFILERS(JP), IN, PR, PRHODREF )
+ CALL Sensor_rare_compute( TPROFILERS(JP), IN, PR, PSV, PRHODREF, PCIT, ZTEMP, ZZ, PSEA )
+ !!
+ TPROFILERS(JP)%XP (:,IN) = TPROFILERS(JP)%INTERP_HOR_FROM_MASSPOINT( PP )
!
DO JSV=1,SIZE(PR,4)
- TPROFILERS(JP)%XR (IN,:,JSV) = STATPROF_INTERP_3D( TPROFILERS(JP), PR(:,:,:,JSV) )
+ TPROFILERS(JP)%XR (:,IN,JSV) = TPROFILERS(JP)%INTERP_HOR_FROM_MASSPOINT( PR(:,:,:,JSV) )
END DO
ZWORK(:,:,:,:)=PSV(:,:,:,:)
ZWORK(:,:,1,:)=PSV(:,:,2,:)
DO JSV=1,SIZE(PSV,4)
- TPROFILERS(JP)%XSV (IN,:,JSV) = STATPROF_INTERP_3D( TPROFILERS(JP), ZWORK(:,:,:,JSV) )
+ TPROFILERS(JP)%XSV (:,IN,JSV) = TPROFILERS(JP)%INTERP_HOR_FROM_MASSPOINT( ZWORK(:,:,:,JSV) )
END DO
ZWORK2(:,:,:,:) = 0.
DO JK=IKB,IKE
@@ -685,29 +363,19 @@ PROFILER: DO JP = 1, NUMBPROFILER_LOC
ZWORK2(:,:,JK,:)=PAER(:,:,IKRAD,:)
END DO
DO JSV=1,SIZE(PAER,4)
- TPROFILERS(JP)%XAER(IN,:,JSV) = STATPROF_INTERP_3D( TPROFILERS(JP), ZWORK2(:,:,:,JSV) )
+ TPROFILERS(JP)%XAER(:,IN,JSV) = TPROFILERS(JP)%INTERP_HOR_FROM_MASSPOINT( ZWORK2(:,:,:,JSV) )
END DO
- IF (SIZE(PTKE)>0) TPROFILERS(JP)%XTKE (IN,:) = STATPROF_INTERP_3D( TPROFILERS(JP), PTKE )
+ IF (SIZE(PTKE)>0) TPROFILERS(JP)%XTKE (:,IN) = TPROFILERS(JP)%INTERP_HOR_FROM_MASSPOINT( PTKE )
+
+ ! XRHOD_SENSOR is not computed for profilers because not very useful
+ ! If needed, the interpolation must also be done vertically
+ ! (and therefore the vertical interpolation coefficients have to be computed)
+ ! TPROFILERS(JP)%XRHOD_SENSOR(IN) = ...
+
+ IF ( CRAD /= 'NONE' ) TPROFILERS(JP)%XTSRAD(IN) = TPROFILERS(JP)%INTERP_HOR_FROM_MASSPOINT( PTS )
!
- IF (LDIAG_IN_RUN) THEN
- TPROFILERS(JP)%XT2M (IN) = STATPROF_INTERP_2D( TPROFILERS(JP), XCURRENT_T2M )
- TPROFILERS(JP)%XQ2M (IN) = STATPROF_INTERP_2D( TPROFILERS(JP), XCURRENT_Q2M )
- TPROFILERS(JP)%XHU2M (IN) = STATPROF_INTERP_2D( TPROFILERS(JP), XCURRENT_HU2M )
- TPROFILERS(JP)%XZON10M(IN) = STATPROF_INTERP_2D( TPROFILERS(JP), XCURRENT_ZON10M )
- TPROFILERS(JP)%XMER10M(IN) = STATPROF_INTERP_2D( TPROFILERS(JP), XCURRENT_MER10M )
- TPROFILERS(JP)%XRN (IN) = STATPROF_INTERP_2D( TPROFILERS(JP), XCURRENT_RN )
- TPROFILERS(JP)%XH (IN) = STATPROF_INTERP_2D( TPROFILERS(JP), XCURRENT_H )
- TPROFILERS(JP)%XLE (IN) = STATPROF_INTERP_2D( TPROFILERS(JP), XCURRENT_LE )
- TPROFILERS(JP)%XLEI (IN) = STATPROF_INTERP_2D( TPROFILERS(JP), XCURRENT_LEI )
- TPROFILERS(JP)%XGFLUX (IN) = STATPROF_INTERP_2D( TPROFILERS(JP), XCURRENT_GFLUX )
- IF (CRAD /= 'NONE') THEN
- TPROFILERS(JP)%XSWD (IN) = STATPROF_INTERP_2D( TPROFILERS(JP), XCURRENT_SWD )
- TPROFILERS(JP)%XSWU (IN) = STATPROF_INTERP_2D( TPROFILERS(JP), XCURRENT_SWU )
- TPROFILERS(JP)%XLWD (IN) = STATPROF_INTERP_2D( TPROFILERS(JP), XCURRENT_LWD )
- TPROFILERS(JP)%XLWU (IN) = STATPROF_INTERP_2D( TPROFILERS(JP), XCURRENT_LWU )
- END IF
- TPROFILERS(JP)%XTKE_DISS(IN,:) = STATPROF_INTERP_3D( TPROFILERS(JP), XCURRENT_TKE_DISS )
- END IF
+ IF ( LDIAG_SURFRAD_PROF ) CALL STATPROF_DIAG_SURFRAD(TPROFILERS(JP), IN )
+ TPROFILERS(JP)%XTKE_DISS(:,IN) = TPROFILERS(JP)%INTERP_HOR_FROM_MASSPOINT( XCURRENT_TKE_DISS )
END DO PROFILER
!
!----------------------------------------------------------------------------
diff --git a/src/mesonh/ext/read_all_data_grib_case.f90 b/src/mesonh/ext/read_all_data_grib_case.f90
index eec912f59b18bf5c7e0a2a137a3136a38264955c..af2db5f9e53eeb8e755fc5435f1ae6a45c98a6e9 100644
--- a/src/mesonh/ext/read_all_data_grib_case.f90
+++ b/src/mesonh/ext/read_all_data_grib_case.f90
@@ -713,6 +713,10 @@ DEALLOCATE (ZLNPS_G)
!
WRITE (ILUOUT0,'(A)') ' | Reading T and Q fields'
!
+IF (IMODEL==11) THEN
+ CALL SEARCH_FIELD(IGRIB,INUM,KPARAM=130,KLEV1=1000) !look for air temperature at pressure level 1000hPa
+ IF (INUM < 0) IMODEL = 0 ! This change is for handling IFS model level grib file obtained by python API
+END IF
IF (IMODEL/=10.AND.IMODEL/=11) THEN
SELECT CASE (IMODEL)
CASE(0) ! ECMWF
diff --git a/src/mesonh/ext/read_desfmn.f90 b/src/mesonh/ext/read_desfmn.f90
index b65cce7aaf57610c6eac1e4d383bc036497b137b..3ced113c52d07eb9732f0104037bcaeb7e635934 100644
--- a/src/mesonh/ext/read_desfmn.f90
+++ b/src/mesonh/ext/read_desfmn.f90
@@ -202,9 +202,14 @@ END MODULE MODI_READ_DESFM_n
!
!* 0. DECLARATIONS
! ------------
-USE MODD_IO, ONLY: TFILEDATA
-USE MODD_LUNIT_n, ONLY: TLUOUT
+USE MODD_IO, ONLY: TFILEDATA
+USE MODD_LUNIT_n, ONLY: TLUOUT
+USE MODD_NEB_n, ONLY: NEBN_INIT
USE MODD_PARAMETERS
+USE MODD_PARAM_ICE_n, ONLY : PARAM_ICEN_INIT
+USE MODD_PARAM_LIMA, ONLY: PARAM_LIMA_INIT
+USE MODD_PARAM_MFSHALL_n, ONLY: PARAM_MFSHALLN_INIT
+USE MODD_TURB_n, ONLY: TURBN_INIT, CTOM, LRMC01
!
USE MODN_BACKUP
USE MODN_BUDGET
@@ -220,14 +225,9 @@ USE MODN_PARAM_n
USE MODN_PARAM_RAD_n
USE MODN_PARAM_ECRAD_n
USE MODN_PARAM_KAFR_n
-USE MODD_PARAM_MFSHALL_n, ONLY: PARAM_MFSHALLN_INIT
-USE MODD_PARAM_ICE_n, ONLY : PARAM_ICEN_INIT
-USE MODD_PARAM_LIMA, ONLY: PARAM_LIMA_INIT
USE MODN_LUNIT_n
USE MODN_LBC_n
USE MODN_NUDGING_n
-USE MODD_TURB_n, ONLY: TURBN_INIT, CTOM, LRMC01
-USE MODD_NEB_n, ONLY: NEBN_INIT
USE MODN_FRC
USE MODN_BLANK_n
USE MODN_CH_SOLVER_n
@@ -266,8 +266,6 @@ USE MODN_LATZ_EDFLX
USE MODN_2D_FRC
USE MODN_BLOWSNOW_n
USE MODN_BLOWSNOW
-USE MODN_PROFILER_n
-USE MODN_STATION_n
!
! USE MODN_FLYERS
!
@@ -342,6 +340,7 @@ LOGICAL :: GFOUND ! Return code when searching namelist
LOGICAL,DIMENSION(JPMODELMAX),SAVE :: LTEMPDEPOS_DST ! Dust Moist flag
LOGICAL,DIMENSION(JPMODELMAX),SAVE :: LTEMPDEPOS_SLT ! Sea Salt Moist flag
LOGICAL,DIMENSION(JPMODELMAX),SAVE :: LTEMPDEPOS_AER ! Orilam Moist flag
+TYPE(TFILEDATA), POINTER :: TZDESFILE
!
!-------------------------------------------------------------------------------
!
@@ -353,136 +352,139 @@ CALL PRINT_MSG(NVERB_DEBUG,'IO','READ_DESFM_n','called for '//TRIM(TPDATAFILE%CN
IF (.NOT.ASSOCIATED(TPDATAFILE%TDESFILE)) &
CALL PRINT_MSG(NVERB_FATAL,'IO','READ_DESFM_n','TDESFILE not associated for '//TRIM(TPDATAFILE%CNAME))
!
-ILUDES = TPDATAFILE%TDESFILE%NLU
+TZDESFILE => TPDATAFILE%TDESFILE
+ILUDES = TZDESFILE%NLU
ILUOUT = TLUOUT%NLU
!
-CALL POSNAM(ILUDES,'NAM_LUNITN',GFOUND)
+CALL POSNAM( TZDESFILE, 'NAM_LUNITN', GFOUND )
CALL INIT_NAM_LUNITN
IF (GFOUND) THEN
READ(UNIT=ILUDES,NML=NAM_LUNITn)
CALL UPDATE_NAM_LUNITN
END IF
-CALL POSNAM(ILUDES,'NAM_CONFN',GFOUND)
+CALL POSNAM( TZDESFILE, 'NAM_CONFN', GFOUND )
CALL INIT_NAM_CONFN
IF (GFOUND) THEN
READ(UNIT=ILUDES,NML=NAM_CONFn)
CALL UPDATE_NAM_CONFN
END IF
-CALL POSNAM(ILUDES,'NAM_DYNN',GFOUND)
+CALL POSNAM( TZDESFILE, 'NAM_DYNN', GFOUND )
CALL INIT_NAM_DYNN
IF (GFOUND) THEN
READ(UNIT=ILUDES,NML=NAM_DYNn)
CALL UPDATE_NAM_DYNN
END IF
-CALL POSNAM(ILUDES,'NAM_ADVN',GFOUND)
+CALL POSNAM( TZDESFILE, 'NAM_ADVN', GFOUND )
CALL INIT_NAM_ADVN
IF (GFOUND) THEN
READ(UNIT=ILUDES,NML=NAM_ADVn)
CALL UPDATE_NAM_ADVN
END IF
-CALL POSNAM(ILUDES,'NAM_PARAMN',GFOUND)
+CALL POSNAM( TZDESFILE, 'NAM_PARAMN', GFOUND )
CALL INIT_NAM_PARAMn
IF (GFOUND) THEN
READ(UNIT=ILUDES,NML=NAM_PARAMn)
CALL UPDATE_NAM_PARAMn
END IF
-CALL POSNAM(ILUDES,'NAM_PARAM_RADN',GFOUND)
+CALL POSNAM( TZDESFILE, 'NAM_PARAM_RADN', GFOUND )
CALL INIT_NAM_PARAM_RADn
IF (GFOUND) THEN
READ(UNIT=ILUDES,NML=NAM_PARAM_RADn)
CALL UPDATE_NAM_PARAM_RADn
END IF
#ifdef MNH_ECRAD
-CALL POSNAM(ILUDES,'NAM_PARAM_ECRADN',GFOUND)
+CALL POSNAM( TZDESFILE, 'NAM_PARAM_ECRADN', GFOUND )
CALL INIT_NAM_PARAM_ECRADn
IF (GFOUND) THEN
READ(UNIT=ILUDES,NML=NAM_PARAM_ECRADn)
CALL UPDATE_NAM_PARAM_ECRADn
END IF
#endif
-CALL POSNAM(ILUDES,'NAM_PARAM_KAFRN',GFOUND)
+CALL POSNAM( TZDESFILE, 'NAM_PARAM_KAFRN', GFOUND )
CALL INIT_NAM_PARAM_KAFRn
IF (GFOUND) THEN
READ(UNIT=ILUDES,NML=NAM_PARAM_KAFRn)
CALL UPDATE_NAM_PARAM_KAFRn
END IF
-CALL PARAM_MFSHALLN_INIT(CPROGRAM, ILUDES, .FALSE., ILUOUT, .FALSE., .TRUE., .FALSE., 0)
-CALL POSNAM(ILUDES,'NAM_LBCN',GFOUND)
+CALL PARAM_MFSHALLN_INIT(CPROGRAM, TZDESFILE, .FALSE., ILUOUT, .FALSE., .TRUE., .FALSE., 0)
+CALL POSNAM( TZDESFILE, 'NAM_LBCN', GFOUND )
CALL INIT_NAM_LBCn
IF (GFOUND) THEN
READ(UNIT=ILUDES,NML=NAM_LBCn)
CALL UPDATE_NAM_LBCn
END IF
-CALL POSNAM(ILUDES,'NAM_NUDGINGN',GFOUND)
+CALL POSNAM( TZDESFILE, 'NAM_NUDGINGN', GFOUND )
CALL INIT_NAM_NUDGINGn
IF (GFOUND) THEN
READ(UNIT=ILUDES,NML=NAM_NUDGINGn)
CALL UPDATE_NAM_NUDGINGn
END IF
-CALL TURBN_INIT(CPROGRAM, ILUDES, .FALSE., ILUOUT, .FALSE., .TRUE., .FALSE., 0)
-CALL NEBN_INIT(CPROGRAM, ILUDES, .FALSE., ILUOUT, .FALSE., .TRUE., .FALSE., 0)
-CALL PARAM_ICEN_INIT(CPROGRAM, ILUDES, .FALSE., ILUOUT, .FALSE., .TRUE., .FALSE., 0)
-CALL POSNAM(ILUDES,'NAM_CH_MNHCN',GFOUND)
+CALL TURBN_INIT(CPROGRAM, TZDESFILE, .FALSE., ILUOUT, .FALSE., .TRUE., .FALSE., 0)
+CALL NEBN_INIT(CPROGRAM, TZDESFILE, .FALSE., ILUOUT, .FALSE., .TRUE., .FALSE., 0)
+CALL PARAM_ICEN_INIT(CPROGRAM, TZDESFILE, .FALSE., ILUOUT, .FALSE., .TRUE., .FALSE., 0)
+CALL POSNAM( TZDESFILE, 'NAM_CH_MNHCN', GFOUND )
CALL INIT_NAM_CH_MNHCn
IF (GFOUND) THEN
READ(UNIT=ILUDES,NML=NAM_CH_MNHCn)
CALL UPDATE_NAM_CH_MNHCn
END IF
-CALL POSNAM(ILUDES,'NAM_CH_SOLVERN',GFOUND)
+CALL POSNAM( TZDESFILE, 'NAM_CH_SOLVERN', GFOUND )
CALL INIT_NAM_CH_SOLVERn
IF (GFOUND) THEN
READ(UNIT=ILUDES,NML=NAM_CH_SOLVERn)
CALL UPDATE_NAM_CH_SOLVERn
END IF
-CALL POSNAM(ILUDES,'NAM_DRAGN',GFOUND)
+CALL POSNAM( TZDESFILE, 'NAM_DRAGN', GFOUND )
CALL INIT_NAM_DRAGn
IF (GFOUND) THEN
READ(UNIT=ILUDES,NML=NAM_DRAGn)
CALL UPDATE_NAM_DRAGn
END IF
-CALL POSNAM(ILUDES,'NAM_IBM_PARAMN',GFOUND,ILUOUT)
+CALL POSNAM( TZDESFILE, 'NAM_IBM_PARAMN', GFOUND )
CALL INIT_NAM_IBM_PARAMn
IF (GFOUND) THEN
READ(UNIT=ILUDES,NML=NAM_IBM_PARAMn)
CALL UPDATE_NAM_IBM_PARAMn
END IF
-CALL POSNAM(ILUDES,'NAM_RECYCL_PARAMN',GFOUND,ILUOUT)
+CALL POSNAM( TZDESFILE, 'NAM_RECYCL_PARAMN', GFOUND )
CALL INIT_NAM_RECYCL_PARAMn
IF (GFOUND) THEN
READ(UNIT=ILUDES,NML=NAM_RECYCL_PARAMn)
CALL UPDATE_NAM_RECYCL_PARAMn
END IF
-CALL POSNAM(ILUDES,'NAM_SERIESN',GFOUND,ILUOUT)
+CALL POSNAM( TZDESFILE, 'NAM_SERIESN', GFOUND )
CALL INIT_NAM_SERIESn
IF (GFOUND) THEN
READ(UNIT=ILUDES,NML=NAM_SERIESn)
CALL UPDATE_NAM_SERIESn
END IF
-CALL POSNAM(ILUDES,'NAM_BLOWSNOWN',GFOUND,ILUOUT)
+CALL POSNAM( TZDESFILE, 'NAM_BLOWSNOWN', GFOUND )
CALL INIT_NAM_BLOWSNOWn
IF (GFOUND) THEN
READ(UNIT=ILUDES,NML=NAM_BLOWSNOWn)
CALL UPDATE_NAM_BLOWSNOWn
END IF
-CALL POSNAM(ILUDES,'NAM_BLANKN',GFOUND,ILUOUT)
+CALL POSNAM( TZDESFILE, 'NAM_BLANKN', GFOUND )
CALL INIT_NAM_BLANKn
IF (GFOUND) THEN
READ(UNIT=ILUDES,NML=NAM_BLANKn)
CALL UPDATE_NAM_BLANKn
END IF
-CALL POSNAM(ILUDES,'NAM_PROFILERN',GFOUND,ILUOUT)
-CALL INIT_NAM_PROFILERn
-IF (GFOUND) THEN
- READ(UNIT=ILUDES,NML=NAM_PROFILERN)
- CALL UPDATE_NAM_PROFILERn
-END IF
-CALL POSNAM(ILUDES,'NAM_STATIONN',GFOUND,ILUOUT)
-CALL INIT_NAM_STATIONn
-IF (GFOUND) THEN
- READ(UNIT=ILUDES,NML=NAM_STATIONn)
- CALL UPDATE_NAM_STATIONn
-END IF
-CALL POSNAM(ILUDES,'NAM_FIREN',GFOUND,ILUOUT)
+! Note: it is not useful to read the PROFILERS/STATIONS namelists in the .des files
+! The values here (if present in file) don't need to be compared with the ones in the EXSEGn files
+! CALL POSNAM( TZDESFILE, 'NAM_PROFILERN', GFOUND )
+! CALL INIT_NAM_PROFILERn
+! IF (GFOUND) THEN
+! READ(UNIT=ILUDES,NML=NAM_PROFILERN)
+! CALL UPDATE_NAM_PROFILERn
+! END IF
+! CALL POSNAM( TZDESFILE, 'NAM_STATIONN', GFOUND )
+! CALL INIT_NAM_STATIONn
+! IF (GFOUND) THEN
+! READ(UNIT=ILUDES,NML=NAM_STATIONn)
+! CALL UPDATE_NAM_STATIONn
+! END IF
+CALL POSNAM( TZDESFILE, 'NAM_FIREN', GFOUND )
CALL INIT_NAM_FIREn
IF (GFOUND) THEN
READ(UNIT=ILUDES,NML=NAM_FIREn)
@@ -491,13 +493,13 @@ END IF
!
!
IF (KMI == 1) THEN
- CALL POSNAM(ILUDES,'NAM_CONF',GFOUND)
+ CALL POSNAM( TZDESFILE, 'NAM_CONF', GFOUND )
IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_CONF)
- CALL POSNAM(ILUDES,'NAM_DYN',GFOUND)
+ CALL POSNAM( TZDESFILE, 'NAM_DYN', GFOUND )
IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_DYN)
- CALL POSNAM(ILUDES,'NAM_NESTING',GFOUND)
+ CALL POSNAM( TZDESFILE, 'NAM_NESTING', GFOUND )
IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_NESTING)
- CALL POSNAM(ILUDES,'NAM_BACKUP',GFOUND)
+ CALL POSNAM( TZDESFILE, 'NAM_BACKUP', GFOUND )
IF (GFOUND) THEN
IF (.NOT.ALLOCATED(XBAK_TIME)) THEN
ALLOCATE(XBAK_TIME(NMODEL,JPOUTMAX))
@@ -521,10 +523,10 @@ IF (KMI == 1) THEN
END IF
READ(UNIT=ILUDES,NML=NAM_BACKUP)
ELSE
- CALL POSNAM(ILUDES,'NAM_FMOUT',GFOUND)
+ CALL POSNAM( TZDESFILE, 'NAM_FMOUT', GFOUND )
IF (GFOUND) CALL PRINT_MSG(NVERB_FATAL,'IO','READ_DESFM_n','use namelist NAM_BACKUP instead of namelist NAM_FMOUT')
END IF
- CALL POSNAM(ILUDES,'NAM_OUTPUT',GFOUND)
+ CALL POSNAM( TZDESFILE, 'NAM_OUTPUT', GFOUND )
IF (GFOUND) THEN
IF (.NOT.ALLOCATED(XBAK_TIME)) THEN
ALLOCATE(XBAK_TIME(NMODEL,JPOUTMAX)) !Allocate *BAK* variables to prevent
@@ -550,83 +552,83 @@ IF (KMI == 1) THEN
END IF
! Note: it is not useful to read the budget namelists in the .des files
! The values here (if present in file) don't need to be compared with the ones in the EXSEGn files
-! CALL POSNAM(ILUDES,'NAM_BUDGET',GFOUND)
+! CALL POSNAM( TZDESFILE, 'NAM_BUDGET', GFOUND )
! IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_BUDGET)
-! CALL POSNAM(ILUDES,'NAM_BU_RU',GFOUND)
+! CALL POSNAM( TZDESFILE, 'NAM_BU_RU', GFOUND )
! IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_BU_RU)
-! CALL POSNAM(ILUDES,'NAM_BU_RV',GFOUND)
+! CALL POSNAM( TZDESFILE, 'NAM_BU_RV', GFOUND )
! IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_BU_RV)
-! CALL POSNAM(ILUDES,'NAM_BU_RW',GFOUND)
+! CALL POSNAM( TZDESFILE, 'NAM_BU_RW', GFOUND )
! IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_BU_RW)
-! CALL POSNAM(ILUDES,'NAM_BU_RTH',GFOUND)
+! CALL POSNAM( TZDESFILE, 'NAM_BU_RTH', GFOUND )
! IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_BU_RTH)
-! CALL POSNAM(ILUDES,'NAM_BU_RTKE',GFOUND)
+! CALL POSNAM( TZDESFILE, 'NAM_BU_RTKE', GFOUND )
! IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_BU_RTKE)
-! CALL POSNAM(ILUDES,'NAM_BU_RRV',GFOUND)
+! CALL POSNAM( TZDESFILE, 'NAM_BU_RRV', GFOUND )
! IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_BU_RRV)
-! CALL POSNAM(ILUDES,'NAM_BU_RRC',GFOUND)
+! CALL POSNAM( TZDESFILE, 'NAM_BU_RRC', GFOUND )
! IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_BU_RRC)
-! CALL POSNAM(ILUDES,'NAM_BU_RRR',GFOUND)
+! CALL POSNAM( TZDESFILE, 'NAM_BU_RRR', GFOUND )
! IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_BU_RRR)
-! CALL POSNAM(ILUDES,'NAM_BU_RRI',GFOUND)
+! CALL POSNAM( TZDESFILE, 'NAM_BU_RRI', GFOUND )
! IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_BU_RRI)
-! CALL POSNAM(ILUDES,'NAM_BU_RRS',GFOUND)
+! CALL POSNAM( TZDESFILE, 'NAM_BU_RRS', GFOUND )
! IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_BU_RRS)
-! CALL POSNAM(ILUDES,'NAM_BU_RRG',GFOUND)
+! CALL POSNAM( TZDESFILE, 'NAM_BU_RRG', GFOUND )
! IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_BU_RRG)
-! CALL POSNAM(ILUDES,'NAM_BU_RRH',GFOUND)
+! CALL POSNAM( TZDESFILE, 'NAM_BU_RRH', GFOUND )
! IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_BU_RRH)
-! CALL POSNAM(ILUDES,'NAM_BU_RSV',GFOUND)
+! CALL POSNAM( TZDESFILE, 'NAM_BU_RSV', GFOUND )
! IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_BU_RSV)
- CALL POSNAM(ILUDES,'NAM_LES',GFOUND)
+ CALL POSNAM( TZDESFILE, 'NAM_LES', GFOUND )
IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_LES)
- CALL POSNAM(ILUDES,'NAM_PDF',GFOUND)
+ CALL POSNAM( TZDESFILE, 'NAM_PDF', GFOUND )
IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_PDF)
- CALL POSNAM(ILUDES,'NAM_FRC',GFOUND)
+ CALL POSNAM( TZDESFILE, 'NAM_FRC', GFOUND )
IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_FRC)
- CALL POSNAM(ILUDES,'NAM_PARAM_C2R2',GFOUND)
+ CALL POSNAM( TZDESFILE, 'NAM_PARAM_C2R2', GFOUND )
IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_PARAM_C2R2)
- CALL POSNAM(ILUDES,'NAM_PARAM_C1R3',GFOUND)
+ CALL POSNAM( TZDESFILE, 'NAM_PARAM_C1R3', GFOUND )
IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_PARAM_C1R3)
- CALL PARAM_LIMA_INIT(CPROGRAM, ILUDES, .FALSE., ILUOUT, .FALSE., .TRUE., .FALSE., 0)
- CALL POSNAM(ILUDES,'NAM_ELEC',GFOUND)
+ CALL PARAM_LIMA_INIT(CPROGRAM, TZDESFILE, .FALSE., ILUOUT, .FALSE., .TRUE., .FALSE., 0)
+ CALL POSNAM( TZDESFILE, 'NAM_ELEC', GFOUND )
IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_ELEC)
- CALL POSNAM(ILUDES,'NAM_SERIES',GFOUND,ILUOUT)
+ CALL POSNAM( TZDESFILE, 'NAM_SERIES', GFOUND )
IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_SERIES)
- CALL POSNAM(ILUDES,'NAM_TURB_CLOUD',GFOUND,ILUOUT)
+ CALL POSNAM( TZDESFILE, 'NAM_TURB_CLOUD', GFOUND )
IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_TURB_CLOUD)
- CALL POSNAM(ILUDES,'NAM_CH_ORILAM',GFOUND,ILUOUT)
+ CALL POSNAM( TZDESFILE, 'NAM_CH_ORILAM', GFOUND )
IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_CH_ORILAM)
- CALL POSNAM(ILUDES,'NAM_DUST',GFOUND,ILUOUT)
+ CALL POSNAM( TZDESFILE, 'NAM_DUST', GFOUND )
IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_DUST)
- CALL POSNAM(ILUDES,'NAM_SALT',GFOUND,ILUOUT)
+ CALL POSNAM( TZDESFILE, 'NAM_SALT', GFOUND )
IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_SALT)
- CALL POSNAM(ILUDES,'NAM_PASPOL',GFOUND,ILUOUT)
+ CALL POSNAM( TZDESFILE, 'NAM_PASPOL', GFOUND )
IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_PASPOL)
#ifdef MNH_FOREFIRE
- CALL POSNAM(ILUDES,'NAM_FOREFIRE',GFOUND,ILUOUT)
+ CALL POSNAM( TZDESFILE, 'NAM_FOREFIRE', GFOUND )
IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_FOREFIRE)
#endif
- CALL POSNAM(ILUDES,'NAM_CONDSAMP',GFOUND,ILUOUT)
+ CALL POSNAM( TZDESFILE, 'NAM_CONDSAMP', GFOUND )
IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_CONDSAMP)
- CALL POSNAM(ILUDES,'NAM_BLOWSNOW',GFOUND,ILUOUT)
+ CALL POSNAM( TZDESFILE, 'NAM_BLOWSNOW', GFOUND )
IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_BLOWSNOW)
- CALL POSNAM(ILUDES,'NAM_2D_FRC',GFOUND,ILUOUT)
+ CALL POSNAM( TZDESFILE, 'NAM_2D_FRC', GFOUND )
IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_2D_FRC)
LTEMPDEPOS_DST(:) = LDEPOS_DST(:)
LTEMPDEPOS_SLT(:) = LDEPOS_SLT(:)
LTEMPDEPOS_AER(:) = LDEPOS_AER(:)
- CALL POSNAM(ILUDES,'NAM_LATZ_EDFLX',GFOUND)
+ CALL POSNAM( TZDESFILE, 'NAM_LATZ_EDFLX', GFOUND )
IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_LATZ_EDFLX)
- CALL POSNAM(ILUDES,'NAM_VISC',GFOUND,ILUOUT)
+ CALL POSNAM( TZDESFILE, 'NAM_VISC', GFOUND )
IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_VISC)
! Note: it is not useful to read the FLYERS/AIRCRAFTS/BALLOONS namelists in the .des files
! The values here (if present in file) don't need to be compared with the ones in the EXSEGn files
-! CALL POSNAM(ILUDES,'NAM_FLYERS',GFOUND,ILUOUT)
+! CALL POSNAM( TZDESFILE, 'NAM_FLYERS', GFOUND )
! IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_FLYERS)
-! CALL POSNAM(ILUSEG,'NAM_AIRCRAFTS',GFOUND,ILUOUT)
+! CALL POSNAM(ILUSEG,'NAM_AIRCRAFTS', GFOUND )
! IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_AIRCRAFTS)
-! CALL POSNAM(ILUSEG,'NAM_BALLOONS',GFOUND,ILUOUT)
+! CALL POSNAM(ILUSEG,'NAM_BALLOONS', GFOUND )
! IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_BALLOONS)
END IF
!
@@ -716,16 +718,16 @@ IF (NVERB >= 10) THEN
WRITE(UNIT=ILUOUT,NML=NAM_PARAM_KAFRn)
!
WRITE(UNIT=ILUOUT,FMT="('*** MASS FLUX SHALLOW CONVECTION ***')")
- CALL PARAM_MFSHALLN_INIT(CPROGRAM, 0, .FALSE., ILUOUT, .FALSE., .FALSE., .FALSE., 2)
+ CALL PARAM_MFSHALLN_INIT(CPROGRAM, TZDESFILE, .FALSE., ILUOUT, .FALSE., .FALSE., .FALSE., 2)
!
WRITE(UNIT=ILUOUT,FMT="('********** LBCn ********************')")
WRITE(UNIT=ILUOUT,NML=NAM_LBCn)
!
WRITE(UNIT=ILUOUT,FMT="('********** TURBn *******************')")
- CALL TURBN_INIT(CPROGRAM, 0, .FALSE., ILUOUT, .FALSE., .FALSE., .FALSE., 2)
+ CALL TURBN_INIT(CPROGRAM, TZDESFILE, .FALSE., ILUOUT, .FALSE., .FALSE., .FALSE., 2)
!
WRITE(UNIT=ILUOUT,FMT="('********** NEBn *******************')")
- CALL NEBN_INIT(CPROGRAM, 0, .FALSE., ILUOUT, .FALSE., .FALSE., .FALSE., 2)
+ CALL NEBN_INIT(CPROGRAM, TZDESFILE, .FALSE., ILUOUT, .FALSE., .FALSE., .FALSE., 2)
!
WRITE(UNIT=ILUOUT,FMT="('********** DRAGn *******************')")
WRITE(UNIT=ILUOUT,NML=NAM_DRAGn)
@@ -751,14 +753,15 @@ IF (NVERB >= 10) THEN
WRITE(UNIT=ILUOUT,FMT="('********** BLANKn ******************')")
WRITE(UNIT=ILUOUT,NML=NAM_BLANKn)
!
- WRITE(UNIT=ILUOUT,FMT="('********** PROFILERn *****************')")
- WRITE(UNIT=ILUOUT,NML=NAM_PROFILERn)
+! Profilers/stations namelists not read anymore in READ_DESFM_n
+! WRITE(UNIT=ILUOUT,FMT="('********** PROFILERn *****************')")
+! WRITE(UNIT=ILUOUT,NML=NAM_PROFILERn)
!
- WRITE(UNIT=ILUOUT,FMT="('********** STATIONn ******************')")
- WRITE(UNIT=ILUOUT,NML=NAM_STATIONn)
+! WRITE(UNIT=ILUOUT,FMT="('********** STATIONn ******************')")
+! WRITE(UNIT=ILUOUT,NML=NAM_STATIONn)
!
WRITE(UNIT=ILUOUT,FMT="('************ ICE SCHEME ***********************')")
- CALL PARAM_ICEN_INIT(CPROGRAM, 0, .FALSE., ILUOUT, .FALSE., .FALSE., .FALSE., 2)
+ CALL PARAM_ICEN_INIT(CPROGRAM, TZDESFILE, .FALSE., ILUOUT, .FALSE., .FALSE., .FALSE., 2)
!
WRITE(UNIT=ILUOUT,FMT="('********** BLAZE *******************')")
WRITE(UNIT=ILUOUT,NML=NAM_FIREn)
@@ -870,7 +873,7 @@ IF (NVERB >= 10) THEN
!
IF( CCLOUD == 'LIMA' ) THEN
WRITE(UNIT=ILUOUT,FMT="('************ LIMA SCHEME **********************')")
- CALL PARAM_LIMA_INIT(CPROGRAM, 0, .FALSE., ILUOUT, .FALSE., .FALSE., .FALSE., 2)
+ CALL PARAM_LIMA_INIT(CPROGRAM, TZDESFILE, .FALSE., ILUOUT, .FALSE., .FALSE., .FALSE., 2)
END IF
!
IF (CELEC /= 'NONE') THEN
diff --git a/src/mesonh/ext/read_exsegn.f90 b/src/mesonh/ext/read_exsegn.f90
index dfb02a2dc0931de75a7fef446a8576081aa97087..a5c44aee26580ff1bcd278192a9f83db8f8c5991 100644
--- a/src/mesonh/ext/read_exsegn.f90
+++ b/src/mesonh/ext/read_exsegn.f90
@@ -302,12 +302,14 @@ END MODULE MODI_READ_EXSEG_n
! P. Wautelet 09/03/2021: move some chemistry initializations to ini_nsv
! P. Wautelet 10/03/2021: move scalar variable name initializations to ini_nsv
! R. Honnert 23/04/2021: add HM21 mixing length and delete HRIO and BOUT from CMF_UPDRAFT
-! S. Riette 11/05/2021 HighLow cloud
+! S. Riette 11/05/2021: HighLow cloud
! A. Costes 12/2021: add Blaze fire model
+! R. Schoetter 12/2021: multi-level coupling between MesoNH and SURFEX
! P. Wautelet 27/04/2022: add namelist for profilers
! 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
@@ -319,6 +321,7 @@ USE MODD_CH_AEROSOL
USE MODD_CH_M9_n, ONLY : NEQ
USE MODD_CONDSAMP
USE MODD_CONF
+USE MODD_CONF_n, ONLY: CSTORAGE_TYPE
USE MODD_CONFZ
! USE MODD_DRAG_n
USE MODD_DUST
@@ -331,10 +334,20 @@ USE MODD_GET_n
USE MODD_GR_FIELD_n
USE MODD_IO, ONLY: TFILEDATA
USE MODD_LUNIT_n, ONLY: TLUOUT
-USE MODD_NSV,NSV_USER_n=>NSV_USER
+USE MODD_NEB_n, ONLY: NEBN_INIT, LSIGMAS, LSUBG_COND, CCONDENS, LSTATNW
+USE MODD_NSV, NSV_USER_n=>NSV_USER
USE MODD_PARAMETERS
+USE MODD_PARAM_ICE_n, ONLY: PARAM_ICEN_INIT, PARAM_ICEN, CSUBG_AUCV_RC, CSUBG_AUCV_RI, LRED, LSNOW_T
+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, &
+ LACTI, LNUCL, XALPHAC, XNUC, LMEYERS, &
+ LPTSPLIT, LSPRO, LADJ, LKHKO, &
+ NMOM_C, NMOM_R, NMOM_I, NMOM_S, NMOM_G, NMOM_H
+USE MODD_PARAM_MFSHALL_n, ONLY: PARAM_MFSHALLN_INIT
USE MODD_PASPOL
USE MODD_SALT
+USE MODD_TURB_n, ONLY: TURBN_INIT, CTOM, CTURBDIM, LRMC01, LHARAT, &
+ LCLOUDMODIFLM, CTURBLEN_CLOUD, XCEI_MIN, XCEI_MAX
USE MODD_VAR_ll, ONLY: NPROC
USE MODD_VISCOSITY
@@ -360,6 +373,7 @@ USE MODN_CONDSAMP
USE MODN_CONF
USE MODN_CONF_n
USE MODN_CONFZ
+USE MODN_COUPLING_LEVELS_n
USE MODN_DRAGBLDG_n
USE MODN_DRAG_n
USE MODN_DRAGTREE_n
@@ -390,26 +404,16 @@ 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 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, &
- LACTI, LNUCL, XALPHAC, XNUC, LMEYERS, &
- LPTSPLIT, LSPRO, LADJ, LKHKO, &
- NMOM_C, NMOM_R, NMOM_I, NMOM_S, NMOM_G, NMOM_H
-USE MODD_PARAM_MFSHALL_n, ONLY: PARAM_MFSHALLN_INIT
USE MODN_PARAM_n ! realized in subroutine ini_model n
USE MODN_PARAM_RAD_n
USE MODN_PASPOL
-USE MODN_PROFILER_n
+USE MODN_PROFILER_n, LDIAG_SURFRAD_PROF => LDIAG_SURFRAD
USE MODN_RECYCL_PARAM_n
USE MODN_SALT
USE MODN_SERIES
USE MODN_SERIES_n
-USE MODN_STATION_n
-USE MODD_TURB_n, ONLY: TURBN_INIT, CTOM, CTURBDIM, LRMC01, LHARAT, &
- LCLOUDMODIFLM, CTURBLEN_CLOUD, XCEI_MIN, XCEI_MAX
-USE MODD_NEB_n, ONLY: NEBN_INIT, LSIGMAS, LSUBG_COND, CCONDENS, LSTATNW
+USE MODN_STATION_n, LDIAG_SURFRAD_STAT => LDIAG_SURFRAD
USE MODN_VISCOSITY
!
IMPLICIT NONE
@@ -492,6 +496,7 @@ CALL INIT_NAM_DYNN
CALL INIT_NAM_ADVN
CALL INIT_NAM_DRAGTREEN
CALL INIT_NAM_DRAGBLDGN
+CALL INIT_NAM_COUPLING_LEVELSN
CALL INIT_NAM_PARAMN
CALL INIT_NAM_PARAM_RADN
#ifdef MNH_ECRAD
@@ -513,76 +518,78 @@ CALL INIT_NAM_STATIONn
CALL INIT_NAM_FIREn
!
WRITE(UNIT=ILUOUT,FMT="(/,'READING THE EXSEG.NAM FILE')")
-CALL POSNAM(ILUSEG,'NAM_LUNITN',GFOUND,ILUOUT)
+CALL POSNAM( TPEXSEGFILE, 'NAM_LUNITN', GFOUND )
IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_LUNITn)
-CALL POSNAM(ILUSEG,'NAM_CONFN',GFOUND,ILUOUT)
+CALL POSNAM( TPEXSEGFILE, 'NAM_CONFN', GFOUND )
IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_CONFn)
-CALL POSNAM(ILUSEG,'NAM_DYNN',GFOUND,ILUOUT)
+CALL POSNAM( TPEXSEGFILE, 'NAM_DYNN', GFOUND )
IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_DYNn)
-CALL POSNAM(ILUSEG,'NAM_ADVN',GFOUND,ILUOUT)
+CALL POSNAM( TPEXSEGFILE, 'NAM_ADVN', GFOUND )
IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_ADVn)
-CALL POSNAM(ILUSEG,'NAM_PARAMN',GFOUND,ILUOUT)
+CALL POSNAM( TPEXSEGFILE, 'NAM_PARAMN', GFOUND )
IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_PARAMn)
-CALL POSNAM(ILUSEG,'NAM_PARAM_RADN',GFOUND,ILUOUT)
+CALL POSNAM( TPEXSEGFILE, 'NAM_PARAM_RADN', GFOUND )
IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_PARAM_RADn)
#ifdef MNH_ECRAD
-CALL POSNAM(ILUSEG,'NAM_PARAM_ECRADN',GFOUND,ILUOUT)
+CALL POSNAM( TPEXSEGFILE, 'NAM_PARAM_ECRADN', GFOUND )
IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_PARAM_ECRADn)
#endif
-CALL POSNAM(ILUSEG,'NAM_PARAM_KAFRN',GFOUND,ILUOUT)
+CALL POSNAM( TPEXSEGFILE, 'NAM_PARAM_KAFRN', GFOUND )
IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_PARAM_KAFRn)
-CALL PARAM_MFSHALLN_INIT(CPROGRAM, ILUSEG, .FALSE., ILUOUT, .FALSE., .TRUE., .FALSE., 0)
-CALL POSNAM(ILUSEG,'NAM_LBCN',GFOUND,ILUOUT)
+CALL PARAM_MFSHALLN_INIT(CPROGRAM, TPEXSEGFILE, .FALSE., ILUOUT, .FALSE., .TRUE., .FALSE., 0)
+CALL POSNAM( TPEXSEGFILE, 'NAM_LBCN', GFOUND )
IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_LBCn)
-CALL POSNAM(ILUSEG,'NAM_NUDGINGN',GFOUND,ILUOUT)
+CALL POSNAM( TPEXSEGFILE, 'NAM_NUDGINGN', GFOUND )
IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_NUDGINGn)
-CALL TURBN_INIT(CPROGRAM, ILUSEG, .FALSE., ILUOUT, .FALSE., .TRUE., .FALSE., 0)
-CALL NEBN_INIT(CPROGRAM, ILUSEG, .FALSE., ILUOUT, .FALSE., .TRUE., .FALSE., 0)
-CALL PARAM_ICEN_INIT(CPROGRAM, ILUSEG, .FALSE., ILUOUT, .FALSE., .TRUE., .FALSE., 0)
-CALL POSNAM(ILUSEG,'NAM_DRAGN',GFOUND,ILUOUT)
+CALL TURBN_INIT(CPROGRAM, TPEXSEGFILE, .FALSE., ILUOUT, .FALSE., .TRUE., .FALSE., 0)
+CALL NEBN_INIT(CPROGRAM, TPEXSEGFILE, .FALSE., ILUOUT, .FALSE., .TRUE., .FALSE., 0)
+CALL PARAM_ICEN_INIT(CPROGRAM, TPEXSEGFILE, .FALSE., ILUOUT, .FALSE., .TRUE., .FALSE., 0)
+CALL POSNAM( TPEXSEGFILE, 'NAM_DRAGN', GFOUND )
IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_DRAGn)
-CALL POSNAM(ILUSEG,'NAM_IBM_PARAMN',GFOUND,ILUOUT)
+CALL POSNAM( TPEXSEGFILE, 'NAM_IBM_PARAMN', GFOUND )
IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_IBM_PARAMn)
-CALL POSNAM(ILUSEG,'NAM_RECYCL_PARAMN',GFOUND,ILUOUT)
+CALL POSNAM( TPEXSEGFILE, 'NAM_RECYCL_PARAMN', GFOUND )
IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_RECYCL_PARAMn)
-CALL POSNAM(ILUSEG,'NAM_CH_MNHCN',GFOUND,ILUOUT)
+CALL POSNAM( TPEXSEGFILE, 'NAM_CH_MNHCN', GFOUND )
IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_CH_MNHCn)
-CALL POSNAM(ILUSEG,'NAM_CH_SOLVERN',GFOUND,ILUOUT)
+CALL POSNAM( TPEXSEGFILE, 'NAM_CH_SOLVERN', GFOUND )
IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_CH_SOLVERn)
-CALL POSNAM(ILUSEG,'NAM_SERIESN',GFOUND,ILUOUT)
+CALL POSNAM( TPEXSEGFILE, 'NAM_SERIESN', GFOUND )
IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_SERIESn)
-CALL POSNAM(ILUSEG,'NAM_BLANKN',GFOUND,ILUOUT)
+CALL POSNAM( TPEXSEGFILE, 'NAM_BLANKN', GFOUND )
IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_BLANKn)
-CALL POSNAM(ILUSEG,'NAM_BLOWSNOWN',GFOUND,ILUOUT)
+CALL POSNAM( TPEXSEGFILE, 'NAM_BLOWSNOWN', GFOUND )
IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_BLOWSNOWn)
-CALL POSNAM(ILUSEG,'NAM_DRAGTREEN',GFOUND,ILUOUT)
+CALL POSNAM( TPEXSEGFILE, 'NAM_DRAGTREEN', GFOUND )
IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_DRAGTREEn)
-CALL POSNAM(ILUSEG,'NAM_DRAGBLDGN',GFOUND,ILUOUT)
+CALL POSNAM( TPEXSEGFILE, 'NAM_DRAGBLDGN', GFOUND )
IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_DRAGBLDGn)
-CALL POSNAM(ILUSEG,'NAM_EOL',GFOUND,ILUOUT)
+CALL POSNAM( TPEXSEGFILE,'NAM_COUPLING_LEVELSN', GFOUND )
+IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_COUPLING_LEVELSn)
+CALL POSNAM( TPEXSEGFILE, 'NAM_EOL', GFOUND )
IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_EOL)
-CALL POSNAM(ILUSEG,'NAM_EOL_ADNR',GFOUND,ILUOUT)
+CALL POSNAM( TPEXSEGFILE, 'NAM_EOL_ADNR', GFOUND )
IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_EOL_ADNR)
-CALL POSNAM(ILUSEG,'NAM_EOL_ALM',GFOUND,ILUOUT)
+CALL POSNAM( TPEXSEGFILE, 'NAM_EOL_ALM', GFOUND )
IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_EOL_ALM)
-CALL POSNAM(ILUSEG,'NAM_PROFILERN',GFOUND,ILUOUT)
+CALL POSNAM( TPEXSEGFILE, 'NAM_PROFILERN', GFOUND )
IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_PROFILERn)
-CALL POSNAM(ILUSEG,'NAM_STATIONN',GFOUND,ILUOUT)
+CALL POSNAM( TPEXSEGFILE, 'NAM_STATIONN', GFOUND )
IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_STATIONn)
-CALL POSNAM(ILUSEG,'NAM_FIREN',GFOUND,ILUOUT)
+CALL POSNAM( TPEXSEGFILE, 'NAM_FIREN', GFOUND )
IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_FIREn)
!
IF (KMI == 1) THEN
WRITE(UNIT=ILUOUT,FMT="(' namelists common to all the models ')")
- CALL POSNAM(ILUSEG,'NAM_CONF',GFOUND,ILUOUT)
+ CALL POSNAM( TPEXSEGFILE, 'NAM_CONF', GFOUND )
IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_CONF)
- CALL POSNAM(ILUSEG,'NAM_CONFZ',GFOUND,ILUOUT)
+ CALL POSNAM( TPEXSEGFILE, 'NAM_CONFZ', GFOUND )
IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_CONFZ)
- CALL POSNAM(ILUSEG,'NAM_DYN',GFOUND,ILUOUT)
+ CALL POSNAM( TPEXSEGFILE, 'NAM_DYN', GFOUND )
IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_DYN)
- CALL POSNAM(ILUSEG,'NAM_NESTING',GFOUND,ILUOUT)
+ CALL POSNAM( TPEXSEGFILE, 'NAM_NESTING', GFOUND )
IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_NESTING)
- CALL POSNAM(ILUSEG,'NAM_BACKUP',GFOUND,ILUOUT)
+ CALL POSNAM( TPEXSEGFILE, 'NAM_BACKUP', GFOUND )
IF (GFOUND) THEN
!Should have been allocated before in READ_DESFM_n
IF (.NOT.ALLOCATED(XBAK_TIME)) THEN
@@ -607,14 +614,14 @@ IF (KMI == 1) THEN
END IF
READ(UNIT=ILUSEG,NML=NAM_BACKUP)
ELSE
- CALL POSNAM(ILUSEG,'NAM_FMOUT',GFOUND)
+ CALL POSNAM( TPEXSEGFILE, 'NAM_FMOUT', GFOUND )
IF (GFOUND) THEN
CALL PRINT_MSG(NVERB_FATAL,'IO','READ_EXSEG_n','use namelist NAM_BACKUP instead of namelist NAM_FMOUT')
ELSE
IF (CPROGRAM=='MESONH') CALL PRINT_MSG(NVERB_ERROR,'IO','READ_EXSEG_n','namelist NAM_BACKUP not found')
END IF
END IF
- CALL POSNAM(ILUSEG,'NAM_OUTPUT',GFOUND,ILUOUT)
+ CALL POSNAM( TPEXSEGFILE, 'NAM_OUTPUT', GFOUND )
IF (GFOUND) THEN
!Should have been allocated before in READ_DESFM_n
IF (.NOT.ALLOCATED(XBAK_TIME)) THEN
@@ -639,10 +646,10 @@ IF (KMI == 1) THEN
END IF
READ(UNIT=ILUSEG,NML=NAM_OUTPUT)
END IF
- CALL POSNAM(ILUSEG,'NAM_BUDGET',GFOUND,ILUOUT)
+ CALL POSNAM( TPEXSEGFILE, 'NAM_BUDGET', GFOUND )
IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_BUDGET)
- CALL POSNAM(ILUSEG,'NAM_BU_RU',GFOUND,ILUOUT)
+ CALL POSNAM( TPEXSEGFILE, 'NAM_BU_RU', GFOUND )
IF (GFOUND) THEN
IF ( ALLOCATED( CBULIST_RU ) ) THEN
CALL Print_msg( NVERB_WARNING, 'IO', 'READ_EXSEG_n', 'unexpected: CBULIST_RU was already allocated' )
@@ -655,7 +662,7 @@ IF (KMI == 1) THEN
ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RU(0) )
END IF
- CALL POSNAM(ILUSEG,'NAM_BU_RV',GFOUND,ILUOUT)
+ CALL POSNAM( TPEXSEGFILE, 'NAM_BU_RV', GFOUND )
IF (GFOUND) THEN
IF ( ALLOCATED( CBULIST_RV ) ) THEN
CALL Print_msg( NVERB_WARNING, 'IO', 'READ_EXSEG_n', 'unexpected: CBULIST_RV was already allocated' )
@@ -668,7 +675,7 @@ IF (KMI == 1) THEN
ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RV(0) )
END IF
- CALL POSNAM(ILUSEG,'NAM_BU_RW',GFOUND,ILUOUT)
+ CALL POSNAM( TPEXSEGFILE, 'NAM_BU_RW', GFOUND )
IF (GFOUND) THEN
IF ( ALLOCATED( CBULIST_RW ) ) THEN
CALL Print_msg( NVERB_WARNING, 'IO', 'READ_EXSEG_n', 'unexpected: CBULIST_RW was already allocated' )
@@ -681,7 +688,7 @@ IF (KMI == 1) THEN
ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RW(0) )
END IF
- CALL POSNAM(ILUSEG,'NAM_BU_RTH',GFOUND,ILUOUT)
+ CALL POSNAM( TPEXSEGFILE, 'NAM_BU_RTH', GFOUND )
IF (GFOUND) THEN
IF ( ALLOCATED( CBULIST_RTH ) ) THEN
CALL Print_msg( NVERB_WARNING, 'IO', 'READ_EXSEG_n', 'unexpected: CBULIST_RTH was already allocated' )
@@ -694,7 +701,7 @@ IF (KMI == 1) THEN
ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RTH(0) )
END IF
- CALL POSNAM(ILUSEG,'NAM_BU_RTKE',GFOUND,ILUOUT)
+ CALL POSNAM( TPEXSEGFILE, 'NAM_BU_RTKE', GFOUND )
IF (GFOUND) THEN
IF ( ALLOCATED( CBULIST_RTKE ) ) THEN
CALL Print_msg( NVERB_WARNING, 'IO', 'READ_EXSEG_n', 'unexpected: CBULIST_RTKE was already allocated' )
@@ -707,7 +714,7 @@ IF (KMI == 1) THEN
ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RTKE(0) )
END IF
- CALL POSNAM(ILUSEG,'NAM_BU_RRV',GFOUND,ILUOUT)
+ CALL POSNAM( TPEXSEGFILE, 'NAM_BU_RRV', GFOUND )
IF (GFOUND) THEN
IF ( ALLOCATED( CBULIST_RRV ) ) THEN
CALL Print_msg( NVERB_WARNING, 'IO', 'READ_EXSEG_n', 'unexpected: CBULIST_RRV was already allocated' )
@@ -720,7 +727,7 @@ IF (KMI == 1) THEN
ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RRV(0) )
END IF
- CALL POSNAM(ILUSEG,'NAM_BU_RRC',GFOUND,ILUOUT)
+ CALL POSNAM( TPEXSEGFILE, 'NAM_BU_RRC', GFOUND )
IF (GFOUND) THEN
IF ( ALLOCATED( CBULIST_RRC ) ) THEN
CALL Print_msg( NVERB_WARNING, 'IO', 'READ_EXSEG_n', 'unexpected: CBULIST_RRC was already allocated' )
@@ -733,7 +740,7 @@ IF (KMI == 1) THEN
ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RRC(0) )
END IF
- CALL POSNAM(ILUSEG,'NAM_BU_RRR',GFOUND,ILUOUT)
+ CALL POSNAM( TPEXSEGFILE, 'NAM_BU_RRR', GFOUND )
IF (GFOUND) THEN
IF ( ALLOCATED( CBULIST_RRR ) ) THEN
CALL Print_msg( NVERB_WARNING, 'IO', 'READ_EXSEG_n', 'unexpected: CBULIST_RRR was already allocated' )
@@ -746,7 +753,7 @@ IF (KMI == 1) THEN
ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RRR(0) )
END IF
- CALL POSNAM(ILUSEG,'NAM_BU_RRI',GFOUND,ILUOUT)
+ CALL POSNAM( TPEXSEGFILE, 'NAM_BU_RRI', GFOUND )
IF (GFOUND) THEN
IF ( ALLOCATED( CBULIST_RRI ) ) THEN
CALL Print_msg( NVERB_WARNING, 'IO', 'READ_EXSEG_n', 'unexpected: CBULIST_RRI was already allocated' )
@@ -759,7 +766,7 @@ IF (KMI == 1) THEN
ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RRI(0) )
END IF
- CALL POSNAM(ILUSEG,'NAM_BU_RRS',GFOUND,ILUOUT)
+ CALL POSNAM( TPEXSEGFILE, 'NAM_BU_RRS', GFOUND )
IF (GFOUND) THEN
IF ( ALLOCATED( CBULIST_RRS ) ) THEN
CALL Print_msg( NVERB_WARNING, 'IO', 'READ_EXSEG_n', 'unexpected: CBULIST_RRS was already allocated' )
@@ -772,7 +779,7 @@ IF (KMI == 1) THEN
ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RRS(0) )
END IF
- CALL POSNAM(ILUSEG,'NAM_BU_RRG',GFOUND,ILUOUT)
+ CALL POSNAM( TPEXSEGFILE, 'NAM_BU_RRG', GFOUND )
IF (GFOUND) THEN
IF ( ALLOCATED( CBULIST_RRG ) ) THEN
CALL Print_msg( NVERB_WARNING, 'IO', 'READ_EXSEG_n', 'unexpected: CBULIST_RRG was already allocated' )
@@ -785,7 +792,7 @@ IF (KMI == 1) THEN
ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RRG(0) )
END IF
- CALL POSNAM(ILUSEG,'NAM_BU_RRH',GFOUND,ILUOUT)
+ CALL POSNAM( TPEXSEGFILE, 'NAM_BU_RRH', GFOUND )
IF (GFOUND) THEN
IF ( ALLOCATED( CBULIST_RRH ) ) THEN
CALL Print_msg( NVERB_WARNING, 'IO', 'READ_EXSEG_n', 'unexpected: CBULIST_RRH was already allocated' )
@@ -798,7 +805,7 @@ IF (KMI == 1) THEN
ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RRH(0) )
END IF
- CALL POSNAM(ILUSEG,'NAM_BU_RSV',GFOUND,ILUOUT)
+ CALL POSNAM( TPEXSEGFILE, 'NAM_BU_RSV', GFOUND )
IF (GFOUND) THEN
IF ( ALLOCATED( CBULIST_RSV ) ) THEN
CALL Print_msg( NVERB_WARNING, 'IO', 'READ_EXSEG_n', 'unexpected: CBULIST_RSV was already allocated' )
@@ -811,58 +818,58 @@ IF (KMI == 1) THEN
ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RSV(0) )
END IF
- CALL POSNAM(ILUSEG,'NAM_LES',GFOUND,ILUOUT)
+ CALL POSNAM( TPEXSEGFILE, 'NAM_LES', GFOUND )
IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_LES)
- CALL POSNAM(ILUSEG,'NAM_MEAN',GFOUND,ILUOUT)
+ CALL POSNAM( TPEXSEGFILE, 'NAM_MEAN', GFOUND )
IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_MEAN)
- CALL POSNAM(ILUSEG,'NAM_PDF',GFOUND,ILUOUT)
+ CALL POSNAM( TPEXSEGFILE, 'NAM_PDF', GFOUND )
IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_PDF)
- CALL POSNAM(ILUSEG,'NAM_FRC',GFOUND,ILUOUT)
+ CALL POSNAM( TPEXSEGFILE, 'NAM_FRC', GFOUND )
IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_FRC)
- CALL POSNAM(ILUSEG,'NAM_PARAM_C2R2',GFOUND,ILUOUT)
+ CALL POSNAM( TPEXSEGFILE, 'NAM_PARAM_C2R2', GFOUND )
IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_PARAM_C2R2)
- CALL POSNAM(ILUSEG,'NAM_PARAM_C1R3',GFOUND,ILUOUT)
+ CALL POSNAM( TPEXSEGFILE, 'NAM_PARAM_C1R3', GFOUND )
IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_PARAM_C1R3)
- CALL PARAM_LIMA_INIT(CPROGRAM, ILUSEG, .FALSE., ILUOUT, .FALSE., .TRUE., .FALSE., 0)
- CALL POSNAM(ILUSEG,'NAM_ELEC',GFOUND,ILUOUT)
+ CALL PARAM_LIMA_INIT(CPROGRAM, TPEXSEGFILE, .FALSE., ILUOUT, .FALSE., .TRUE., .FALSE., 0)
+ CALL POSNAM( TPEXSEGFILE, 'NAM_ELEC', GFOUND )
IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_ELEC)
- CALL POSNAM(ILUSEG,'NAM_SERIES',GFOUND,ILUOUT)
+ CALL POSNAM( TPEXSEGFILE, 'NAM_SERIES', GFOUND )
IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_SERIES)
- CALL POSNAM(ILUSEG,'NAM_CH_ORILAM',GFOUND,ILUOUT)
+ CALL POSNAM( TPEXSEGFILE, 'NAM_CH_ORILAM', GFOUND )
IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_CH_ORILAM)
- CALL POSNAM(ILUSEG,'NAM_DUST',GFOUND,ILUOUT)
+ CALL POSNAM( TPEXSEGFILE, 'NAM_DUST', GFOUND )
IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_DUST)
- CALL POSNAM(ILUSEG,'NAM_SALT',GFOUND,ILUOUT)
+ CALL POSNAM( TPEXSEGFILE, 'NAM_SALT', GFOUND )
IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_SALT)
- CALL POSNAM(ILUSEG,'NAM_PASPOL',GFOUND,ILUOUT)
+ CALL POSNAM( TPEXSEGFILE, 'NAM_PASPOL', GFOUND )
IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_PASPOL)
#ifdef MNH_FOREFIRE
- CALL POSNAM(ILUSEG,'NAM_FOREFIRE',GFOUND,ILUOUT)
+ CALL POSNAM( TPEXSEGFILE, 'NAM_FOREFIRE', GFOUND )
IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_FOREFIRE)
#endif
- CALL POSNAM(ILUSEG,'NAM_CONDSAMP',GFOUND,ILUOUT)
+ CALL POSNAM( TPEXSEGFILE, 'NAM_CONDSAMP', GFOUND )
IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_CONDSAMP)
- CALL POSNAM(ILUSEG,'NAM_2D_FRC',GFOUND,ILUOUT)
+ CALL POSNAM( TPEXSEGFILE, 'NAM_2D_FRC', GFOUND )
IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_2D_FRC)
- CALL POSNAM(ILUSEG,'NAM_LATZ_EDFLX',GFOUND)
+ CALL POSNAM( TPEXSEGFILE, 'NAM_LATZ_EDFLX', GFOUND )
IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_LATZ_EDFLX)
- CALL POSNAM(ILUSEG,'NAM_BLOWSNOW',GFOUND,ILUOUT)
+ CALL POSNAM( TPEXSEGFILE, 'NAM_BLOWSNOW', GFOUND )
IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_BLOWSNOW)
- CALL POSNAM(ILUSEG,'NAM_VISC',GFOUND,ILUOUT)
+ CALL POSNAM( TPEXSEGFILE, 'NAM_VISC', GFOUND )
IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_VISC)
- CALL POSNAM(ILUSEG,'NAM_FLYERS',GFOUND,ILUOUT)
+ CALL POSNAM( TPEXSEGFILE, 'NAM_FLYERS', GFOUND )
IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_FLYERS)
IF ( NAIRCRAFTS > 0 ) THEN
CALL AIRCRAFTS_NML_ALLOCATE( NAIRCRAFTS )
- CALL POSNAM(ILUSEG,'NAM_AIRCRAFTS',GFOUND,ILUOUT)
+ CALL POSNAM( TPEXSEGFILE, 'NAM_AIRCRAFTS', GFOUND )
IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_AIRCRAFTS)
END IF
IF ( NBALLOONS > 0 ) THEN
CALL BALLOONS_NML_ALLOCATE( NBALLOONS )
- CALL POSNAM(ILUSEG,'NAM_BALLOONS',GFOUND,ILUOUT)
+ CALL POSNAM( TPEXSEGFILE, 'NAM_BALLOONS', GFOUND )
IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_BALLOONS)
END IF
END IF
@@ -907,8 +914,8 @@ CALL TEST_NAM_VAR(ILUOUT,'CLBCX(2)',CLBCX(2),'CYCL','WALL','OPEN')
CALL TEST_NAM_VAR(ILUOUT,'CLBCY(1)',CLBCY(1),'CYCL','WALL','OPEN')
CALL TEST_NAM_VAR(ILUOUT,'CLBCY(2)',CLBCY(2),'CYCL','WALL','OPEN')
!
-CALL TURBN_INIT(CPROGRAM, 0, .FALSE., ILUOUT, .FALSE., .FALSE., .TRUE., 0)
-CALL NEBN_INIT(CPROGRAM, 0, .FALSE., ILUOUT, .FALSE., .FALSE., .TRUE., 0)
+CALL TURBN_INIT(CPROGRAM, TPEXSEGFILE, .FALSE., ILUOUT, .FALSE., .FALSE., .TRUE., 0)
+CALL NEBN_INIT(CPROGRAM, TPEXSEGFILE, .FALSE., ILUOUT, .FALSE., .FALSE., .TRUE., 0)
!
CALL TEST_NAM_VAR(ILUOUT,'CCH_TDISCRETIZATION',CCH_TDISCRETIZATION, &
'SPLIT ','CENTER ','LAGGED ')
@@ -927,11 +934,11 @@ CALL TEST_NAM_VAR(ILUOUT,'CTURBLEN_CLOUD',CTURBLEN_CLOUD,'NONE','DEAR','DELT','B
!
! The test on the mass flux scheme for shallow convection
!
-CALL PARAM_MFSHALLN_INIT(CPROGRAM, 0, .FALSE., ILUOUT, .FALSE., .FALSE., .TRUE., 0)
+CALL PARAM_MFSHALLN_INIT(CPROGRAM, TPEXSEGFILE, .FALSE., ILUOUT, .FALSE., .FALSE., .TRUE., 0)
!
! The test on the CSOLVER name is made elsewhere
!
-CALL PARAM_ICEN_INIT(CPROGRAM, 0, .FALSE., ILUOUT, .FALSE., .FALSE., .TRUE., 0)
+CALL PARAM_ICEN_INIT(CPROGRAM, TPEXSEGFILE, .FALSE., ILUOUT, .FALSE., .FALSE., .TRUE., 0)
IF( CCLOUD == 'C3R5' ) THEN
CALL TEST_NAM_VAR(ILUOUT,'CPRISTINE_ICE_C1R3',CPRISTINE_ICE_C1R3, &
'PLAT','COLU','BURO')
@@ -940,7 +947,7 @@ IF( CCLOUD == 'C3R5' ) THEN
END IF
!
IF( CCLOUD == 'LIMA' ) THEN
- CALL PARAM_LIMA_INIT(CPROGRAM, 0, .FALSE., ILUOUT, .FALSE., .FALSE., .TRUE., 0)
+ CALL PARAM_LIMA_INIT(CPROGRAM, TPEXSEGFILE, .FALSE., ILUOUT, .FALSE., .FALSE., .TRUE., 0)
END IF
! Blaze
CALL UPDATE_NAM_FIREn
@@ -1781,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
@@ -2994,6 +3054,7 @@ CALL UPDATE_NAM_LUNITN
CALL UPDATE_NAM_CONFN
CALL UPDATE_NAM_DRAGTREEN
CALL UPDATE_NAM_DRAGBLDGN
+CALL UPDATE_NAM_COUPLING_LEVELSN
CALL UPDATE_NAM_DYNN
CALL UPDATE_NAM_ADVN
CALL UPDATE_NAM_PARAMN
diff --git a/src/mesonh/ext/read_field.f90 b/src/mesonh/ext/read_field.f90
index d86c67557c62c692ede13db25b29122ca62055f1..8774371974618e33c0592ce46af6d4334355973b 100644
--- a/src/mesonh/ext/read_field.f90
+++ b/src/mesonh/ext/read_field.f90
@@ -283,7 +283,6 @@ USE MODD_BLOWSNOW_n, ONLY: XSNWCANO
USE MODD_CONF, ONLY: CCONF, CPROGRAM, L1D, LFORCING, NVERB
USE MODD_CONF_n, ONLY: IDX_RVT, IDX_RCT, IDX_RRT, IDX_RIT, IDX_RST, IDX_RGT, IDX_RHT
USE MODD_CST, ONLY: XALPW, XBETAW, XCPD, XGAMW, XMD, XMV, XP00, XRD
-USE MODD_TURB_n, ONLY: XTKEMIN
USE MODD_DYN_n, ONLY: LOCEAN
use modd_field, only: tfieldmetadata, tfieldlist, NMNHDIM_NI, NMNHDIM_NJ, NMNHDIM_NOTLISTED, &
TYPEDATE, TYPEREAL, TYPELOG, TYPEINT
@@ -305,6 +304,7 @@ USE MODD_PARAM_n, ONLY: CSCONV
USE MODD_RECYCL_PARAM_n, ONLY: LRECYCLE, LRECYCLN, LRECYCLS, LRECYCLW, NR_COUNT
USE MODD_REF, ONLY: LCOUPLES
USE MODD_TIME, ONLY: DATE_TIME
+USE MODD_TURB_n, ONLY: XTKEMIN
!
use mode_field, only: Find_field_id_from_mnhname
USE MODE_IO_FIELD_READ, only: IO_Field_read
diff --git a/src/mesonh/ext/read_precip_field.f90 b/src/mesonh/ext/read_precip_field.f90
index 1267beea757dd57efdedb88d79264cefd58a738c..3fb16bdf4fe01c6156fcbc158006b1adbe531b65 100644
--- a/src/mesonh/ext/read_precip_field.f90
+++ b/src/mesonh/ext/read_precip_field.f90
@@ -100,7 +100,7 @@ END MODULE MODI_READ_PRECIP_FIELD
use modd_field, only: tfieldmetadata, tfieldlist
USE MODD_IO, ONLY: TFILEDATA
-USE MODD_PARAM_ICE_n, ONLY: LDEPOSC
+USE MODD_PARAM_ICE_n, ONLY: LDEPOSC
USE MODD_PARAM_C2R2, ONLY: LDEPOC
USE MODD_PARAM_LIMA, ONLY: MDEPOC=>LDEPOC
!
diff --git a/src/mesonh/ext/resolved_cloud.f90 b/src/mesonh/ext/resolved_cloud.f90
index aec42c0535e375182860e9e1ff46049510d13234..78b056cf359b9870f8233cc348d1ea6cae86e4d8 100644
--- a/src/mesonh/ext/resolved_cloud.f90
+++ b/src/mesonh/ext/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,38 +285,50 @@ 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
! ------------
-USE MODD_BUDGET, ONLY: TBUDGETS, TBUCONF
-USE MODD_CH_AEROSOL, ONLY: LORILAM
-USE MODD_DUST, ONLY: LDUST
-USE MODD_CST, ONLY: CST
-USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
-USE MODD_DUST , ONLY: LDUST
-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
-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
-USE MODD_PARAM_LIMA, ONLY: LADJ, LPTSPLIT, LSPRO, NMOD_CCN, NMOD_IFN, NMOD_IMM, NMOM_I
+USE MODD_BUDGET, ONLY: TBUDGETS, TBUCONF
+USE MODD_CH_AEROSOL, ONLY: LORILAM
+USE MODD_DUST, ONLY: LDUST
+USE MODD_CST, ONLY: CST
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+USE MODD_DUST, ONLY: LDUST
+USE MODD_ELEC_DESCR, ONLY: ELEC_DESCR, LSEDIM_BEARD, LIAGGS_LATHAM
+USE MODD_ELEC_n, ONLY: XEFIELDU, XEFIELDV, XEFIELDW
+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_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
+USE MODD_PARAM_LIMA, ONLY: LADJ, LPTSPLIT, LSPRO, NMOD_CCN, NMOD_IFN, NMOD_IMM, NMOM_I
USE MODD_RAIN_ICE_DESCR_n, ONLY: XRTMIN, RAIN_ICE_DESCRN
USE MODD_RAIN_ICE_PARAM_n, ONLY: RAIN_ICE_PARAMN
-USE MODD_SALT, ONLY: LSALT
-USE MODD_TURB_n, ONLY: TURBN
+USE MODD_SALT, ONLY: LSALT
+USE MODD_TURB_n, ONLY: TURBN
!
USE MODE_ll
USE MODE_FILL_DIMPHYEX, ONLY: FILL_DIMPHYEX
use mode_sources_neg_correct, only: Sources_neg_correct
!
+USE MODI_AER2LIMA
USE MODI_C2R2_ADJUST
+USE MODI_ELEC_ADJUST
USE MODI_FAST_TERMS
USE MODI_GET_HALO
USE MODI_ICE_ADJUST
+USE MODI_ICE_ADJUST_ELEC
+USE MODI_ION_SOURCE_ELEC
USE MODI_KHKO_NOTADJUST
USE MODI_LIMA
USE MODI_LIMA_ADJUST
@@ -326,10 +339,10 @@ USE MODI_LIMA_NOTADJUST
USE MODI_LIMA_WARM
USE MODI_RAIN_C2R2_KHKO
USE MODI_RAIN_ICE
+USE MODI_RAIN_ICE_ELEC
USE MODI_RAIN_ICE_OLD
USE MODI_SHUMAN
USE MODI_SLOW_TERMS
-USE MODI_AER2LIMA
!
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 )
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 4. CLOUD ELECTRICITY
+! -----------------
+!
+!++cb++ 01/06/23
+!IF (HELEC == 'ELE4') &
+IF (HELEC(1:3) == 'ELE') THEN
+!--cb--
!
-!* 3.4 Limitations of Na and Nc to the CCN max number concentration
+!* 4.1 Ion source from drift motion and cosmic rays
!
-! 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
+ 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
+!
+ 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
+ !
+ ! Perform 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
+ !
+ ! Perform 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/mesonh/ext/rrcolss.f90 b/src/mesonh/ext/rrcolss.f90
deleted file mode 100644
index 0dac2fa04b4ba96dba68bb07e5ded522557851ea..0000000000000000000000000000000000000000
--- a/src/mesonh/ext/rrcolss.f90
+++ /dev/null
@@ -1,315 +0,0 @@
-!MNH_LIC Copyright 1995-2019 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_RRCOLSS
-! ###################
-!
-INTERFACE
-!
- SUBROUTINE RRCOLSS( KND, PALPHAS, PNUS, PALPHAR, PNUR, &
- PESR, PEXMASSR, PFALLS, PEXFALLS, PFALLEXPS, PFALLR, PEXFALLR, &
- PLBDASMAX, PLBDARMAX, PLBDASMIN, PLBDARMIN, &
- PDINFTY, PRRCOLSS, PAG, PBS, PAS )
-!
-INTEGER, INTENT(IN) :: KND ! Number of discrete size intervals in DS and DR
-!
-REAL, INTENT(IN) :: PALPHAS ! First shape parameter of the aggregates
- ! size distribution (generalized gamma law)
-REAL, INTENT(IN) :: PNUS ! Second shape parameter of the aggregates
- ! size distribution (generalized gamma law)
-REAL, INTENT(IN) :: PALPHAR ! First shape parameter of the rain
- ! size distribution (generalized gamma law)
-REAL, INTENT(IN) :: PNUR ! Second shape parameter of the rain
- ! size distribution (generalized gamma law)
-REAL, INTENT(IN) :: PESR ! Efficiency of aggregates collecting rain
-REAL, INTENT(IN) :: PEXMASSR ! Mass exponent of rain
-REAL, INTENT(IN) :: PFALLS ! Fall speed constant of aggregates
-REAL, INTENT(IN) :: PEXFALLS ! Fall speed exponent of aggregates
-REAL, INTENT(IN) :: PFALLEXPS ! Fall speed exponential of aggregates (Thompson 2008)
-REAL, INTENT(IN) :: PFALLR ! Fall speed constant of rain
-REAL, INTENT(IN) :: PEXFALLR ! Fall speed exponent of rain
-REAL, INTENT(IN) :: PLBDASMAX ! Maximun slope of size distribution of aggregates
-REAL, INTENT(IN) :: PLBDARMAX ! Maximun slope of size distribution of rain
-REAL, INTENT(IN) :: PLBDASMIN ! Minimun slope of size distribution of aggregates
-REAL, INTENT(IN) :: PLBDARMIN ! Minimun slope of size distribution of rain
-REAL, INTENT(IN) :: PDINFTY ! Factor to define the largest diameter up to
- ! which the diameter integration is performed
-REAL, INTENT(IN) :: PAG, PBS, PAS
-!
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PRRCOLSS! Scaled fall speed difference in
- ! the mass collection kernel as a
- ! function of LAMBDAX and LAMBDAZ
-!
- END SUBROUTINE RRCOLSS
-!
-END INTERFACE
-!
- END MODULE MODI_RRCOLSS
-! ########################################################################
- SUBROUTINE RRCOLSS( KND, PALPHAS, PNUS, PALPHAR, PNUR, &
- PESR, PEXMASSR, PFALLS, PEXFALLS, PFALLEXPS, PFALLR, PEXFALLR, &
- PLBDASMAX, PLBDARMAX, PLBDASMIN, PLBDARMIN, &
- PDINFTY, PRRCOLSS, PAG, PBS, PAS )
-! ########################################################################
-!
-!
-!
-!!**** * - Build up a look-up table containing the scaled fall speed
-!! difference between size distributed particles of aggregates and Z
-!!
-!!
-!! PURPOSE
-!! -------
-!! The purpose of this routine is to integrate numerically the scaled fall
-!! speed difference between aggregates and rain for use in collection
-!! kernels. A first integral of the form
-!!
-!! infty Dz_max
-!! / /
-!! |{| }
-!! |{| E_xz (Dx+Dz)^2 |cxDx^dx-czDz^dz| Dz^bz n(Dz) dDz} n(Dx) dDx
-!! |{| }
-!! / /
-!! 0 Dz_min
-!!
-!! is evaluated and normalised by a second integral of the form
-!!
-!! infty
-!! / /
-!! |{| }
-!! |{| (Dx+Dz)^2 Dz^bz n(Dz) dDz} n(Dx) dDx
-!! |{| }
-!! / /
-!! 0
-!!
-!! The result is stored in a two-dimensional array.
-!!
-!!** METHOD
-!! ------
-!! The free parameters of the size distribution function of aggregates and Z
-!! (slope parameter LAMBDA) are discretized with a geometrical rate in a
-!! specific range
-!! LAMBDA = exp( (Log(LAMBDA_max) - Log(LAMBDA_min))/N_interval )
-!! The two above integrals are performed using the trapezoidal scheme.
-!!
-!! EXTERNAL
-!! --------
-!! MODI_GENERAL_GAMMA: Generalized gamma distribution law
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!! MODD_CST : XPI,XRHOLW
-!! MODD_RAIN_ICE_DESCR: XAS,XAS,XBS
-!!
-!! REFERENCE
-!! ---------
-!! B.S. Ferrier , 1994 : A Double-Moment Multiple-Phase Four-Class
-!! Bulk Ice Scheme,JAS,51,249-280.
-!!
-!! AUTHOR
-!! ------
-!! J.-P. Pinty * Laboratoire d'Aerologie *
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 8/11/95
-!!
-! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
-! J. Wurtz 03/2022: new snow characteristics
-!
-!-------------------------------------------------------------------------------
-!
-!
-!* 0. DECLARATIONS
-! ------------
-!
-!
-USE MODI_GENERAL_GAMMA
-!
-USE MODD_CST
-USE MODD_RAIN_ICE_DESCR_n
-!
-IMPLICIT NONE
-!
-!
-!* 0.1 Declarations of dummy arguments
-! -------------------------------
-!
-!
-INTEGER, INTENT(IN) :: KND ! Number of discrete size intervals in DS and DR
-!
-REAL, INTENT(IN) :: PALPHAS ! First shape parameter of the aggregates
- ! size distribution (generalized gamma law)
-REAL, INTENT(IN) :: PNUS ! Second shape parameter of the aggregates
- ! size distribution (generalized gamma law)
-REAL, INTENT(IN) :: PALPHAR ! First shape parameter of the rain
- ! size distribution (generalized gamma law)
-REAL, INTENT(IN) :: PNUR ! Second shape parameter of the rain
- ! size distribution (generalized gamma law)
-REAL, INTENT(IN) :: PESR ! Efficiency of aggregates collecting rain
-REAL, INTENT(IN) :: PEXMASSR ! Mass exponent of rain
-REAL, INTENT(IN) :: PFALLS ! Fall speed constant of aggregates
-REAL, INTENT(IN) :: PEXFALLS ! Fall speed exponent of aggregates
-REAL, INTENT(IN) :: PFALLEXPS ! Fall speed exponential of aggregates (Thompson 2008)
-REAL, INTENT(IN) :: PFALLR ! Fall speed constant of rain
-REAL, INTENT(IN) :: PEXFALLR ! Fall speed exponent of rain
-REAL, INTENT(IN) :: PLBDASMAX ! Maximun slope of size distribution of aggregates
-REAL, INTENT(IN) :: PLBDARMAX ! Maximun slope of size distribution of rain
-REAL, INTENT(IN) :: PLBDASMIN ! Minimun slope of size distribution of aggregates
-REAL, INTENT(IN) :: PLBDARMIN ! Minimun slope of size distribution of rain
-REAL, INTENT(IN) :: PDINFTY ! Factor to define the largest diameter up to
- ! which the diameter integration is performed
-REAL, INTENT(IN) :: PAG, PBS, PAS
-!
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PRRCOLSS! Scaled fall speed difference in
- ! the mass collection kernel as a
- ! function of LAMBDAX and LAMBDAZ
-!
-!
-!* 0.2 Declarations of local variables
-! -------------------------------
-!
-!
-INTEGER :: JLBDAS ! Slope index of the size distribution of aggregates
-INTEGER :: JLBDAR ! Slope index of the size distribution of rain
-INTEGER :: JDS ! Diameter index of a particle of aggregates
-INTEGER :: JDR ! Diameter index of a particle of rain
-!
-INTEGER :: INR ! Number of diameter step for the partial integration
-!
-!
-REAL :: ZLBDAS ! Current slope parameter LAMBDA of aggregates
-REAL :: ZLBDAR ! Current slope parameter LAMBDA of rain
-REAL :: ZDLBDAS ! Growth rate of the slope parameter LAMBDA of aggregates
-REAL :: ZDLBDAR ! Growth rate of the slope parameter LAMBDA of rain
-REAL :: ZDDS ! Integration step of the diameter of aggregates
-REAL :: ZDDSCALR! Integration step of the diameter of rain (scaling integral)
-REAL :: ZDDCOLLR! Integration step of the diameter of rain (fallspe integral)
-REAL :: ZDS ! Current diameter of the particle aggregates
-REAL :: ZDR ! Current diameter of the rain
-REAL :: ZDRMAX ! Maximal diameter of the raindrops where the integration ends
-REAL :: ZCOLLR ! Single integral of the mass weighted fall speed difference
- ! over the spectrum of rain
-REAL :: ZCOLLDRMAX ! Maximum ending point for the partial integral
-REAL :: ZCOLLSR ! Double integral of the mass weighted fall speed difference
- ! over the spectra of aggregates and rain
-REAL :: ZSCALR ! Single integral of the scaling factor over
- ! the spectrum of rain
-REAL :: ZSCALSR ! Double integral of the scaling factor over
- ! the spectra of aggregates and rain
-REAL :: ZFUNC ! Ancillary function
-REAL :: ZCST1
-!
-!
-!-------------------------------------------------------------------------------
-!
-!
-!* 1 COMPUTE THE SCALED VELOCITY DIFFERENCE IN THE MASS
-!* COLLECTION KERNEL,
-! -------------------------------------------------
-!
-!
-!
-!* 1.0 Initialization
-!
-PRRCOLSS(:,:) = 0.0
-ZCST1 = (3.0/XPI)/XRHOLW
-!
-!* 1.1 Compute the growth rate of the slope factors LAMBDA
-!
-ZDLBDAS = EXP( LOG(PLBDASMAX/PLBDASMIN)/REAL(SIZE(PRRCOLSS(:,:),1)-1) )
-ZDLBDAR = EXP( LOG(PLBDARMAX/PLBDARMIN)/REAL(SIZE(PRRCOLSS(:,:),2)-1) )
-!
-!* 1.2 Scan the slope factors LAMBDAX and LAMBDAZ
-!
-DO JLBDAS = 1,SIZE(PRRCOLSS(:,:),1)
- ZLBDAS = PLBDASMIN * ZDLBDAS ** (JLBDAS-1)
-!
-!* 1.3 Compute the diameter steps
-!
- ZDDS = PDINFTY / (REAL(KND) * ZLBDAS)
- DO JLBDAR = 1,SIZE(PRRCOLSS(:,:),2)
- ZLBDAR = PLBDARMIN * ZDLBDAR ** (JLBDAR-1)
-!
-!* 1.4 Initialize the collection integrals
-!
- ZSCALSR = 0.0
- ZCOLLSR = 0.0
-!
-!* 1.5 Compute the diameter steps
-!
- ZDDSCALR = PDINFTY / (REAL(KND) * ZLBDAR)
-!
-!* 1.6 Scan over the diameters DS and DR
-!
- DO JDS = 1,KND-1
- ZDS = ZDDS * REAL(JDS)
- ZSCALR = 0.0
- ZCOLLR = 0.0
- DO JDR = 1,KND-1
- ZDR = ZDDSCALR * REAL(JDR)
-!
-!* 1.7 Compute the normalization factor by integration over the
-! dimensional spectrum of rain
-!
- ZSCALR = ZSCALR + (ZDS+ZDR)**2 * ZDR**PEXMASSR &
- * GENERAL_GAMMA(PALPHAR,PNUR,ZLBDAR,ZDR)
- END DO
-!
-!* 1.8 Compute the scaled fall speed difference by partial
-! integration over the dimensional spectrum of rain
-!
- ZFUNC = PAG - PAS*ZDS**(PBS-3.0) ! approximate limit is Ds=240 microns
- IF( ZFUNC>0.0 ) THEN
- ZDRMAX = ZDS*( ZCST1*ZFUNC )**0.3333333
- ELSE
- ZDRMAX = PDINFTY / ZLBDAR
- END IF
- IF( ZDS>1.0E-4 ) THEN ! allow computation if Ds>100 microns
- ! corresponding to a maximal density of the aggregates of XRHOLW
- IF( ZDRMAX >= 0.5*ZDDSCALR ) THEN
- INR = CEILING( ZDRMAX/ZDDSCALR )
- ZDDCOLLR = ZDRMAX / REAL(INR)
- IF (INR>=KND ) THEN
- INR = KND
- ZDDCOLLR = ZDDSCALR
- END IF
- DO JDR = 1,INR-1
- ZDR = ZDDCOLLR * REAL(JDR)
- ZCOLLR = ZCOLLR + (ZDS+ZDR)**2 * ZDR**PEXMASSR &
- * PESR * ABS(PFALLS*ZDS**PEXFALLS * EXP(-(PFALLEXPS*ZDS)**PALPHAS)-PFALLR*ZDR**PEXFALLR) &
- * GENERAL_GAMMA(PALPHAR,PNUR,ZLBDAR,ZDR)
- END DO
- ZCOLLDRMAX = (ZDS+ZDRMAX)**2 * ZDRMAX**PEXMASSR &
- * PESR * ABS(PFALLS*ZDS**PEXFALLS* EXP(-(PFALLEXPS*ZDS)**PALPHAS)-PFALLR*ZDRMAX**PEXFALLR) &
- * GENERAL_GAMMA(PALPHAR,PNUR,ZLBDAR,ZDRMAX)
- ZCOLLR = (ZCOLLR + 0.5*ZCOLLDRMAX)*(ZDDCOLLR/ZDDSCALR)
-!
-!* 1.9 Compute the normalization factor by integration over the
-! dimensional spectrum of aggregates
-!
- ZFUNC = GENERAL_GAMMA(PALPHAS,PNUS,ZLBDAS,ZDS)
- ZSCALSR = ZSCALSR + ZSCALR * ZFUNC
-!
-!* 1.10 Compute the scaled fall speed difference by integration over
-! the dimensional spectrum of aggregates
-!
- ZCOLLSR = ZCOLLSR + ZCOLLR * ZFUNC
- END IF
-!
-! Otherwise ZDRMAX = 0.0 so the density of the graupel cannot be reached
-! and so PRRCOLSS(JLBDAS,JLBDAR) = 0.0 !
-!
- END IF
- END DO
-!
-!* 1.11 Scale the fall speed difference
-!
- IF( ZSCALSR>0.0 ) PRRCOLSS(JLBDAS,JLBDAR) = ZCOLLSR / ZSCALSR
- END DO
-END DO
-!
-END SUBROUTINE RRCOLSS
diff --git a/src/mesonh/ext/rscolrg.f90 b/src/mesonh/ext/rscolrg.f90
deleted file mode 100644
index 26969afcd4b3282beafb10e659a0b0d547cfc125..0000000000000000000000000000000000000000
--- a/src/mesonh/ext/rscolrg.f90
+++ /dev/null
@@ -1,315 +0,0 @@
-!MNH_LIC Copyright 1995-2019 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_RSCOLRG
-! ###################
-!
-INTERFACE
-!
- SUBROUTINE RSCOLRG( KND, PALPHAS, PZNUS, PALPHAR, PNUR, &
- PESR, PEXMASSS, PFALLS, PEXFALLS, PFALLEXPS, PFALLR, PEXFALLR, &
- PLBDASMAX, PLBDARMAX, PLBDASMIN, PLBDARMIN, &
- PDINFTY, PRSCOLRG,PAG, PBS, PAS )
-!
-INTEGER, INTENT(IN) :: KND ! Number of discrete size intervals in DS and DR
-!
-REAL, INTENT(IN) :: PALPHAS ! First shape parameter of the aggregates
- ! size distribution (generalized gamma law)
-REAL, INTENT(IN) :: PZNUS ! Second shape parameter of the aggregates
- ! size distribution (generalized gamma law)
-REAL, INTENT(IN) :: PALPHAR ! First shape parameter of the rain
- ! size distribution (generalized gamma law)
-REAL, INTENT(IN) :: PNUR ! Second shape parameter of the rain
- ! size distribution (generalized gamma law)
-REAL, INTENT(IN) :: PESR ! Efficiency of the aggregates collecting rain
-REAL, INTENT(IN) :: PEXMASSS ! Mass exponent of the aggregates
-REAL, INTENT(IN) :: PFALLS ! Fall speed constant of the aggregates
-REAL, INTENT(IN) :: PEXFALLS ! Fall speed exponent of the aggregates
-REAL, INTENT(IN) :: PFALLEXPS ! Fall speed exponential constant of the aggregates
-REAL, INTENT(IN) :: PFALLR ! Fall speed constant of rain
-REAL, INTENT(IN) :: PEXFALLR ! Fall speed exponent of rain
-REAL, INTENT(IN) :: PLBDASMAX ! Maximun slope of size distribution of the aggregates
-REAL, INTENT(IN) :: PLBDARMAX ! Maximun slope of size distribution of rain
-REAL, INTENT(IN) :: PLBDASMIN ! Minimun slope of size distribution of the aggregates
-REAL, INTENT(IN) :: PLBDARMIN ! Minimun slope of size distribution of rain
-REAL, INTENT(IN) :: PDINFTY ! Factor to define the largest diameter up to
- ! which the diameter integration is performed
-REAL, INTENT(IN) :: PAG, PBS, PAS
-!
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PRSCOLRG! Scaled fall speed difference in
- ! the mass collection kernel as a
- ! function of LAMBDAX and LAMBDAZ
-!
- END SUBROUTINE RSCOLRG
-!
-END INTERFACE
-!
- END MODULE MODI_RSCOLRG
-! ########################################################################
- SUBROUTINE RSCOLRG( KND, PALPHAS, PZNUS, PALPHAR, PNUR, &
- PESR, PEXMASSS, PFALLS, PEXFALLS, PFALLEXPS, PFALLR, PEXFALLR, &
- PLBDASMAX, PLBDARMAX, PLBDASMIN, PLBDARMIN, &
- PDINFTY, PRSCOLRG,PAG, PBS, PAS )
-! ########################################################################
-!
-!
-!
-!!**** * - Build up a look-up table containing the scaled fall speed
-!! difference between size distributed particles of the aggregates and Z
-!!
-!!
-!! PURPOSE
-!! -------
-!! The purpose of this routine is to integrate numerically the scaled fall
-!! speed difference between aggregates and rain for use in collection
-!! kernels. A first integral of the form
-!!
-!! infty Dz_max
-!! / /
-!! |{| }
-!! |{| E_xz (Dx+Dz)^2 |cxDx^dx-czDz^dz| Dz^bz n(Dz) dDz} n(Dx) dDx
-!! |{| }
-!! / /
-!! 0 Dz_min
-!!
-!! is evaluated and normalised by a second integral of the form
-!!
-!! infty
-!! / /
-!! |{| }
-!! |{| (Dx+Dz)^2 Dz^bz n(Dz) dDz} n(Dx) dDx
-!! |{| }
-!! / /
-!! 0
-!!
-!! The result is stored in a two-dimensional array.
-!!
-!!** METHOD
-!! ------
-!! The free parameters of the size distribution function of the aggregates
-!! and Z (slope parameter LAMBDA) are discretized with a geometrical rate
-!! in a specific range
-!! LAMBDA = exp( (Log(LAMBDA_max) - Log(LAMBDA_min))/N_interval )
-!! The two above integrals are performed using the trapezoidal scheme.
-!!
-!! EXTERNAL
-!! --------
-!! MODI_GENERAL_GAMMA: Generalized gamma distribution law
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!! MODD_CST : XPI,XRHOLW
-!! MODD_RAIN_ICE_DESCR: XAS,XAS,XBS
-!!
-!! REFERENCE
-!! ---------
-!! B.S. Ferrier , 1994 : A Double-Moment Multiple-Phase Four-Class
-!! Bulk Ice Scheme,JAS,51,249-280.
-!!
-!! AUTHOR
-!! ------
-!! J.-P. Pinty * Laboratoire d'Aerologie *
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 8/11/95
-!!
-! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
-! J. Wurtz 03/2022: new snow characteristics
-!
-!-------------------------------------------------------------------------------
-!
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODI_GENERAL_GAMMA
-!
-USE MODD_CST
-USE MODD_RAIN_ICE_DESCR_n
-!
-IMPLICIT NONE
-!
-!* 0.1 Declarations of dummy arguments
-! -------------------------------
-!
-!
-INTEGER, INTENT(IN) :: KND ! Number of discrete size intervals in DS and DR
-!
-REAL, INTENT(IN) :: PALPHAS ! First shape parameter of the aggregates
- ! size distribution (generalized gamma law)
-REAL, INTENT(IN) :: PZNUS ! Second shape parameter of the aggregates
- ! size distribution (generalized gamma law)
-REAL, INTENT(IN) :: PALPHAR ! First shape parameter of the rain
- ! size distribution (generalized gamma law)
-REAL, INTENT(IN) :: PNUR ! Second shape parameter of the rain
- ! size distribution (generalized gamma law)
-REAL, INTENT(IN) :: PESR ! Efficiency of the aggregates collecting rain
-REAL, INTENT(IN) :: PEXMASSS ! Mass exponent of the aggregates
-REAL, INTENT(IN) :: PFALLS ! Fall speed constant of the aggregates
-REAL, INTENT(IN) :: PEXFALLS ! Fall speed exponent of the aggregates
-REAL, INTENT(IN) :: PFALLEXPS ! Fall speed exponential constant of the aggregates
-REAL, INTENT(IN) :: PFALLR ! Fall speed constant of rain
-REAL, INTENT(IN) :: PEXFALLR ! Fall speed exponent of rain
-REAL, INTENT(IN) :: PLBDASMAX ! Maximun slope of size distribution of the aggregates
-REAL, INTENT(IN) :: PLBDARMAX ! Maximun slope of size distribution of rain
-REAL, INTENT(IN) :: PLBDASMIN ! Minimun slope of size distribution of the aggregates
-REAL, INTENT(IN) :: PLBDARMIN ! Minimun slope of size distribution of rain
-REAL, INTENT(IN) :: PDINFTY ! Factor to define the largest diameter up to
- ! which the diameter integration is performed
-REAL, INTENT(IN) :: PAG, PBS, PAS
-!
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PRSCOLRG! Scaled fall speed difference in
- ! the mass collection kernel as a
- ! function of LAMBDAX and LAMBDAZ
-!
-!
-!* 0.2 Declarations of local variables
-! -------------------------------
-!
-!
-INTEGER :: JLBDAS ! Slope index of the size distribution of the aggregates
-INTEGER :: JLBDAR ! Slope index of the size distribution of rain
-INTEGER :: JDS ! Diameter index of a particle of the aggregates
-INTEGER :: JDR ! Diameter index of a particle of rain
-!
-INTEGER :: INR ! Number of diameter step for the partial integration
-!
-REAL :: ZLBDAS ! Current slope parameter LAMBDA of the aggregates
-REAL :: ZLBDAR ! Current slope parameter LAMBDA of rain
-REAL :: ZDLBDAS ! Growth rate of the slope parameter LAMBDA of the aggregates
-REAL :: ZDLBDAR ! Growth rate of the slope parameter LAMBDA of rain
-REAL :: ZDDS ! Integration step of the diameter of the aggregates
-REAL :: ZDDSCALR! Integration step of the diameter of rain (scaling integral)
-REAL :: ZDDCOLLR! Integration step of the diameter of rain (fallspe integral)
-REAL :: ZDS ! Current diameter of the particle aggregates
-REAL :: ZDR ! Current diameter of the raindrops
-REAL :: ZDRMIN ! Minimal diameter of the raindrops where the integration starts
-REAL :: ZDRMAX ! Maximal diameter of the raindrops where the integration ends
-REAL :: ZCOLLR ! Single integral of the mass weighted fall speed difference
- ! over the spectrum of rain
-REAL :: ZCOLLDRMIN ! Minimum ending point for the partial integral
-REAL :: ZCOLLSR ! Double integral of the mass weighted fall speed difference
- ! over the spectra of the aggregates and rain
-REAL :: ZSCALR ! Single integral of the scaling factor over
- ! the spectrum of rain
-REAL :: ZSCALSR ! Double integral of the scaling factor over
- ! the spectra of the aggregates and rain
-REAL :: ZFUNC ! Ancillary function
-REAL :: ZCST1
-!
-!
-!-------------------------------------------------------------------------------
-!
-!
-!* 1 COMPUTE THE SCALED VELOCITY DIFFERENCE IN THE MASS
-!* COLLECTION KERNEL,
-! -------------------------------------------------
-!
-!
-!* 1.0 Initialization
-!
-PRSCOLRG(:,:) = 0.0
-ZCST1 = (3.0/XPI)/XRHOLW
-!
-!* 1.1 Compute the growth rate of the slope factors LAMBDA
-!
-ZDLBDAR = EXP( LOG(PLBDARMAX/PLBDARMIN)/REAL(SIZE(PRSCOLRG(:,:),1)-1) )
-ZDLBDAS = EXP( LOG(PLBDASMAX/PLBDASMIN)/REAL(SIZE(PRSCOLRG(:,:),2)-1) )
-!
-!* 1.2 Scan the slope factors LAMBDAX and LAMBDAZ
-!
-DO JLBDAR = 1,SIZE(PRSCOLRG(:,:),1)
- ZLBDAR = PLBDARMIN * ZDLBDAR ** (JLBDAR-1)
- ZDRMAX = PDINFTY / ZLBDAR
-!
-!* 1.3 Compute the diameter steps
-!
- ZDDSCALR = PDINFTY / (REAL(KND) * ZLBDAR)
- DO JLBDAS = 1,SIZE(PRSCOLRG(:,:),2)
- ZLBDAS = PLBDASMIN * ZDLBDAS ** (JLBDAS-1)
-!
-!* 1.4 Initialize the collection integrals
-!
- ZSCALSR = 0.0
- ZCOLLSR = 0.0
-!
-!* 1.5 Compute the diameter steps
-!
- ZDDS = PDINFTY / (REAL(KND) * ZLBDAS)
-!
-!* 1.6 Scan over the diameters DS and DR
-!
- DO JDS = 1,KND-1
- ZDS = ZDDS * REAL(JDS)
- ZSCALR = 0.0
- ZCOLLR = 0.0
- DO JDR = 1,KND-1
- ZDR = ZDDSCALR * REAL(JDR)
-!
-!* 1.7 Compute the normalization factor by integration over the
-! dimensional spectrum of rain
-!
- ZSCALR = ZSCALR + (ZDS+ZDR)**2 * GENERAL_GAMMA(PALPHAR,PNUR,ZLBDAR,ZDR)
- END DO
-!
-!* 1.8 Compute the scaled fall speed difference by partial
-! integration over the dimensional spectrum of rain
-!
- ZFUNC = PAG - PAS*ZDS**(PBS-3.0) ! approximate limit is Ds=240 microns
- IF( ZFUNC>0.0 ) THEN
- ZDRMIN = ZDS*( ZCST1*ZFUNC )**0.3333333
- ELSE
- ZDRMIN = 0.0
- END IF
- IF( ZDS>1.0E-4 ) THEN ! allow computation if Ds>100 microns
- ! corresponding to a maximal density of the aggregates of XRHOLW
- IF( (ZDRMAX-ZDRMIN) >= 0.5*ZDDSCALR ) THEN
- INR = CEILING( (ZDRMAX-ZDRMIN)/ZDDSCALR )
- ZDDCOLLR = (ZDRMAX-ZDRMIN) / REAL(INR)
- DO JDR = 1,INR-1
- ZDR = ZDDCOLLR * REAL(JDR) + ZDRMIN
- ZCOLLR = ZCOLLR + (ZDS+ZDR)**2 &
- * GENERAL_GAMMA(PALPHAR,PNUR,ZLBDAR,ZDR) &
- * PESR * ABS(PFALLS*ZDS**PEXFALLS*EXP(-(ZDS*PFALLEXPS)**PALPHAS)-PFALLR*ZDR**PEXFALLR)
- END DO
- IF( ZDRMIN>0.0 ) THEN
- ZCOLLDRMIN = (ZDS+ZDRMIN)**2 &
- * GENERAL_GAMMA(PALPHAR,PNUR,ZLBDAR,ZDRMIN) &
- * PESR * ABS(PFALLS*ZDS**PEXFALLS*EXP(-(ZDS*PFALLEXPS)**PALPHAS)-PFALLR*ZDRMIN**PEXFALLR)
- ELSE
- ZCOLLDRMIN = 0.0
- END IF
- ZCOLLR = (ZCOLLR + 0.5*ZCOLLDRMIN)*(ZDDCOLLR/ZDDSCALR)
-!
-!* 1.9 Compute the normalization factor by integration over the
-! dimensional spectrum of the aggregates
-!
- ZFUNC = (ZDS**PEXMASSS) * GENERAL_GAMMA(PALPHAS,PZNUS,ZLBDAS,ZDS)
- ZSCALSR = ZSCALSR + ZSCALR * ZFUNC
-!
-!* 1.10 Compute the scaled fall speed difference by integration over
-! the dimensional spectrum of the aggregates
-!
- ZCOLLSR = ZCOLLSR + ZCOLLR * ZFUNC
-!
-! Otherwise ZDRMIN>ZDRMAX so PRRCOLSS(JLBDAS,JLBDAR) = 0.0 !
-!
- END IF
-!
-! Otherwise ZDRMAX = 0.0 so the density of the graupel cannot be reached
-! and so PRRCOLSS(JLBDAS,JLBDAR) = 0.0 !
-!
- END IF
- END DO
-!
-!* 1.10 Scale the fall speed difference
-!
- IF( ZSCALSR>0.0 ) PRSCOLRG(JLBDAR,JLBDAS) = ZCOLLSR / ZSCALSR
- END DO
-END DO
-!
-END SUBROUTINE RSCOLRG
diff --git a/src/mesonh/ext/series_cloud_elec.f90 b/src/mesonh/ext/series_cloud_elec.f90
index c740922db924e0a69472a670046a154571f3977e..1eb1e4e48311570513adb6a6535a1290d6b07913 100644
--- a/src/mesonh/ext/series_cloud_elec.f90
+++ b/src/mesonh/ext/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/mesonh/ext/set_conc_ice_c1r3.f90 b/src/mesonh/ext/set_conc_ice_c1r3.f90
index 0dfe34119bcd614b71adf0c7c6e3e9d8a8e006b4..c2f74743969e573f2ff3fead077f94503bd12897 100644
--- a/src/mesonh/ext/set_conc_ice_c1r3.f90
+++ b/src/mesonh/ext/set_conc_ice_c1r3.f90
@@ -75,11 +75,11 @@ END MODULE MODI_SET_CONC_ICE_C1R3
!* 0. DECLARATIONS
! ------------
!
-USE MODD_CST, ONLY : XRHOLI
-USE MODD_CONF, ONLY : NVERB
-USE MODD_ICE_C1R3_DESCR, ONLY : XRTMIN, XCTMIN
-USE MODD_ICE_C1R3_PARAM, ONLY : XCONCI_MAX, XNUC_CON, XEXTT_CON, XEX_CON
-USE MODD_LUNIT_n, ONLY : TLUOUT
+USE MODD_CST, ONLY : XRHOLI
+USE MODD_CONF, ONLY : NVERB
+USE MODD_ICE_C1R3_DESCR, ONLY : XRTMIN, XCTMIN
+USE MODD_ICE_C1R3_PARAM, ONLY : XCONCI_MAX, XNUC_CON, XEXTT_CON, XEX_CON
+USE MODD_LUNIT_n, ONLY : TLUOUT
USE MODD_RAIN_ICE_DESCR_n, ONLY : XAI, XBI
!
IMPLICIT NONE
diff --git a/src/mesonh/ext/set_rsou.f90 b/src/mesonh/ext/set_rsou.f90
index 6c2ea6b2f9203cc2eca4d01697a0975155c40f95..4526251833db633bf65d0808d8f86cf6ad973943 100644
--- a/src/mesonh/ext/set_rsou.f90
+++ b/src/mesonh/ext/set_rsou.f90
@@ -261,7 +261,7 @@ END MODULE MODI_SET_RSOU
USE MODD_CONF
USE MODD_CONF_n
USE MODD_CST
-USE MODD_NEB_n, ONLY: NEBN
+USE MODD_NEB_n, ONLY: NEBN
USE MODD_DYN_n, ONLY: LOCEAN
USE MODD_FIELD_n
USE MODD_GRID
diff --git a/src/mesonh/ext/spawn_model2.f90 b/src/mesonh/ext/spawn_model2.f90
index 3511cd27f32930b19e51dac080c7feeb5469d991..c9c9c5774cfc9584037f3a450e06934da32d5ceb 100644
--- a/src/mesonh/ext/spawn_model2.f90
+++ b/src/mesonh/ext/spawn_model2.f90
@@ -290,9 +290,9 @@ USE MODI_GET_SIZEX_LB
USE MODI_GET_SIZEY_LB
!
USE MODD_LIMA_PRECIP_SCAVENGING_n
-USE MODD_PARAM_LIMA, ONLY : MDEPOC=>LDEPOC, LSCAV
-USE MODD_PARAM_ICE_n, ONLY : LDEPOSC
-USE MODD_PARAM_C2R2, ONLY : LDEPOC
+USE MODD_PARAM_LIMA, ONLY : MDEPOC=>LDEPOC, LSCAV
+USE MODD_PARAM_ICE_n, ONLY : LDEPOSC
+USE MODD_PARAM_C2R2, ONLY : LDEPOC
USE MODD_PASPOL, ONLY : LPASPOL
!
USE MODD_MPIF
diff --git a/src/mesonh/ext/two_wayn.f90 b/src/mesonh/ext/two_wayn.f90
index b2299ee4ac537dace171013da289b8b8f0fc0b5b..7cd52cb869c5a0674e567649824cd16c7801c17c 100644
--- a/src/mesonh/ext/two_wayn.f90
+++ b/src/mesonh/ext/two_wayn.f90
@@ -123,7 +123,7 @@ USE MODD_PARAMETERS ! Declarative modules
USE MODD_NESTING
USE MODD_CONF
USE MODD_NSV
-USE MODD_PARAM_ICE_n, ONLY : LSEDIC
+USE MODD_PARAM_ICE_n, ONLY : LSEDIC
USE MODD_PARAM_C2R2, ONLY : LSEDC
USE MODD_PARAM_LIMA, ONLY : NSEDC => LSEDC
!
diff --git a/src/mesonh/ext/write_desfmn.f90 b/src/mesonh/ext/write_desfmn.f90
index d5ee56097423c4e106b08d9387980c0b063c2f27..50210c832df24a366f4c738aeebce932e7c8f49d 100644
--- a/src/mesonh/ext/write_desfmn.f90
+++ b/src/mesonh/ext/write_desfmn.f90
@@ -162,9 +162,14 @@ USE MODD_FOREFIRE, ONLY: LFOREFIRE
USE MODD_IBM_LSF, ONLY: LIBM_LSF
USE MODD_IO, ONLY: TFILEDATA
USE MODD_LUNIT_n, ONLY: TLUOUT
+USE MODD_NEB_n, ONLY: NEBN_INIT
USE MODD_PARAMETERS
+USE MODD_PARAM_ICE_n, ONLY: PARAM_ICEN_INIT
+USE MODD_PARAM_LIMA, ONLY: PARAM_LIMA_INIT
+USE MODD_PARAM_MFSHALL_n, ONLY: PARAM_MFSHALLN_INIT
USE MODD_PROFILER_n, ONLY: LPROFILER
USE MODD_STATION_n, ONLY: LSTATION
+USE MODD_TURB_n, ONLY: TURBN_INIT
!
USE MODE_MSG
!
@@ -179,19 +184,14 @@ USE MODN_BUDGET
USE MODN_LES
USE MODN_DYN_n
USE MODN_ADV_n
-USE MODN_PARAM_n
-USE MODN_PARAM_RAD_n
USE MODN_PARAM_ECRAD_n
USE MODN_PARAM_KAFR_n
-USE MODD_PARAM_MFSHALL_n, ONLY: PARAM_MFSHALLN_INIT
-USE MODD_PARAM_ICE_n, ONLY: PARAM_ICEN_INIT
-USE MODD_PARAM_LIMA, ONLY: PARAM_LIMA_INIT
+USE MODN_PARAM_n
+USE MODN_PARAM_RAD_n
USE MODN_CONF_n
USE MODN_LUNIT_n
USE MODN_LBC_n
USE MODN_NUDGING_n
-USE MODD_TURB_n, ONLY: TURBN_INIT
-USE MODD_NEB_n, ONLY: NEBN_INIT
USE MODN_BLANK_n
USE MODN_FRC
USE MODN_CH_MNHC_n
@@ -216,8 +216,8 @@ USE MODN_BLOWSNOW_n
USE MODN_BLOWSNOW
USE MODN_IBM_PARAM_n
USE MODN_RECYCL_PARAM_n
-USE MODN_PROFILER_n
-USE MODN_STATION_n
+USE MODN_PROFILER_n, LDIAG_SURFRAD_PROF => LDIAG_SURFRAD
+USE MODN_STATION_n, LDIAG_SURFRAD_STAT => LDIAG_SURFRAD
USE MODN_FIRE_n
USE MODN_FLYERS
!
@@ -367,7 +367,7 @@ CALL INIT_NAM_PARAM_KAFRn
IF(CDCONV /= 'NONE' .OR. CSCONV == 'KAFR') &
WRITE(UNIT=ILUSEG,NML=NAM_PARAM_KAFRn)
!
-IF (CSCONV == 'EDKF' ) CALL PARAM_MFSHALLN_INIT(CPROGRAM, 0, .FALSE., ILUSEG, .FALSE., .FALSE., .FALSE., 1)
+IF (CSCONV == 'EDKF' ) CALL PARAM_MFSHALLN_INIT(CPROGRAM, TPDATAFILE, .FALSE., ILUSEG, .FALSE., .FALSE., .FALSE., 1)
!
CALL INIT_NAM_LBCn
WRITE(UNIT=ILUSEG,NML=NAM_LBCn)
@@ -375,9 +375,9 @@ WRITE(UNIT=ILUSEG,NML=NAM_LBCn)
CALL INIT_NAM_NUDGINGn
WRITE(UNIT=ILUSEG,NML=NAM_NUDGINGn)
!
-IF(CTURB /= 'NONE') CALL TURBN_INIT(CPROGRAM, 0, .FALSE., ILUSEG, .FALSE., .FALSE., .FALSE., 1)
+IF(CTURB /= 'NONE') CALL TURBN_INIT(CPROGRAM, TPDATAFILE, .FALSE., ILUSEG, .FALSE., .FALSE., .FALSE., 1)
!
-CALL NEBN_INIT(CPROGRAM, 0, .FALSE., ILUSEG, .FALSE., .FALSE., .FALSE., 1)
+CALL NEBN_INIT(CPROGRAM, TPDATAFILE, .FALSE., ILUSEG, .FALSE., .FALSE., .FALSE., 1)
!
CALL INIT_NAM_BLANKn
WRITE(UNIT=ILUSEG,NML=NAM_BLANKn)
@@ -457,15 +457,15 @@ IF(LBU_RSV) WRITE(UNIT=ILUSEG,NML=NAM_BU_RSV)
IF(LLES_MEAN .OR. LLES_RESOLVED .OR. LLES_SUBGRID .OR. LLES_UPDRAFT &
.OR. LLES_DOWNDRAFT .OR. LLES_SPECTRA) WRITE(UNIT=ILUSEG,NML=NAM_LES)
IF(LFORCING .OR. LTRANS) WRITE(UNIT=ILUSEG,NML=NAM_FRC)
-IF(CCLOUD(1:3) == 'ICE') CALL PARAM_ICEN_INIT(CPROGRAM, 0, .FALSE., ILUSEG, .FALSE., .FALSE., .FALSE., 1)
+IF(CCLOUD(1:3) == 'ICE') CALL PARAM_ICEN_INIT(CPROGRAM, TPDATAFILE, .FALSE., ILUSEG, .FALSE., .FALSE., .FALSE., 1)
IF(CCLOUD == 'C2R2' .OR. CCLOUD == 'C3R5' .OR. CCLOUD == 'KHKO') &
WRITE(UNIT=ILUSEG,NML=NAM_PARAM_C2R2)
IF(CCLOUD == 'C3R5' ) WRITE(UNIT=ILUSEG,NML=NAM_PARAM_C1R3)
-IF(CCLOUD == 'LIMA' ) CALL PARAM_LIMA_INIT(CPROGRAM, 0, .FALSE., ILUSEG, .FALSE., .FALSE., .FALSE., 1)
+IF(CCLOUD == 'LIMA' ) CALL PARAM_LIMA_INIT(CPROGRAM, TPDATAFILE, .FALSE., ILUSEG, .FALSE., .FALSE., .FALSE., 1)
IF(CELEC /= 'NONE') WRITE(UNIT=ILUSEG,NML=NAM_ELEC)
IF(LSERIES) WRITE(UNIT=ILUSEG,NML=NAM_SERIES)
-IF(CTURB /= 'NONE') CALL TURBN_INIT(CPROGRAM, 0, .FALSE., ILUSEG, .FALSE., .FALSE., .FALSE., 1)
-CALL NEBN_INIT(CPROGRAM, 0, .FALSE., ILUSEG, .FALSE., .FALSE., .FALSE., 1)
+IF(CTURB /= 'NONE') CALL TURBN_INIT(CPROGRAM, TPDATAFILE, .FALSE., ILUSEG, .FALSE., .FALSE., .FALSE., 1)
+CALL NEBN_INIT(CPROGRAM, TPDATAFILE, .FALSE., ILUSEG, .FALSE., .FALSE., .FALSE., 1)
WRITE(UNIT=ILUSEG,NML=NAM_FLYERS)
!Not possible (for the moment): arrays have been deallocated after ini_aircraft: WRITE(UNIT=ILUSEG,NML=NAM_AIRCRAFTS)
!Not possible (for the moment): arrays have been deallocated after ini_balloon: WRITE(UNIT=ILUSEG,NML=NAM_BALLOONS)
@@ -521,7 +521,7 @@ IF (NVERB >= 5) THEN
WRITE(UNIT=ILUOUT,NML=NAM_PARAM_KAFRn)
!
WRITE(UNIT=ILUOUT,FMT="('************ PARAM_MFSHALLn *******')")
- CALL PARAM_MFSHALLN_INIT(CPROGRAM, 0, .FALSE., ILUOUT, .FALSE., .FALSE., .FALSE., 2)
+ CALL PARAM_MFSHALLN_INIT(CPROGRAM, TPDATAFILE, .FALSE., ILUOUT, .FALSE., .FALSE., .FALSE., 2)
!
WRITE(UNIT=ILUOUT,FMT="('********** LBCn ********************')")
WRITE(UNIT=ILUOUT,NML=NAM_LBCn)
@@ -530,10 +530,10 @@ IF (NVERB >= 5) THEN
WRITE(UNIT=ILUOUT,NML=NAM_NUDGINGn)
!
WRITE(UNIT=ILUOUT,FMT="('********** TURBn *******************')")
- CALL TURBN_INIT(CPROGRAM, 0, .FALSE., ILUOUT, .FALSE., .FALSE., .FALSE., 2)
+ CALL TURBN_INIT(CPROGRAM, TPDATAFILE, .FALSE., ILUOUT, .FALSE., .FALSE., .FALSE., 2)
!
WRITE(UNIT=ILUOUT,FMT="('********** NEBn *******************')")
- CALL NEBN_INIT(CPROGRAM, 0, .FALSE., ILUOUT, .FALSE., .FALSE., .FALSE., 2)
+ CALL NEBN_INIT(CPROGRAM, TPDATAFILE, .FALSE., ILUOUT, .FALSE., .FALSE., .FALSE., 2)
!
WRITE(UNIT=ILUOUT,FMT="('********** CHEMICAL MONITORn *******')")
WRITE(UNIT=ILUOUT,NML=NAM_CH_MNHCn)
@@ -554,7 +554,7 @@ IF (NVERB >= 5) THEN
WRITE(UNIT=ILUOUT,NML=NAM_BLANKn)
!
WRITE(UNIT=ILUOUT,FMT="('************ ICE SCHEME ***********************')")
- CALL PARAM_ICEN_INIT(CPROGRAM, 0, .FALSE., ILUOUT, .FALSE., .FALSE., .FALSE., 2)
+ CALL PARAM_ICEN_INIT(CPROGRAM, TPDATAFILE, .FALSE., ILUOUT, .FALSE., .FALSE., .FALSE., 2)
!
IF (KMI==1) THEN
WRITE(UNIT=ILUOUT,FMT="(/,'PART OF SEGMENT FILE COMMON TO ALL THE MODELS')")
@@ -671,7 +671,7 @@ IF (NVERB >= 5) THEN
!
IF( CCLOUD == 'LIMA' ) THEN
WRITE(UNIT=ILUOUT,FMT="('*********** LIMA SCHEME *********************')")
- CALL PARAM_LIMA_INIT(CPROGRAM, 0, .FALSE., ILUOUT, .FALSE., .FALSE., .FALSE., 2)
+ CALL PARAM_LIMA_INIT(CPROGRAM, TPDATAFILE, .FALSE., ILUOUT, .FALSE., .FALSE., .FALSE., 2)
END IF
!
IF( CCLOUD == 'KHKO' ) THEN
diff --git a/src/mesonh/ext/write_lesn.f90 b/src/mesonh/ext/write_lesn.f90
index 44f915343d63daec3f7f285412ab3fdb75b6fd2d..c35e3eafa6d7cd382b62dc002e08b1bafbf87a6e 100644
--- a/src/mesonh/ext/write_lesn.f90
+++ b/src/mesonh/ext/write_lesn.f90
@@ -1150,14 +1150,12 @@ if ( nspectra_k > 0 ) then
call Les_diachro_2pt_write( tpdiafile, XCORRi_WRi, XCORRj_WRi, 'WRI', 'W*ri 2 points correlations', 'm kg s-1 kg-1' )
end if
-!PW: TODO: ameliorer le ygroup (tenir compte de ce qu'est la variable scalaire et pas juste son jsv!)
do jsv = 1, nsv
Write( ygroup, fmt = "( a2, i3.3 )" ) "SS", jsv
call Les_diachro_2pt_write( tpdiafile, XCORRi_SvSv(:,:,:,JSV), XCORRj_SvSv(:,:,:,JSV), ygroup, &
'Sv*Sv 2 points correlations','kg2 kg-2' )
end do
-!PW: TODO: ameliorer le ygroup (tenir compte de ce qu'est la variable scalaire et pas juste son jsv!)
do jsv = 1, nsv
Write( ygroup, fmt = "( a2, i3.3 )" ) "WS", jsv
call Les_diachro_2pt_write( tpdiafile, XCORRi_WSv(:,:,:,JSV), XCORRj_WSv(:,:,:,JSV), ygroup, &
diff --git a/src/mesonh/ext/write_lfifm1_for_diag.f90 b/src/mesonh/ext/write_lfifm1_for_diag.f90
index a6099e6a0f4eb779347699adbcf1e6f85fc896ca..84ff78bdab8ce9d1759df3baa7a02dc307bd0382 100644
--- a/src/mesonh/ext/write_lfifm1_for_diag.f90
+++ b/src/mesonh/ext/write_lfifm1_for_diag.f90
@@ -1087,7 +1087,6 @@ IF (LLIMA_DIAG) THEN
END IF
!
DO JSV = NSV_LIMA_BEG,NSV_LIMA_END
-!PW: bases sur CLIMA_*_CONC et pas CLIMA_*_NAMES !!!
!
TZFIELD%CUNITS = 'cm-3'
WRITE(TZFIELD%CCOMMENT,'(A6,A3,I3.3)')'X_Y_Z_','SVT',JSV
@@ -1194,7 +1193,6 @@ IF (LLIMA_DIAG) THEN
END IF
!
END IF
-!PW: TODO: a documenter
IF (LELECDIAG .AND. CELEC .NE. "NONE") THEN
DO JSV = NSV_ELECBEG,NSV_ELECEND
TZFIELD = TSVLIST(JSV)
@@ -1279,7 +1277,6 @@ IF (LPASPOL) THEN
END IF
! Conditional sampling variables
IF (LCONDSAMP) THEN
-!PW: TODO: a documenter!!!
DO JSV = NSV_CSBEG, NSV_CSEND
TZFIELD = TSVLIST(JSV)
CALL IO_Field_write(TPFILE,TZFIELD,XSVT(:,:,:,JSV))
@@ -1319,7 +1316,6 @@ IF (LCHAQDIAG) THEN !aqueous concentration in M
-!PW: TODO: LCHICDIAG n'existe pas => les variables correspondantes ne sont pas ecrites...
! ZWORK31(:,:,:)=0.
! DO JSV = NSV_CHICBEG,NSV_CHICEND ! ice phase
@@ -1348,8 +1344,26 @@ IF ((LCHEMDIAG).AND.(LORILAM).AND.(LUSECHEM)) THEN
IF (.NOT.(ASSOCIATED(XSIG3D))) &
ALLOCATE(XSIG3D(SIZE(XSVT,1),SIZE(XSVT,2),SIZE(XSVT,3),JPMODE))
!
- CALL PPP2AERO(XSVT(:,:,:,NSV_AERBEG:NSV_AEREND), XRHODREF, &
- PSIG3D=XSIG3D, PRG3D=XRG3D, PN3D=XN3D, PCTOTA=ZPTOTA)
+ IF (CRGUNIT=="MASS") THEN
+ XRG3D(:,:,:,1) = XINIRADIUSI * EXP(-3.*(LOG(XINISIGI))**2)
+ XRG3D(:,:,:,2) = XINIRADIUSJ * EXP(-3.*(LOG(XINISIGJ))**2)
+ ELSE
+ XRG3D(:,:,:,1) = XINIRADIUSI
+ XRG3D(:,:,:,2) = XINIRADIUSJ
+ END IF
+ XSIG3D(:,:,:,1) = XINISIGI
+ XSIG3D(:,:,:,2) = XINISIGJ
+ XN3D(:,:,:,1) = XN0IMIN
+ XN3D(:,:,:,2) = XN0JMIN
+
+ ZPTOTA(:,:,:,:,:) = 0.
+
+ CALL PPP2AERO(XSVT(IIB:IIE,IJB:IJE,IKB:IKE,NSV_AERBEG:NSV_AEREND),&
+ XRHODREF(IIB:IIE,IJB:IJE,IKB:IKE), &
+ PSIG3D=XSIG3D(IIB:IIE,IJB:IJE,IKB:IKE,:),&
+ PRG3D=XRG3D(IIB:IIE,IJB:IJE,IKB:IKE,:),&
+ PN3D=XN3D(IIB:IIE,IJB:IJE,IKB:IKE,:),&
+ PCTOTA=ZPTOTA(IIB:IIE,IJB:IJE,IKB:IKE,:,:))
TZFIELD = TFIELDMETADATA( &
CMNHNAME = 'generic for aerosol modes', &
@@ -1868,7 +1882,6 @@ END IF
! Blowing snow variables
!
IF(LBLOWSNOW) THEN
-!PW:TODO?:variables scalaires XSVT pas ecrites ici. Voulu?
TZFIELD = TFIELDMETADATA( &
CMNHNAME = 'SNWSUBL3D', &
CSTDNAME = '', &
diff --git a/src/mesonh/ext/write_lfifm1_for_diag_supp.f90 b/src/mesonh/ext/write_lfifm1_for_diag_supp.f90
index bb8214c93eb61a4b10f68adc4f90d12f6d43773f..974e78231d39c46ec70973c62476ca5fb54998d5 100644
--- a/src/mesonh/ext/write_lfifm1_for_diag_supp.f90
+++ b/src/mesonh/ext/write_lfifm1_for_diag_supp.f90
@@ -91,6 +91,9 @@ END MODULE MODI_WRITE_LFIFM1_FOR_DIAG_SUPP
!! J.-P. Chaboureau 07/2018 bug fix on XEMIS when calling CALL_RTTOVxx
!! J.-P. Chaboureau 09/04/2021 add the call to RTTOV13
! P. Wautelet 04/02/2022: use TSVLIST to manage metadata of scalar variables
+!! D. Ricard & Q.Rodier 08/2023 add some diagnostics on pressure levels
+!! (temperature, relative and specific humidity, vertical velocity, TKE)
+!! D. Ricard 08/2023 add a diagnostic: maximum of cloud fraction on vertical levels
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -100,7 +103,7 @@ USE MODD_CH_AEROSOL, ONLY: LORILAM
USE MODD_CH_BUDGET_n, ONLY: CNAMES_BUDGET, NEQ_BUDGET, XTCHEM
USE MODD_CH_FLX_n, ONLY: XCHFLX
USE MODD_CH_PRODLOSSTOT_n, ONLY: CNAMES_PRODLOSST, NEQ_PLT, XLOSS, XPROD
-USE MODD_CST, ONLY: XCPD, XP00, XRD, XTT
+USE MODD_CST, ONLY: XCPD, XP00, XRD, XTT, XMV, XMD, XALPI, XGAMI, XBETAI
USE MODD_CURVCOR_n, ONLY: XCORIOZ
USE MODD_DIAG_IN_RUN, ONLY: XCURRENT_ZON10M, XCURRENT_MER10M, &
XCURRENT_SFCO2, XCURRENT_SWD, XCURRENT_LWD, &
@@ -111,7 +114,7 @@ use modd_field, only: NMNHDIM_NI, NMNHDIM_NJ, NMNHDIM_NOTLISTED, NMN
use modd_field
USE MODD_IO, ONLY: TFILEDATA
USE MODD_CONF, ONLY: LCARTESIAN
-USE MODD_CONF_n, ONLY: LUSERC, LUSERI, NRR
+USE MODD_CONF_n, ONLY: LUSERC, LUSERI, LUSERV, NRR
USE MODD_DEEP_CONVECTION_n, ONLY: NCLBASCONV, NCLTOPCONV, XCAPE, XDMFCONV, XDRCCONV, XDRICONV, XDRVCONV, &
XDTHCONV, XDSVCONV, XMFCONV, XPRLFLXCONV, XPRSFLXCONV, XUMFCONV
USE MODD_DIAG_FLAG, ONLY: CRAD_SAT, LCHEMDIAG, LCLD_COV, LCOARSE, LISOAL, LISOPR, LISOTH, LRAD_SUBG_COND, &
@@ -119,11 +122,11 @@ USE MODD_DIAG_FLAG, ONLY: CRAD_SAT, LCHEMDIAG, LCLD_COV, LCOARSE, LISOAL
USE MODD_FIELD_n, ONLY: XCLDFR, XICEFR, XPABST, XSIGS, XTHT, XTKET, XRT, XUT, XVT, XWT
USE MODD_GRID_n, ONLY: XZHAT, XZZ
USE MODD_METRICS_n, ONLY: XDXX, XDYY, XDZX, XDZY, XDZZ
-USE MODD_NEB_n, ONLY: LSIGMAS, LSUBG_COND, VSIGQSAT
+USE MODD_NEB_n, ONLY: LSIGMAS, LSUBG_COND, VSIGQSAT
USE MODD_NSV, ONLY: NSV, NSV_CHEMBEG, NSV_CHEMEND, TSVLIST
USE MODD_PARAMETERS, ONLY: JPVEXT, NUNDEF, XUNDEF
USE MODD_PARAM_KAFR_n, ONLY: LCHTRANS
-USE MODD_PARAM_n, ONLY: CRAD, CSURF
+USE MODD_PARAM_n, ONLY: CRAD, CSURF, CCLOUD
USE MODD_PARAM_RAD_n, only: NRAD_COLNBR
USE MODD_RADIATIONS_N, ONLY: NCLEARCOL_TM1, NDLON, NFLEV, NSTATM, &
XAER, XAZIM, XCCO2, XDIR_ALB, XDIRFLASWD, XDIRSRFSWD, XDTHRAD, XEMIS, &
@@ -132,12 +135,12 @@ USE MODD_RAD_TRANSF, ONLY: JPGEOST
USE MODD_REF_n, ONLY: XRHODREF
USE MODD_SALT, ONLY: LSALT
USE MODD_TIME_n, ONLY: TDTCUR
-USE MODD_NEB_n, ONLY: LSIGMAS, LSUBG_COND, VSIGQSAT
use mode_field, only: Find_field_id_from_mnhname
USE MODE_IO_FIELD_WRITE, only: IO_Field_write
USE MODE_MSG
USE MODE_NEIGHBORAVG, ONLY: BLOCKAVG, MOVINGAVG
+USE MODE_THERMO, ONLY: SM_FOES
USE MODE_TOOLS_LL, ONLY: GET_INDICE_ll
#ifdef MNH_RTTOV_8
@@ -172,7 +175,7 @@ TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
INTEGER :: IIU,IJU,IKU,IIB,IJB,IKB,IIE,IJE,IKE ! Arrays bounds
INTEGER :: IKRAD
!
-INTEGER :: JI,JJ,JK,JSV ! loop index
+INTEGER :: JI,JJ,JK,JSV,JRR ! loop index
!
! variables for Diagnostic variables related to deep convection
REAL,DIMENSION(:,:), ALLOCATABLE :: ZWORK21,ZWORK22
@@ -198,7 +201,8 @@ INTEGER :: IPRES, ITH
CHARACTER(LEN=4) :: YCAR4
CHARACTER(LEN=4), DIMENSION(SIZE(XISOPR)) :: YPRES
CHARACTER(LEN=4), DIMENSION(SIZE(XISOTH)) :: YTH
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZWORK32,ZWORK33,ZWORK34,ZWRES,ZPRES,ZWTH
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZWORK32,ZWORK33,ZWORK34,ZWRES,ZPRES,ZWTH, &
+ ZRT,ZQV,ZMRVP,ZWRES1,ZTEMPP
REAL, DIMENSION(:), ALLOCATABLE :: ZTH
REAL,DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)) :: ZPOVO
REAL,DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)) :: ZVOX,ZVOY,ZVOZ
@@ -434,6 +438,22 @@ IF (LCLD_COV .AND. LUSERC) THEN
CALL IO_Field_write(TPFILE,'CLDFR',XCLDFR)
CALL IO_Field_write(TPFILE,'ICEFR',XICEFR)
!
+ ZWORK21(:,:)=0.0
+ ZWORK21(IIB:IIE,IJB:IJE)=MAXVAL(XCLDFR(IIB:IIE,IJB:IJE,JPVEXT+1:IKE),DIM=3)
+
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'CLDFRMAX', &
+ !Invalid CF convention standard name: CSTDNAME = 'max_cloud_fraction', &
+ CLONGNAME = 'CLDFRMAX', &
+ CUNITS = '1', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_MAx of CLoud fraction', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 2, &
+ LTIMEDEP = .TRUE. )
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK21)
+ !
! Visibility
!
ZWORK31(:,:,:)= 1.E4 ! 10 km for clear sky
@@ -910,6 +930,7 @@ IF (CSURF=='EXTE') THEN
CALL IO_Field_write(TPFILE,TZFIELD,XCURRENT_SFCO2)
END IF
!
+ IF ( CRAD /= 'NONE' ) THEN
IF(ANY(XCURRENT_SWD/=XUNDEF))THEN
TZFIELD = TFIELDMETADATA( &
CMNHNAME = 'SWD', &
@@ -969,6 +990,7 @@ IF (CSURF=='EXTE') THEN
LTIMEDEP = .TRUE. )
CALL IO_Field_write(TPFILE,TZFIELD,XCURRENT_LWU)
END IF
+ END IF ! CRAD/='NONE'
END IF
! MODIF FP NOV 2012
@@ -996,6 +1018,7 @@ ALLOCATE(ZWORK34(IIU,IJU,IKU))
END DO
ALLOCATE(ZWRES(IIU,IJU,IPRES))
+ ALLOCATE(ZTEMPP(IIU,IJU,IPRES))
ZWRES(:,:,:)=XUNDEF
ALLOCATE(ZPRES(IIU,IJU,IPRES))
IPRES=0
@@ -1031,6 +1054,17 @@ ALLOCATE(ZWORK34(IIU,IJU,IKU))
CALL IO_Field_write(TPFILE,TZFIELD,ZWRES(:,:,JK))
END DO
! *********************
+! Temperature
+! *********************
+ DO JK=1,IPRES
+ TZFIELD%CMNHNAME = 'TEMP'//TRIM(YPRES(JK))//'HPA'
+ TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
+ TZFIELD%CUNITS = 'K'
+ TZFIELD%CCOMMENT = 'X_Y_air temperature '//TRIM(YPRES(JK))//' hPa'
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWRES(:,:,JK)*(ZPRES(:,:,JK)/XP00)**(XRD/XCPD))
+ END DO
+ ZTEMPP(:,:,:)=ZWRES(:,:,:)
+! *********************
! Wind
! *********************
ZWORK31(:,:,:) = MXF(XUT(:,:,:))
@@ -1054,6 +1088,29 @@ ALLOCATE(ZWORK34(IIU,IJU,IKU))
TZFIELD%CCOMMENT = 'X_Y_V component of wind '//TRIM(YPRES(JK))//' hPa'
CALL IO_Field_write(TPFILE,TZFIELD,ZWRES(:,:,JK))
END DO
+ !
+ ZWORK31(:,:,:) = MZF(XWT(:,:,:))
+ CALL PINTER(ZWORK31, XPABST, XZZ, ZTEMP, ZWRES, ZPRES, &
+ IIU, IJU, IKU, IKB, IPRES, 'LOG', 'RHU.')
+ DO JK=1,IPRES
+ TZFIELD%CMNHNAME = 'WT'//TRIM(YPRES(JK))//'HPA'
+ TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
+ TZFIELD%CUNITS = 'm s-1'
+ TZFIELD%CCOMMENT = 'X_Y_V component of wind '//TRIM(YPRES(JK))//' hPa'
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWRES(:,:,JK))
+ END DO
+! *********************
+! Turbulent kinetic energy
+! *********************
+ CALL PINTER(XTKET, XPABST, XZZ, ZTEMP, ZWRES, ZPRES, &
+ IIU, IJU, IKU, IKB, IPRES, 'LOG', 'RHU.')
+ DO JK=1,IPRES
+ TZFIELD%CMNHNAME = 'TKET'//TRIM(YPRES(JK))//'HPA'
+ TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
+ TZFIELD%CUNITS = 'm 2 s-2'
+ TZFIELD%CCOMMENT = 'X_Y_turbulent kinetic energy '//TRIM(YPRES(JK))//' hPa'
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWRES(:,:,JK))
+ END DO
! *********************
! Water Vapour Mixing Ratio
! *********************
@@ -1066,6 +1123,55 @@ ALLOCATE(ZWORK34(IIU,IJU,IKU))
TZFIELD%CCOMMENT = 'X_Y_Vapor Mixing Ratio '//TRIM(YPRES(JK))//' hPa'
CALL IO_Field_write(TPFILE,TZFIELD,ZWRES(:,:,JK)*1.E3)
END DO
+!
+! *********************
+! Relative humidity
+! *********************
+ IF (LUSERV) THEN
+ ALLOCATE(ZWRES1(IIU,IJU,IPRES))
+ ALLOCATE(ZMRVP(IIU,IJU,IPRES))
+ ZMRVP(:,:,:)=ZWRES(:,:,:)
+ ZWRES1(:,:,:)=SM_FOES(ZTEMPP(:,:,:))
+ ZWRES1(:,:,:)=(XMV/XMD)*ZWRES1(:,:,:)/(ZPRES(:,:,:)-ZWRES1(:,:,:))
+ ZWRES(:,:,:)=100.*ZMRVP(:,:,:)/ZWRES1(:,:,:)
+ IF (CCLOUD(1:3) =='ICE' .OR. CCLOUD =='C3R5' .OR. CCLOUD == 'LIMA') THEN
+ WHERE ( ZTEMPP(:,:,:)< XTT)
+ ZWRES1(:,:,:) = EXP( XALPI - XBETAI/ZTEMPP(:,:,:) &
+ - XGAMI*ALOG(ZTEMPP(:,:,:)) ) !saturation over ice
+ ZWRES1(:,:,:)=(XMV/XMD)*ZWRES1(:,:,:)/(ZPRES(:,:,:)-ZWRES1(:,:,:))
+ ZWRES(:,:,:)=100.*ZMRVP(:,:,:)/ZWRES1(:,:,:)
+ END WHERE
+ END IF
+ DO JK=1,IPRES
+ TZFIELD%CMNHNAME = 'REHU'//TRIM(YPRES(JK))//'HPA'
+ TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
+ TZFIELD%CUNITS = 'percent'
+ TZFIELD%CCOMMENT = 'X_Y_Relative humidity '//TRIM(YPRES(JK))//' hPa'
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWRES(:,:,JK))
+ END DO
+ DEALLOCATE(ZWRES1,ZMRVP,ZTEMPP)
+ END IF
+ !
+ ALLOCATE(ZRT(IIU,IJU,IKU))
+ ALLOCATE(ZQV(IIU,IJU,IKU))
+ ZRT(:,:,:)=0.
+ DO JRR=1,NRR
+ ZRT(:,:,:) = ZRT(:,:,:) + XRT(:,:,:,JRR)
+ END DO
+ ZQV(:,:,:) = XRT(:,:,:,1) / (1.0 + ZRT(:,:,:))
+ ! *********************
+ ! Water specific humidity
+ ! *********************
+ CALL PINTER(ZQV, XPABST, XZZ, ZTEMP, ZWRES, ZPRES, &
+ IIU, IJU, IKU, IKB, IPRES, 'LOG', 'RHU.')
+ DO JK=1,IPRES
+ TZFIELD%CMNHNAME = 'QV'//TRIM(YPRES(JK))//'HPA'
+ TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
+ TZFIELD%CUNITS = 'kg kg-1'
+ TZFIELD%CCOMMENT = 'X_Y_Vapor Specific humidity '//TRIM(YPRES(JK))//' hPa'
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWRES(:,:,JK))
+ END DO
+ DEALLOCATE(ZRT,ZQV)
! *********************
! Geopotential in meters
! *********************
diff --git a/src/mesonh/ext/xy_to_latlon.f90 b/src/mesonh/ext/xy_to_latlon.f90
index 45a379940c45a11e46943cc0cd61895fb3ec97f6..d544a960751ac2ebbafdc763ddaeee0b2adfe1f0 100644
--- a/src/mesonh/ext/xy_to_latlon.f90
+++ b/src/mesonh/ext/xy_to_latlon.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1996-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1996-2023 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.
@@ -73,6 +73,8 @@ USE MODD_LUNIT
!
USE MODE_FIELD, ONLY: INI_FIELD_LIST
USE MODE_GRIDPROJ
+USE MODE_INI_CST, ONLY: INI_CST
+USE MODE_INIT_ll, only: SET_DIM_ll, SET_JP_ll
USE MODE_IO, only: IO_Config_set, IO_Init
use MODE_IO_FIELD_READ, only: IO_Field_read
USE MODE_IO_FILE, only: IO_File_close, IO_File_open
@@ -80,7 +82,6 @@ USE MODE_IO_MANAGE_STRUCT, only: IO_File_add2list
USE MODE_MODELN_HANDLER, ONLY: GOTO_MODEL
use MODE_SPLITTINGZ_ll
!
-USE MODE_INI_CST, ONLY: INI_CST
USE MODI_READ_HGRID
!
USE MODN_CONFIO, ONLY: NAM_CONFIO
diff --git a/src/mesonh/ext/zoom_pgd.f90 b/src/mesonh/ext/zoom_pgd.f90
index 8caa8ccb640fc9c5bfff4ff7353b87586c9586e8..efd60bdd8b7ff10aab35bd512983979ae82eb07b 100644
--- a/src/mesonh/ext/zoom_pgd.f90
+++ b/src/mesonh/ext/zoom_pgd.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 2005-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2005-2023 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.
@@ -59,6 +59,7 @@ use modd_precision, only: LFIINT
!
USE MODE_FINALIZE_MNH, only: FINALIZE_MNH
USE MODE_POS
+USE MODE_INI_CST, ONLY: INI_CST
USE MODE_IO, only: IO_Config_set, IO_Init
USE MODE_IO_FIELD_READ, only: IO_Field_read
USE MODE_IO_FIELD_WRITE, only: IO_Field_write, IO_Header_write
@@ -82,7 +83,6 @@ USE MODI_WRITE_PGD_SURF_ATM_N
USE MODD_MNH_SURFEX_n
!
USE MODN_CONFIO, ONLY : NAM_CONFIO
-USE MODE_INI_CST, ONLY: INI_CST
!
IMPLICIT NONE
!
@@ -138,9 +138,9 @@ ILUNAM = TZNMLFILE%NLU
CPGDFILE = 'PGDFILE' ! name of the input file
YZOOMFILE = ''
YZOOMNBR = '00'
-CALL POSNAM(ILUNAM,'NAM_PGDFILE',GFOUND,ILUOUT0)
+CALL POSNAM( TZNMLFILE, 'NAM_PGDFILE', GFOUND )
IF (GFOUND) READ(UNIT=ILUNAM,NML=NAM_PGDFILE)
-CALL POSNAM(ILUNAM,'NAM_CONFIO',GFOUND,ILUOUT0)
+CALL POSNAM( TZNMLFILE, 'NAM_CONFIO', GFOUND )
IF (GFOUND) READ(UNIT=ILUNAM,NML=NAM_CONFIO)
CALL IO_Config_set()
!
@@ -199,7 +199,6 @@ IF ( (LEN_TRIM(YZOOMFILE) == 0) .OR. (ADJUSTL(YZOOMFILE) == ADJUSTL(CPGDFILE)) )
END IF
!
CALL IO_File_add2list(TZZOOMFILE,TRIM(YZOOMFILE),'PGD','WRITE',KLFINPRAR=INT(1,KIND=LFIINT),KLFITYPE=1,KLFIVERB=5)
-!PW: TODO: points to dad file (if existing) ! TZZOOMFILE%TDADFILE =>
!
CALL IO_File_open(TZZOOMFILE)
CALL WRITE_HGRID(1,TZZOOMFILE)
diff --git a/src/mesonh/filesToSuppress.txt b/src/mesonh/filesToSuppress.txt
index ca6910d2cf72296af8bd8b2a60e8ace4cf3ebe86..559ea345838ab41d288c985c1eaf9dce1f8e0396 100644
--- a/src/mesonh/filesToSuppress.txt
+++ b/src/mesonh/filesToSuppress.txt
@@ -1,6 +1,6 @@
#This file contains the source codes that must not be included
#for the model compilation. These codes already exist in the Meso-NH model
-#and are used outside of the physics
+#and are used outside of the physics, or are not useful for Meso-NH (i.e. for testsprogs only)
# must be written with lower case .f90 (because prep_code already transformed it)
aux/mode_msg.f90
diff --git a/src/mesonh/micro/ini_param_elec.f90 b/src/mesonh/micro/ini_param_elec.f90
index 03bc5fc30c2dc413ea721f83cdda88a4c543ae0e..b144572c51801be9f045437ebf8323b2a33b8994 100644
--- a/src/mesonh/micro/ini_param_elec.f90
+++ b/src/mesonh/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/mesonh/micro/ini_rain_ice_elec.f90 b/src/mesonh/micro/ini_rain_ice_elec.f90
index 3a0279455f46639c20443f68f27caa1b166700f3..1a7fa798b429365740460f18850a2215c1a69bb3 100644
--- a/src/mesonh/micro/ini_rain_ice_elec.f90
+++ b/src/mesonh/micro/ini_rain_ice_elec.f90
@@ -208,12 +208,6 @@ IF (CSEDIM == 'SPLI') THEN
END DO SPLIT
END IF
!
-IF (HCLOUD == 'ICE4') THEN
- CALL RAIN_ICE_DESCR_ALLOCATE(7)
-ELSE IF (HCLOUD == 'ICE3') THEN
- CALL RAIN_ICE_DESCR_ALLOCATE(6)
-END IF
-!
XRTMIN(1) = 1.0E-20
XRTMIN(2) = 1.0E-20
XRTMIN(3) = 1.0E-20
diff --git a/src/mesonh/micro/lima_nucleation_procs.f90 b/src/mesonh/micro/lima_nucleation_procs.f90
deleted file mode 100644
index c239ca84cf69c23c4370c8488ee9cb6428669957..0000000000000000000000000000000000000000
--- a/src/mesonh/micro/lima_nucleation_procs.f90
+++ /dev/null
@@ -1,394 +0,0 @@
-!MNH_LIC Copyright 2018-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_LIMA_NUCLEATION_PROCS
-! ###############################
-!
-IMPLICIT NONE
-INTERFACE
- SUBROUTINE LIMA_NUCLEATION_PROCS (PTSTEP, TPFILE, PRHODJ, &
- PRHODREF, PEXNREF, PPABST, PT, PDTHRAD, PW_NU,&
- PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
- PCCT, PCRT, PCIT, &
- PNFT, PNAT, PIFT, PINT, PNIT, PNHT, &
- PCLDFR, PICEFR, PPRCFR )
-!
-USE MODD_IO, ONLY: TFILEDATA
-IMPLICIT NONE
-!
-REAL, INTENT(IN) :: PTSTEP ! Double Time step
-TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Reference density
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Reference density
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! abs. pressure at time t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PT ! Temperature
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDTHRAD ! Radiative temperature tendency
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PW_NU ! updraft velocity used for
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHT ! Theta at t
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRVT ! Water vapor m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRCT ! Cloud water m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Rain water m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRIT ! Pristine ice m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRST ! Snow m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRGT ! Graupel m.r. at t
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCCT ! Cloud water conc. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PCRT ! Rain water conc. at t
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCIT ! Prinstine ice conc. at t
-!
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PNFT ! CCN C. available at t
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PNAT ! CCN C. activated at t
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PIFT ! IFN C. available at t
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PINT ! IFN C. activated at t
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PNIT ! Coated IFN activated at t
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PNHT ! CCN hom freezing
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCLDFR ! Cloud fraction
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PICEFR ! Ice fraction
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PPRCFR ! Precipitation fraction
-!
-END SUBROUTINE LIMA_NUCLEATION_PROCS
-END INTERFACE
-END MODULE MODI_LIMA_NUCLEATION_PROCS
-! #############################################################################
-SUBROUTINE LIMA_NUCLEATION_PROCS (PTSTEP, TPFILE, PRHODJ, &
- PRHODREF, PEXNREF, PPABST, PT, PDTHRAD, PW_NU,&
- PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
- PCCT, PCRT, PCIT, &
- PNFT, PNAT, PIFT, PINT, PNIT, PNHT, &
- PCLDFR, PICEFR, PPRCFR )
-! #############################################################################
-!
-!! PURPOSE
-!! -------
-!! Compute nucleation processes for the time-split version of LIMA
-!!
-!! AUTHOR
-!! ------
-!! B. Vié * CNRM *
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 15/03/2018
-! M. Leriche 06/2019: missing update of PNFT after CCN hom. ncl.
-! P. Wautelet 27/02/2020: bugfix: PNFT was not updated after LIMA_CCN_HOM_FREEZING
-! P. Wautelet 27/02/2020: add Z_TH_HINC variable (for budgets)
-! P. Wautelet 02/2020: use the new data structures and subroutines for budgets
-! 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
-!-------------------------------------------------------------------------------
-!
-use modd_budget, only: lbu_enable, lbudget_th, lbudget_rv, lbudget_rc, lbudget_rr, &
- lbudget_ri, lbudget_rs, lbudget_rg, lbudget_rh, lbudget_sv, &
- NBUDGET_TH, NBUDGET_RV, NBUDGET_RC, NBUDGET_RI, NBUDGET_SV1, &
- tbudgets
-USE MODD_IO, ONLY: TFILEDATA
-USE MODD_PARAMETERS, ONLY : JPHEXT, JPVEXT
-USE MODD_NSV, ONLY : NSV_LIMA_NC, NSV_LIMA_NR, NSV_LIMA_CCN_FREE, NSV_LIMA_CCN_ACTI, &
- NSV_LIMA_NI, NSV_LIMA_IFN_FREE, NSV_LIMA_IFN_NUCL, NSV_LIMA_IMM_NUCL, NSV_LIMA_HOM_HAZE
-USE MODD_PARAM_LIMA, ONLY : LCOLD, LNUCL, LMEYERS, LSNOW, LWARM, LACTI, LRAIN, LHHONI, &
- NMOD_CCN, NMOD_IFN, NMOD_IMM, XCTMIN, XRTMIN, LSPRO, NMOM_I, NMOM_C
-USE MODD_NEB_n, ONLY : LSUBG_COND
-
-use mode_budget, only: Budget_store_add, Budget_store_init, Budget_store_end
-
-USE MODI_LIMA_CCN_ACTIVATION
-USE MODI_LIMA_CCN_HOM_FREEZING
-USE MODI_LIMA_MEYERS_NUCLEATION
-USE MODI_LIMA_PHILLIPS_IFN_NUCLEATION
-USE MODE_RAIN_ICE_NUCLEATION
-!
-!-------------------------------------------------------------------------------
-!
-IMPLICIT NONE
-!
-!-------------------------------------------------------------------------------
-!
-REAL, INTENT(IN) :: PTSTEP ! Double Time step
-TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Reference density
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Reference density
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! abs. pressure at time t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PT ! Temperature
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDTHRAD ! Radiative temperature tendency
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PW_NU ! updraft velocity used for
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHT ! Theta at t
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRVT ! Water vapor m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRCT ! Cloud water m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Rain water m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRIT ! Rain water m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRST ! Rain water m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRGT ! Rain water m.r. at t
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCCT ! Cloud water conc. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PCRT ! Rain water conc. at t
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCIT ! Prinstine ice conc. at t
-!
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PNFT ! CCN C. available at t
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PNAT ! CCN C. activated at t
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PIFT ! IFN C. available at t
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PINT ! IFN C. activated at t
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PNIT ! Coated IFN activated at t
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PNHT ! CCN hom. freezing
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCLDFR ! Cloud fraction
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PICEFR ! Ice fraction
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PPRCFR ! Precipitation fraction
-!
-!-------------------------------------------------------------------------------
-!
-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)) :: ZTHS, ZRIS, ZRVS, ZRHT, ZCIT, ZT
-!
-integer :: idx
-INTEGER :: JL
-!
-!-------------------------------------------------------------------------------
-!
-IF ( LWARM .AND. LACTI .AND. NMOD_CCN >=1 .AND. NMOM_C.GE.2) THEN
-
- IF (.NOT.LSUBG_COND .AND. .NOT.LSPRO) THEN
-
- if ( lbu_enable ) then
- if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'HENU', ptht(:, :, :) * prhodj(:, :, :) / ptstep )
- if ( lbudget_rv ) call Budget_store_init( tbudgets(NBUDGET_RV), 'HENU', prvt(:, :, :) * prhodj(:, :, :) / ptstep )
- if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'HENU', prct(:, :, :) * prhodj(:, :, :) / ptstep )
- if ( lbudget_sv ) then
- call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'HENU', pcct(:, :, :) * prhodj(:, :, :) / ptstep )
- do jl = 1, nmod_ccn
- idx = NBUDGET_SV1 - 1 + nsv_lima_ccn_free - 1 + jl
- call Budget_store_init( tbudgets(idx), 'HENU', pnft(:, :, :, jl) * prhodj(:, :, :) / ptstep )
- idx = NBUDGET_SV1 - 1 + nsv_lima_ccn_acti - 1 + jl
- call Budget_store_init( tbudgets(idx), 'HENU', pnat(:, :, :, jl) * prhodj(:, :, :) / ptstep )
- end do
- end if
- end if
-
- CALL LIMA_CCN_ACTIVATION( TPFILE, &
- PRHODREF, PEXNREF, PPABST, PT, PDTHRAD, PW_NU, &
- PTHT, PRVT, PRCT, PCCT, PRRT, PNFT, PNAT, PCLDFR )
- if ( lbu_enable ) then
- if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'HENU', ptht(:, :, :) * prhodj(:, :, :) / ptstep )
- if ( lbudget_rv ) call Budget_store_end( tbudgets(NBUDGET_RV), 'HENU', prvt(:, :, :) * prhodj(:, :, :) / ptstep )
- if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'HENU', prct(:, :, :) * prhodj(:, :, :) / ptstep )
- if ( lbudget_sv ) then
- call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'HENU', pcct(:, :, :) * prhodj(:, :, :) / ptstep )
- do jl = 1, nmod_ccn
- idx = NBUDGET_SV1 - 1 + nsv_lima_ccn_free - 1 + jl
- call Budget_store_end( tbudgets(idx), 'HENU', pnft(:, :, :, jl) * prhodj(:, :, :) / ptstep )
- idx = NBUDGET_SV1 - 1 + nsv_lima_ccn_acti - 1 + jl
- call Budget_store_end( tbudgets(idx), 'HENU', pnat(:, :, :, jl) * prhodj(:, :, :) / ptstep )
- end do
- end if
- end if
-
- END IF
-
- WHERE(PCLDFR(:,:,:)<1.E-10 .AND. PRCT(:,:,:)>XRTMIN(2) .AND. PCCT(:,:,:)>XCTMIN(2)) PCLDFR(:,:,:)=1.
-
-END IF
-!
-!-------------------------------------------------------------------------------
-!
-IF ( LCOLD .AND. LNUCL .AND. NMOM_I>=2 .AND. .NOT.LMEYERS .AND. NMOD_IFN >= 1 ) THEN
- if ( lbu_enable ) then
- if ( lbudget_sv ) then
- do jl = 1, nmod_ifn
- idx = NBUDGET_SV1 - 1 + nsv_lima_ifn_free - 1 + jl
- call Budget_store_init( tbudgets(idx), 'HIND', pift(:, :, :, jl) * prhodj(:, :, :) / ptstep )
- idx = NBUDGET_SV1 - 1 + nsv_lima_ifn_nucl - 1 + jl
- call Budget_store_init( tbudgets(idx), 'HIND', pint(:, :, :, jl) * prhodj(:, :, :) / ptstep )
- end do
-
- do jl = 1, nmod_ccn
- idx = NBUDGET_SV1 - 1 + nsv_lima_ccn_acti - 1 + jl
- call Budget_store_init( tbudgets(idx), 'HINC', pnat(:, :, :, jl) * prhodj(:, :, :) / ptstep )
- end do
- do jl = 1, nmod_imm
- idx = NBUDGET_SV1 - 1 + nsv_lima_imm_nucl - 1 + jl
- call Budget_store_init( tbudgets(idx), 'HINC', pnit(:, :, :, jl) * prhodj(:, :, :) / ptstep )
- end do
- end if
- end if
-
- CALL LIMA_PHILLIPS_IFN_NUCLEATION (PTSTEP, &
- 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, &
- PICEFR )
- WHERE(PICEFR(:,:,:)<1.E-10 .AND. PRIT(:,:,:)>XRTMIN(4) .AND. PCIT(:,:,:)>XCTMIN(4)) PICEFR(:,:,:)=1.
-!
- if ( lbu_enable ) then
- if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'HIND', z_th_hind(:, :, :) * prhodj(:, :, :) / ptstep )
- if ( lbudget_rv ) call Budget_store_add( tbudgets(NBUDGET_RV), 'HIND', -z_ri_hind(:, :, :) * prhodj(:, :, :) / ptstep )
- if ( lbudget_ri ) call Budget_store_add( tbudgets(NBUDGET_RI), 'HIND', z_ri_hind(:, :, :) * prhodj(:, :, :) / ptstep )
- if ( lbudget_sv ) then
- call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'HIND', z_ci_hind(:, :, :) * prhodj(:, :, :) / ptstep )
- do jl = 1, nmod_ifn
- idx = NBUDGET_SV1 - 1 + nsv_lima_ifn_free - 1 + jl
- call Budget_store_end( tbudgets(idx), 'HIND', pift(:, :, :, jl) * prhodj(:, :, :) / ptstep )
- idx = NBUDGET_SV1 - 1 + nsv_lima_ifn_nucl - 1 + jl
- call Budget_store_end( tbudgets(idx), 'HIND', pint(:, :, :, jl) * prhodj(:, :, :) / ptstep )
- end do
- end if
-
- if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'HINC', z_th_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
- if ( lbudget_rc ) call Budget_store_add( tbudgets(NBUDGET_RC), 'HINC', z_rc_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
- if ( lbudget_ri ) call Budget_store_add( tbudgets(NBUDGET_RI), 'HINC', -z_rc_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
- if ( lbudget_sv ) then
- if (nmom_c.ge.2) then
- call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'HINC', z_cc_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
- end if
- call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'HINC', -z_cc_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
- do jl = 1, nmod_ccn
- idx = NBUDGET_SV1 - 1 + nsv_lima_ccn_acti - 1 + jl
- call Budget_store_end( tbudgets(idx), 'HINC', pnat(:, :, :, jl) * prhodj(:, :, :) / ptstep )
- end do
- do jl = 1, nmod_imm
- idx = NBUDGET_SV1 - 1 + nsv_lima_imm_nucl - 1 + jl
- call Budget_store_end( tbudgets(idx), 'HINC', pnit(:, :, :, jl) * prhodj(:, :, :) / ptstep )
- end do
- end if
- end if
-END IF
-!
-!-------------------------------------------------------------------------------
-!
-IF (LCOLD .AND. LNUCL .AND. NMOM_I>=2 .AND. LMEYERS) THEN
- CALL LIMA_MEYERS_NUCLEATION (PTSTEP, &
- 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, &
- PICEFR )
- WHERE(PICEFR(:,:,:)<1.E-10 .AND. PRIT(:,:,:)>XRTMIN(4) .AND. PCIT(:,:,:)>XCTMIN(4)) PICEFR(:,:,:)=1.
- !
- if ( lbu_enable ) then
- if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'HIND', z_th_hind(:, :, :) * prhodj(:, :, :) / ptstep )
- if ( lbudget_rv ) call Budget_store_add( tbudgets(NBUDGET_RV), 'HIND', -z_ri_hind(:, :, :) * prhodj(:, :, :) / ptstep )
- if ( lbudget_ri ) call Budget_store_add( tbudgets(NBUDGET_RI), 'HIND', z_ri_hind(:, :, :) * prhodj(:, :, :) / ptstep )
- if ( lbudget_sv ) then
- call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'HIND', z_ci_hind(:, :, :) * prhodj(:, :, :) / ptstep )
- if (nmod_ifn > 0 ) &
- call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ifn_nucl), 'HIND', &
- z_ci_hind(:, :, :) * prhodj(:, :, :) / ptstep )
- end if
-
- if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'HINC', z_th_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
- if ( lbudget_rc ) call Budget_store_add( tbudgets(NBUDGET_RC), 'HINC', z_rc_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
- if ( lbudget_ri ) call Budget_store_add( tbudgets(NBUDGET_RI), 'HINC', -z_rc_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
- if ( lbudget_sv ) then
- if (nmom_c.ge.2) then
- call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'HINC', z_cc_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
- end if
- call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'HINC', -z_cc_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
- if (nmod_ifn > 0 ) &
- call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ifn_nucl), 'HINC', &
- -z_cc_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
- end if
- end if
-END IF
-!
-!-------------------------------------------------------------------------------
-!
-IF (LCOLD .AND. LNUCL .AND. NMOM_I.EQ.1) THEN
- WHERE(PICEFR(:,:,:)<1.E-10 .AND. PRIT(:,:,:)>XRTMIN(4) .AND. PCIT(:,:,:)>XCTMIN(4)) PICEFR(:,:,:)=1.
- !
- ZTHS=PTHT/PTSTEP
- ZRVS=PRVT/PTSTEP
- ZRIS=PRIT/PTSTEP
- ZRHT=0.
- ZCIT=PCIT
- ZT=PT
- CALL RAIN_ICE_NUCLEATION(1+JPHEXT, SIZE(PT,1)-JPHEXT, 1+JPHEXT, SIZE(PT,2)-JPHEXT, 1+JPVEXT, SIZE(PT,3)-JPVEXT, 6, &
- PTSTEP, PTHT, PPABST, PRHODJ, PRHODREF, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
- ZCIT, PEXNREF, ZTHS, ZRVS, ZRIS, ZT, ZRHT)
- !
-! Z_TH_HIND=ZTHS*PTSTEP-PTHT
-! Z_RI_HIND=ZRIS*PTSTEP-PRIT
-! Z_CI_HIND=ZCIT-PCIT
- PCIT=ZCIT
- PRIT=ZRIS*PTSTEP
- PTHT=ZTHS*PTSTEP
- PRVT=ZRVS*PTSTEP
-! Z_TH_HINC=0.
-! Z_RC_HINC=0.
-! Z_CC_HINC=0.
-! !
-! if ( lbu_enable ) then
-! if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'HIND', z_th_hind(:, :, :) * prhodj(:, :, :) / ptstep )
-! if ( lbudget_rv ) call Budget_store_add( tbudgets(NBUDGET_RV), 'HIND', -z_ri_hind(:, :, :) * prhodj(:, :, :) / ptstep )
-! if ( lbudget_ri ) call Budget_store_add( tbudgets(NBUDGET_RI), 'HIND', z_ri_hind(:, :, :) * prhodj(:, :, :) / ptstep )
-! if ( lbudget_sv ) then
-! call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'HIND', z_ci_hind(:, :, :) * prhodj(:, :, :) / ptstep )
-! if (nmod_ifn > 0 ) &
-! call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ifn_nucl), 'HIND', &
-! z_ci_hind(:, :, :) * prhodj(:, :, :) / ptstep )
-! end if
-!
-! if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'HINC', z_th_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
-! if ( lbudget_rc ) call Budget_store_add( tbudgets(NBUDGET_RC), 'HINC', z_rc_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
-! if ( lbudget_ri ) call Budget_store_add( tbudgets(NBUDGET_RI), 'HINC', -z_rc_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
-! if ( lbudget_sv ) then
-! call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'HINC', z_cc_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
-! call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'HINC', -z_cc_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
-! if (nmod_ifn > 0 ) &
-! call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ifn_nucl), 'HINC', &
-! -z_cc_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
-! end if
-! end if
-END IF
-!
-!-------------------------------------------------------------------------------
-!
-IF ( LCOLD .AND. LNUCL .AND. LHHONI .AND. NMOD_CCN >= 1 .AND. NMOM_I.GE.2) THEN
- if ( lbu_enable ) then
- if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'HONH', PTHT(:, :, :) * prhodj(:, :, :) / ptstep )
- if ( lbudget_rv ) call Budget_store_init( tbudgets(NBUDGET_RV), 'HONH', PRVT(:, :, :) * prhodj(:, :, :) / ptstep )
- if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'HONH', PRIT(:, :, :) * prhodj(:, :, :) / ptstep )
- if ( lbudget_sv ) then
- call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'HONH', PCIT(:, :, :) * prhodj(:, :, :) / ptstep )
- do jl = 1, nmod_ccn
- idx = NBUDGET_SV1 - 1 + nsv_lima_ccn_free - 1 + jl
- call Budget_store_init( tbudgets(idx), 'HONH', PNFT(:, :, :, jl) * prhodj(:, :, :) / ptstep )
- end do
- call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_hom_haze), 'HONH', PNHT(:, :, :) * prhodj(:, :, :) / ptstep )
- end if
- end if
-
- CALL LIMA_CCN_HOM_FREEZING (PRHODREF, PEXNREF, PPABST, PW_NU, &
- PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
- PCCT, PCRT, PCIT, PNFT, PNHT, &
- PICEFR )
- WHERE(PICEFR(:,:,:)<1.E-10 .AND. PRIT(:,:,:)>XRTMIN(4) .AND. PCIT(:,:,:)>XCTMIN(4)) PICEFR(:,:,:)=1.
-!
- if ( lbu_enable ) then
- if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'HONH', PTHT(:, :, :) * prhodj(:, :, :) / ptstep )
- if ( lbudget_rv ) call Budget_store_end( tbudgets(NBUDGET_RV), 'HONH', PRVT(:, :, :) * prhodj(:, :, :) / ptstep )
- if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'HONH', PRIT(:, :, :) * prhodj(:, :, :) / ptstep )
- if ( lbudget_sv ) then
- call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'HONH', PCIT(:, :, :) * prhodj(:, :, :) / ptstep )
- do jl = 1, nmod_ccn
- idx = NBUDGET_SV1 - 1 + nsv_lima_ccn_free - 1 + jl
- call Budget_store_end( tbudgets(idx), 'HONH', PNFT(:, :, :, jl) * prhodj(:, :, :) / ptstep )
- end do
- call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_hom_haze), 'HONH', PNHT(:, :, :) * prhodj(:, :, :) / ptstep )
- end if
- end if
-ENDIF
-!
-!-------------------------------------------------------------------------------
-!
-END SUBROUTINE LIMA_NUCLEATION_PROCS
diff --git a/src/mesonh/micro/radar_rain_ice.f90 b/src/mesonh/micro/radar_rain_ice.f90
index 13cfa19bd0b4abc4d53a3b7552431aae46ec1aa3..ae504233f2bf27919460e236fe796abf2021b6de 100644
--- a/src/mesonh/micro/radar_rain_ice.f90
+++ b/src/mesonh/micro/radar_rain_ice.f90
@@ -129,7 +129,7 @@ USE MODD_PARAM_LIMA_MIXED, ONLY:XDG_L=>XDG,XLBEXG_L=>XLBEXG,XLBG_L=>XLBG,XCCG_L=
XCXH_L=>XCXH,XDH_L=>XDH,XCH_L=>XCH,XALPHAH_L=>XALPHAH,XNUH_L=>XNUH,XBH_L=>XBH
USE MODD_PARAM_LIMA, ONLY: XALPHAR_L=>XALPHAR,XNUR_L=>XNUR,XALPHAS_L=>XALPHAS,XNUS_L=>XNUS,&
- XALPHAG_L=>XALPHAG,XNUG_L=>XNUG, XALPHAI_L=>XALPHAI,XNUI_L=>XNUI,&
+ XALPHAG_L=>XALPHAG,XNUG_L=>XNUG, XALPHAI_L=>XALPHAI,XNUI_L=>XNUI, NMOM_C, NMOM_R, NMOM_I, &
XRTMIN_L=>XRTMIN,XALPHAC_L=>XALPHAC,XNUC_L=>XNUC,LSNOW_T_L=>LSNOW_T,NMOM_S,NMOM_G,NMOM_H
USE MODD_PARAMETERS
USE MODD_PARAM_n, ONLY : CCLOUD
@@ -254,8 +254,8 @@ IF (SIZE(PRT,4) >= 3) THEN
Z3=7.8
!
ZLBDA(:,:,:) = 0.0
- IF (CCLOUD == 'LIMA') THEN
- GRAIN(:,:,:) =( (PRT(:,:,:,3).GT.XRTMIN_L(3)).AND. PCRT(:,:,:).GT.0.0)
+ IF (CCLOUD == 'LIMA' .AND. NMOM_R.GE.2) THEN
+ GRAIN(:,:,:) =( PRT(:,:,:,3).GT.XRTMIN_L(3) .AND. PCRT(:,:,:).GT.0.0)
ZLBEX=1.0/(-XBR_L)
ZLB_L(:,:,:)=( XAR_L*PCRT(:,:,:)*PRHODREF(:,:,:)*MOMG(XALPHAR_L,XNUR_L,XBR_L) )**(-ZLBEX)
WHERE( GRAIN(:,:,:) )
diff --git a/src/mesonh/turb/modn_param_mfshalln.f90 b/src/mesonh/turb/modn_param_mfshalln.f90
deleted file mode 100644
index 8b137891791fe96927ad78e64b0aad7bded08bdc..0000000000000000000000000000000000000000
--- a/src/mesonh/turb/modn_param_mfshalln.f90
+++ /dev/null
@@ -1 +0,0 @@
-
diff --git a/src/testprogs/aux/modd_misc.F90 b/src/testprogs/aux/modd_misc.F90
index 2642e4f3976ccf45f9c03ee7df8f760a3f241009..bf3c2f272f2283e3a3de739989cc0a66171d3890 100644
--- a/src/testprogs/aux/modd_misc.F90
+++ b/src/testprogs/aux/modd_misc.F90
@@ -34,6 +34,9 @@ TYPE MISC_t
TYPE(TFILEDATA) :: ZTFILE
REAL :: PRSNOW
LOGICAL :: ODIAG_IN_RUN
- CHARACTER(LEN=4) :: CMICRO
+ CHARACTER(LEN=4) :: CMICRO
+ LOGICAL :: OELEC=.FALSE. !< Lightning prognostic scheme
+ CHARACTER(LEN=4) :: CELEC='NONE' !< Name of the electricity scheme
+ LOGICAL :: OSEDIM_BEARD=.FALSE. !< Switch for effect of electrical forces on sedim.
END TYPE MISC_t
END MODULE MODD_MISC
diff --git a/src/testprogs/ice_adjust/main_ice_adjust.F90 b/src/testprogs/ice_adjust/main_ice_adjust.F90
index dca1e7d7160f6565c648cf8d08bc51b8c71a3d49..728acef74c1e0bd043b4d57a24414a4ec6e056ee 100644
--- a/src/testprogs/ice_adjust/main_ice_adjust.F90
+++ b/src/testprogs/ice_adjust/main_ice_adjust.F90
@@ -5,6 +5,7 @@ USE GETDATA_ICE_ADJUST_MOD, ONLY: GETDATA_ICE_ADJUST
USE COMPUTE_DIFF, ONLY: DIFF
USE MODI_ICE_ADJUST
USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+USE MODD_IO, ONLY: TFILEDATA
USE MODD_PHYEX, ONLY: PHYEX_t
USE STACK_MOD
USE OMP_LIB
@@ -56,6 +57,7 @@ INTEGER :: IBL, JLON, JLEV
TYPE(DIMPHYEX_t) :: D, D0
TYPE(PHYEX_t) :: PHYEX
+TYPE(TFILEDATA) :: TPFILE
LOGICAL :: LLCHECK
LOGICAL :: LLCHECKDIFF
LOGICAL :: LLDIFF
@@ -314,9 +316,10 @@ CMICRO='ICE3'
CSCONV='NONE'
CTURB='TKEL'
PTSTEP = 50.000000000000000
+TPFILE%NLU=0
!Default values
-CALL INI_PHYEX(CPROGRAM, 0, .TRUE., IULOUT, 0, 1, &
+CALL INI_PHYEX(CPROGRAM, TPFILE, .TRUE., IULOUT, 0, 1, &
&PTSTEP, ZDZMIN, &
&CMICRO, CSCONV, CTURB, &
&LDDEFAULTVAL=.TRUE., LDREADNAM=.FALSE., LDCHECK=.FALSE., KPRINT=0, LDINIT=.FALSE., &
@@ -361,7 +364,7 @@ PHYEX%NEBN%CFRAC_ICE_ADJUST='S' ! Ice/liquid partition rule to use in adjustment
PHYEX%NEBN%CFRAC_ICE_SHALLOW_MF='S' ! Ice/liquid partition rule to use in shallow_mf
!Param initialisation
-CALL INI_PHYEX(CPROGRAM, 0, .TRUE., IULOUT, 0, 1, &
+CALL INI_PHYEX(CPROGRAM, TPFILE, .TRUE., IULOUT, 0, 1, &
&PTSTEP, ZDZMIN, &
&CMICRO, CSCONV, CTURB, &
&LDDEFAULTVAL=.FALSE., LDREADNAM=.FALSE., LDCHECK=.TRUE., KPRINT=2, LDINIT=.TRUE., &
diff --git a/src/testprogs/rain_ice/main_rain_ice.F90 b/src/testprogs/rain_ice/main_rain_ice.F90
index 2dd27371f4979b6161503cf0b48cdb2ebbad37ef..1e381ade159f0174a97a9c60c88676240c49bb1c 100644
--- a/src/testprogs/rain_ice/main_rain_ice.F90
+++ b/src/testprogs/rain_ice/main_rain_ice.F90
@@ -5,6 +5,7 @@ USE GETDATA_RAIN_ICE_MOD, ONLY: GETDATA_RAIN_ICE
USE COMPUTE_DIFF, ONLY: DIFF
USE MODI_RAIN_ICE
USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+USE MODD_IO, ONLY: TFILEDATA
USE MODD_PHYEX, ONLY: PHYEX_t
USE STACK_MOD
USE OMP_LIB
@@ -49,6 +50,7 @@ INTEGER :: IBL, JLON, JLEV
TYPE(DIMPHYEX_t) :: D, D0
TYPE(PHYEX_t) :: PHYEX
+TYPE(TFILEDATA) :: TPFILE
LOGICAL :: LLCHECK
LOGICAL :: LLCHECKDIFF
LOGICAL :: LLDIFF
@@ -56,6 +58,7 @@ INTEGER :: IBLOCK1, IBLOCK2
INTEGER :: ISTSZ, JBLK1, JBLK2
INTEGER :: NTID, ITID
INTEGER :: JRR
+REAL :: ZTHVREFZIKB! for electricity use only
REAL, ALLOCATABLE :: PSTACK(:,:)
TYPE (STACK) :: YLSTACK
@@ -128,7 +131,6 @@ D0%NKB = KLEV
D0%NKE = 1
D0%NKTB = 1
D0%NKTE = KLEV
-
ISTSZ = NPROMA * 20 * KLEV
ALLOCATE (PSTACK (ISTSZ, NGPBLKS))
@@ -136,6 +138,11 @@ TS = OMP_GET_WTIME ()
ZTD = 0.
ZTC = 0.
+IF (PHYEX%MISC%CELEC /='NONE') THEN
+CALL ABORT ! The following value of ZTHVREFZIKB must be removed from the electricity scheme or computed correctly here
+ELSE
+ ZTHVREFZIKB = 0. ! for electricity use only
+END IF
IF (LHOOK) CALL DR_HOOK ('MAIN',0,ZHOOK_HANDLE)
@@ -197,10 +204,10 @@ JBLK2 = (NGPBLKS * (ITID+1)) / NTID
YLSTACK%L = 0
YLSTACK%U = 0
#endif
-
CALL RAIN_ICE (D, PHYEX%CST, PHYEX%PARAM_ICEN, PHYEX%RAIN_ICE_PARAMN, &
- & PHYEX%RAIN_ICE_DESCRN, PHYEX%MISC%TBUCONF, &
- & PTSTEP=PHYEX%MISC%PTSTEP, &
+ & PHYEX%RAIN_ICE_DESCRN, PHYEX%ELEC_PARAM, PHYEX%ELEC_DESCR, &
+ & PHYEX%MISC%TBUCONF, OELEC=PHYEX%MISC%OELEC, OSEDIM_BEARD=PHYEX%MISC%OSEDIM_BEARD, &
+ & PTHVREFZIKB=ZTHVREFZIKB, HCLOUD='ICE3 ', PTSTEP=PHYEX%MISC%PTSTEP, &
& KRR=PHYEX%MISC%KRR, PEXN=PEXNREF(:,:,IBL), &
& PDZZ=PDZZ(:,:,IBL), PRHODJ=PRHODJ(:,:,IBL), PRHODREF=PRHODREF(:,:,IBL),PEXNREF=PEXNREF2(:,:,IBL),&
& PPABST=PPABSM(:,:,IBL), PCIT=PCIT(:,:,IBL), PCLDFR=PCLDFR(:,:,IBL), &
@@ -316,9 +323,10 @@ CMICRO='ICE3'
CSCONV='NONE'
CTURB='TKEL'
PTSTEP = 25.0000000000000
+TPFILE%NLU=0
!Default values
-CALL INI_PHYEX(CPROGRAM, 0, .TRUE., IULOUT, 0, 1, &
+CALL INI_PHYEX(CPROGRAM, TPFILE, .TRUE., IULOUT, 0, 1, &
&PTSTEP, ZDZMIN, &
&CMICRO, CSCONV, CTURB, &
&LDDEFAULTVAL=.TRUE., LDREADNAM=.FALSE., LDCHECK=.FALSE., KPRINT=0, LDINIT=.FALSE., &
@@ -356,7 +364,7 @@ PHYEX%PARAM_ICEN%CSUBG_RR_EVAP='NONE'
PHYEX%PARAM_ICEN%CSUBG_PR_PDF='SIGM'
!Param initialisation
-CALL INI_PHYEX(CPROGRAM, 0, .TRUE., IULOUT, 0, 1, &
+CALL INI_PHYEX(CPROGRAM, TPFILE, .TRUE., IULOUT, 0, 1, &
&PTSTEP, ZDZMIN, &
&CMICRO, CSCONV, CTURB, &
&LDDEFAULTVAL=.FALSE., LDREADNAM=.FALSE., LDCHECK=.TRUE., KPRINT=2, LDINIT=.TRUE., &
diff --git a/src/testprogs/rain_ice_old/main_rain_ice_old.F90 b/src/testprogs/rain_ice_old/main_rain_ice_old.F90
index af96129e22f3315d9414a1a877f52ac8c8418ade..584d28a324572ce59c45834fc87989099fb6907a 100644
--- a/src/testprogs/rain_ice_old/main_rain_ice_old.F90
+++ b/src/testprogs/rain_ice_old/main_rain_ice_old.F90
@@ -314,6 +314,7 @@ JBLK2 = (NGPBLKS * (ITID+1)) / NTID
ENDDO
+<<<<<<< HEAD
IF (LHOOK) CALL DR_HOOK ('MAIN',1,ZHOOK_HANDLE)
TE = OMP_GET_WTIME()
@@ -522,4 +523,3 @@ SUBROUTINE INIT_GMICRO(D, KRR, NGPBLKS, ODMICRO, PRT, PSSIO, OCND2)
END SUBROUTINE INIT_GMICRO
END PROGRAM
-
diff --git a/src/testprogs/shallow/main_shallow.F90 b/src/testprogs/shallow/main_shallow.F90
index 05281a7a0f05828e6bd0494f753b2edb64d134da..6edca5acf6bffbe910324fd4e4589e501978c8f0 100644
--- a/src/testprogs/shallow/main_shallow.F90
+++ b/src/testprogs/shallow/main_shallow.F90
@@ -5,6 +5,7 @@ USE GETDATA_SHALLOW_MOD, ONLY: GETDATA_SHALLOW
USE COMPUTE_DIFF, ONLY: DIFF
USE MODI_SHALLOW_MF
USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+USE MODD_IO, ONLY: TFILEDATA
USE MODD_PHYEX, ONLY: PHYEX_t
USE STACK_MOD
USE OMP_LIB
@@ -102,6 +103,7 @@ INTEGER :: IBL, JLON, JLEV
TYPE(DIMPHYEX_t) :: D, D0
TYPE(PHYEX_t) :: PHYEX
+TYPE(TFILEDATA) :: TPFILE
LOGICAL :: LLCHECK
LOGICAL :: LLCHECKDIFF
LOGICAL :: LLDIFF
@@ -405,9 +407,10 @@ CMICRO='NONE'
CSCONV='EDKF'
CTURB='TKEL'
PTSTEP = 25.0000000000000
+TPFILE%NLU=0
!Default values
-CALL INI_PHYEX(CPROGRAM, 0, .TRUE., IULOUT, 0, 1, &
+CALL INI_PHYEX(CPROGRAM, TPFILE, .TRUE., IULOUT, 0, 1, &
&PTSTEP, ZDZMIN, &
&CMICRO, CSCONV, CTURB, &
&LDDEFAULTVAL=.TRUE., LDREADNAM=.FALSE., LDCHECK=.FALSE., KPRINT=0, LDINIT=.FALSE., &
@@ -428,7 +431,7 @@ PHYEX%NEBN%LSUBG_COND=.TRUE.
PHYEX%NEBN%CFRAC_ICE_SHALLOW_MF='S'
!Param initialisation
-CALL INI_PHYEX(CPROGRAM, 0, .TRUE., IULOUT, 0, 1, &
+CALL INI_PHYEX(CPROGRAM, TPFILE, .TRUE., IULOUT, 0, 1, &
&PTSTEP, ZDZMIN, &
&CMICRO, CSCONV, CTURB, &
&LDDEFAULTVAL=.FALSE., LDREADNAM=.FALSE., LDCHECK=.TRUE., KPRINT=2, LDINIT=.TRUE., &
diff --git a/src/testprogs/turb_mnh/main_turb.F90 b/src/testprogs/turb_mnh/main_turb.F90
index 578d65520c061639dd03b4e951f3981525ad54c7..4111de05aa9e0e4a7249edbf75af943d324a974a 100644
--- a/src/testprogs/turb_mnh/main_turb.F90
+++ b/src/testprogs/turb_mnh/main_turb.F90
@@ -5,6 +5,7 @@ USE GETDATA_TURB_MOD, ONLY: GETDATA_TURB
USE COMPUTE_DIFF, ONLY: DIFF
USE MODI_TURB
USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+USE MODD_IO, ONLY: TFILEDATA
USE MODD_PHYEX, ONLY: PHYEX_t
USE STACK_MOD
USE OMP_LIB
@@ -111,6 +112,7 @@ INTEGER :: NPROMA, NGPBLKS, NFLEVG
INTEGER :: IBL, JLON, JLEV
TYPE(DIMPHYEX_t) :: D, D0
+TYPE(TFILEDATA) :: TPFILE
TYPE(PHYEX_t) :: PHYEX
LOGICAL :: LLCHECK
LOGICAL :: LLCHECKDIFF
@@ -297,7 +299,7 @@ CALL TURB(PHYEX%CST, PHYEX%CSTURB, PHYEX%MISC%TBUCONF, PHYEX%TURBN, PHYEX%NEBN,
& PHYEX%MISC%O2D, PHYEX%MISC%ONOMIXLG, PHYEX%MISC%OFLAT, PHYEX%MISC%OCOUPLES, PHYEX%MISC%OBLOWSNOW,PHYEX%MISC%OIBM,&
& PHYEX%MISC%OFLYER, PHYEX%MISC%OCOMPUTE_SRC, PHYEX%MISC%PRSNOW, &
& PHYEX%MISC%OOCEAN, PHYEX%MISC%ODEEPOC, PHYEX%MISC%ODIAG_IN_RUN, &
- & PHYEX%TURBN%CTURBLEN_CLOUD,PHYEX%MISC%CMICRO, &
+ & PHYEX%TURBN%CTURBLEN_CLOUD,PHYEX%MISC%CMICRO, PHYEX%MISC%CELEC, &
& PHYEX%MISC%PTSTEP,PHYEX%MISC%ZTFILE, &
& ZDXX(:,:,IBL),ZDYY(:,:,IBL),ZDZZ(:,:,IBL),ZDZX(:,:,IBL),ZDZY(:,:,IBL),ZZZ(:,:,IBL), &
& ZDIRCOSXW,ZDIRCOSYW,ZDIRCOSZW,ZCOSSLOPE,ZSINSLOPE, &
@@ -423,9 +425,10 @@ CMICRO='ICE3'
CSCONV='NONE'
CTURB='TKEL'
PTSTEP = 25.0000000000000
+TPFILE%NLU=0
!Default values
-CALL INI_PHYEX(CPROGRAM, 0, .TRUE., IULOUT, 0, 1, &
+CALL INI_PHYEX(CPROGRAM, TPFILE, .TRUE., IULOUT, 0, 1, &
&PTSTEP, ZDZMIN, &
&CMICRO, CSCONV, CTURB, &
&LDDEFAULTVAL=.TRUE., LDREADNAM=.FALSE., LDCHECK=.FALSE., KPRINT=0, LDINIT=.FALSE., &
@@ -469,7 +472,7 @@ PHYEX%TURBN%XLINI=0.1 !This line should not exist to reproduce operational setup
!was done (erroneously) with XLINI=0.1
!Param initialisation
-CALL INI_PHYEX(CPROGRAM, 0, .TRUE., IULOUT, 0, 1, &
+CALL INI_PHYEX(CPROGRAM, TPFILE, .TRUE., IULOUT, 0, 1, &
&PTSTEP, ZDZMIN, &
&CMICRO, CSCONV, CTURB, &
&LDDEFAULTVAL=.FALSE., LDREADNAM=.FALSE., LDCHECK=.TRUE., KPRINT=2, LDINIT=.TRUE., &