diff --git a/src/PHYEX/aux/modd_nsv.f90 b/src/PHYEX/aux/modd_nsv.f90
new file mode 100644
index 0000000000000000000000000000000000000000..9cfa343c413e3b78171c89590cf04432585986fc
--- /dev/null
+++ b/src/PHYEX/aux/modd_nsv.f90
@@ -0,0 +1,282 @@
+!MNH_LIC Copyright 2001-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 MODD_NSV
+! ###############
+!
+!!**** *MODD_NSV* - declaration of scalar variables numbers
+!!
+!! PURPOSE
+!! -------
+!! Arrays to store the per-model NSV_* values number (suffix _A denote an array)
+!!
+!! AUTHOR
+!! ------
+!! D. Gazen L.A.
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 01/02/01
+!! J.-P. Pinty 29/11/02 add C3R5, ELEC
+!! V. Masson 01/2004 add scalar names
+!! M. Leriche 12/04/07 add aqueous chemistry
+!! M. Leriche 08/07/10 add ice phase chemistry
+!! C.Lac 07/11 add conditional sampling
+!! Pialat/Tulet 15/02/12 add ForeFire
+!! Modification 01/2016 (JP Pinty) Add LIMA
+!! V. Vionnet 07/17 add blowing snow
+! B. Vie 06/2021: add prognostic supersaturation for LIMA
+! P. Wautelet 26/11/2021: add TSVLIST and TSVLIST_A to store the metadata of all the scalar variables
+! A. Costes 12/2021: add Blaze fire model smoke
+! 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
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_FIELD, ONLY: tfieldmetadata
+USE MODD_PARAMETERS, ONLY: JPMODELMAX, & ! Maximum allowed number of nested models
+ JPSVMAX, & ! Maximum number of scalar variables
+ JPSVNAMELGTMAX, & ! Maximum length of a scalar variable name
+ NMNHNAMELGTMAX
+!
+IMPLICIT NONE
+SAVE
+!
+REAL,DIMENSION(JPSVMAX) :: XSVMIN ! minimum value for SV variables
+!
+LOGICAL :: LINI_NSV(JPMODELMAX) = .FALSE. ! becomes True when routine INI_NSV is called
+!
+CHARACTER(LEN=NMNHNAMELGTMAX), DIMENSION(:,:), ALLOCATABLE, TARGET :: CSV_CHEM_LIST_A !Names of all the chemical variables
+TYPE(tfieldmetadata), DIMENSION(:,:), ALLOCATABLE, TARGET :: TSVLIST_A !Metadata of all the scalar variables
+
+INTEGER,DIMENSION(JPMODELMAX)::NSV_A = 0 ! total number of scalar variables
+ ! NSV_A = NSV_USER_A+NSV_C2R2_A+NSV_CHEM_A+..
+INTEGER,DIMENSION(JPMODELMAX)::NSV_CHEM_LIST_A = 0 ! total number of chemical variables (including dust, salt...)
+INTEGER,DIMENSION(JPMODELMAX)::NSV_USER_A = 0 ! number of user scalar variables with
+ ! indices in the range : 1...NSV_USER_A
+!
+INTEGER,DIMENSION(JPMODELMAX)::NSV_C2R2_A = 0 ! number of liq scalar in C2R2
+ ! and in C3R5
+INTEGER,DIMENSION(JPMODELMAX)::NSV_C2R2BEG_A = 0 ! with indices in the range :
+INTEGER,DIMENSION(JPMODELMAX)::NSV_C2R2END_A = 0 ! NSV_C2R2BEG_A...NSV_C2R2END_A
+!
+INTEGER,DIMENSION(JPMODELMAX)::NSV_C1R3_A = 0 ! number of ice scalar in C3R5
+INTEGER,DIMENSION(JPMODELMAX)::NSV_C1R3BEG_A = 0 ! with indices in the range :
+INTEGER,DIMENSION(JPMODELMAX)::NSV_C1R3END_A = 0 ! NSV_C1R3BEG_A...NSV_C1R3END_A
+!
+INTEGER,DIMENSION(JPMODELMAX)::NSV_ELEC_A = 0 ! number of scalar in ELEC
+INTEGER,DIMENSION(JPMODELMAX)::NSV_ELECBEG_A = 0 ! with indices in the range :
+INTEGER,DIMENSION(JPMODELMAX)::NSV_ELECEND_A = 0 ! NSV_ELECBEG_A...NSV_ELECEND_A
+!
+INTEGER,DIMENSION(JPMODELMAX)::NSV_CHEM_A = 0 ! number of chemical scalar
+INTEGER,DIMENSION(JPMODELMAX)::NSV_CHEMBEG_A = 0 ! with indices in the range :
+INTEGER,DIMENSION(JPMODELMAX)::NSV_CHEMEND_A = 0 ! NSV_CHEMBEG_A...NSV_CHEMEND_A
+!
+INTEGER,DIMENSION(JPMODELMAX)::NSV_CHGS_A = 0 ! number of gaseous chemcial species
+INTEGER,DIMENSION(JPMODELMAX)::NSV_CHGSBEG_A = 0 ! with indices
+INTEGER,DIMENSION(JPMODELMAX)::NSV_CHGSEND_A = 0 ! NSV_CHGSBEG_
+!
+INTEGER,DIMENSION(JPMODELMAX)::NSV_CHAC_A = 0 ! number of aqueous chemical species
+INTEGER,DIMENSION(JPMODELMAX)::NSV_CHACBEG_A = 0 ! with indices
+INTEGER,DIMENSION(JPMODELMAX)::NSV_CHACEND_A = 0 ! NSV_CHACBEG
+!
+INTEGER,DIMENSION(JPMODELMAX)::NSV_CHIC_A = 0 ! number of ice phase chemical species
+INTEGER,DIMENSION(JPMODELMAX)::NSV_CHICBEG_A = 0 ! with indices
+INTEGER,DIMENSION(JPMODELMAX)::NSV_CHICEND_A = 0 ! NSV_CHICBEG
+!
+INTEGER,DIMENSION(JPMODELMAX)::NSV_LG_A = 0 ! number of LaGrangian
+INTEGER,DIMENSION(JPMODELMAX)::NSV_LGBEG_A = 0 ! with indices in the range :
+INTEGER,DIMENSION(JPMODELMAX)::NSV_LGEND_A = 0 ! NSV_LGBEG_A...NSV_LGEND_A
+!
+INTEGER,DIMENSION(JPMODELMAX)::NSV_LNOX_A = 0 ! number of lightning NOx
+INTEGER,DIMENSION(JPMODELMAX)::NSV_LNOXBEG_A = 0 ! with indices in the range :
+INTEGER,DIMENSION(JPMODELMAX)::NSV_LNOXEND_A = 0 ! NSV_LNOXBEG_A...NSV_LNOXEND_A
+INTEGER,DIMENSION(JPMODELMAX)::NSV_DST_A = 0 ! number of dust scalar
+INTEGER,DIMENSION(JPMODELMAX)::NSV_DSTBEG_A = 0 ! with indices in the range :
+INTEGER,DIMENSION(JPMODELMAX)::NSV_DSTEND_A = 0 ! NSV_DSTBEG_A...NSV_DSTEND_A
+!
+INTEGER,DIMENSION(JPMODELMAX)::NSV_SLT_A = 0 ! number of sea salt scalar
+INTEGER,DIMENSION(JPMODELMAX)::NSV_SLTBEG_A = 0 ! with indices in the range :
+INTEGER,DIMENSION(JPMODELMAX)::NSV_SLTEND_A = 0 ! NSV_SLTBEG_A...NSV_SLTEND_A
+!
+INTEGER,DIMENSION(JPMODELMAX)::NSV_AER_A = 0 ! number of aerosol scalar
+INTEGER,DIMENSION(JPMODELMAX)::NSV_AERBEG_A = 0 ! with indices in the range :
+INTEGER,DIMENSION(JPMODELMAX)::NSV_AEREND_A = 0 ! NSV_AERBEG_A...NSV_AEREND_A
+!
+INTEGER,DIMENSION(JPMODELMAX)::NSV_DSTDEP_A = 0 ! number of aerosol scalar
+INTEGER,DIMENSION(JPMODELMAX)::NSV_DSTDEPBEG_A = 0 ! with indices in the range :
+INTEGER,DIMENSION(JPMODELMAX)::NSV_DSTDEPEND_A = 0 ! NSV_AERBEG_A...NSV_AEREND_A
+!
+INTEGER,DIMENSION(JPMODELMAX)::NSV_AERDEP_A = 0 ! number of aerosol scalar
+INTEGER,DIMENSION(JPMODELMAX)::NSV_AERDEPBEG_A = 0 ! with indices in the range :
+INTEGER,DIMENSION(JPMODELMAX)::NSV_AERDEPEND_A = 0 ! NSV_AERBEG_A...NSV_AEREND_A
+!
+INTEGER,DIMENSION(JPMODELMAX)::NSV_SLTDEP_A = 0 ! number of aerosol scalar
+INTEGER,DIMENSION(JPMODELMAX)::NSV_SLTDEPBEG_A = 0 ! with indices in the range :
+INTEGER,DIMENSION(JPMODELMAX)::NSV_SLTDEPEND_A = 0 ! NSV_SLTBEG_A...NSV_SLTEND_A
+!
+INTEGER,DIMENSION(JPMODELMAX)::NSV_PP_A = 0 ! number of passive pol.
+INTEGER,DIMENSION(JPMODELMAX)::NSV_PPBEG_A = 0 ! with indices in the range :
+INTEGER,DIMENSION(JPMODELMAX)::NSV_PPEND_A = 0 ! NSV_PPBEG_A...NSV_PPEND_A
+!
+INTEGER,DIMENSION(JPMODELMAX)::NSV_CS_A = 0 ! number of condit.samplings
+INTEGER,DIMENSION(JPMODELMAX)::NSV_CSBEG_A = 0 ! with indices in the range :
+INTEGER,DIMENSION(JPMODELMAX)::NSV_CSEND_A = 0 ! NSV_CSBEG_A...NSV_CSEND_A
+!
+INTEGER,DIMENSION(JPMODELMAX)::NSV_LIMA_A = 0 ! number of scalar in LIMA
+INTEGER,DIMENSION(JPMODELMAX)::NSV_LIMA_BEG_A = 0 ! with indices in the range :
+INTEGER,DIMENSION(JPMODELMAX)::NSV_LIMA_END_A = 0 ! NSV_LIMA_BEG_A...NSV_LIMA_END_A
+INTEGER,DIMENSION(JPMODELMAX)::NSV_LIMA_NC_A = 0 ! First Nc variable
+INTEGER,DIMENSION(JPMODELMAX)::NSV_LIMA_NR_A = 0 ! First Nr variable
+INTEGER,DIMENSION(JPMODELMAX)::NSV_LIMA_CCN_FREE_A = 0 ! First Free CCN conc.
+INTEGER,DIMENSION(JPMODELMAX)::NSV_LIMA_CCN_ACTI_A = 0 ! First Acti. CNN conc.
+INTEGER,DIMENSION(JPMODELMAX)::NSV_LIMA_SCAVMASS_A = 0 ! Scavenged mass variable
+INTEGER,DIMENSION(JPMODELMAX)::NSV_LIMA_NI_A = 0 ! First Ni var.
+INTEGER,DIMENSION(JPMODELMAX)::NSV_LIMA_NS_A = 0 ! First Ns var.
+INTEGER,DIMENSION(JPMODELMAX)::NSV_LIMA_NG_A = 0 ! First Ng var.
+INTEGER,DIMENSION(JPMODELMAX)::NSV_LIMA_NH_A = 0 ! First Nh var.
+INTEGER,DIMENSION(JPMODELMAX)::NSV_LIMA_IFN_FREE_A = 0 ! First Free IFN conc.
+INTEGER,DIMENSION(JPMODELMAX)::NSV_LIMA_IFN_NUCL_A = 0 ! First Nucl. IFN conc.
+INTEGER,DIMENSION(JPMODELMAX)::NSV_LIMA_IMM_NUCL_A = 0 ! First Nucl. IMM conc.
+INTEGER,DIMENSION(JPMODELMAX)::NSV_LIMA_HOM_HAZE_A = 0 ! Hom. freezing of CCN
+INTEGER,DIMENSION(JPMODELMAX)::NSV_LIMA_SPRO_A = 0 ! Supersaturation
+!
+#ifdef MNH_FOREFIRE
+INTEGER,DIMENSION(JPMODELMAX)::NSV_FF_A = 0 ! number of ForeFire scalar variables
+INTEGER,DIMENSION(JPMODELMAX)::NSV_FFBEG_A = 0 ! with indices in the range :
+INTEGER,DIMENSION(JPMODELMAX)::NSV_FFEND_A = 0 ! NSV_FFBEG_A...NSV_FFEND_A
+!
+#endif
+! Blaze smoke indexes
+INTEGER,DIMENSION(JPMODELMAX)::NSV_FIRE_A = 0 ! number of Blaze smoke scalar variables
+INTEGER,DIMENSION(JPMODELMAX)::NSV_FIREBEG_A = 0 ! with indices in the range :
+INTEGER,DIMENSION(JPMODELMAX)::NSV_FIREEND_A = 0 ! NSV_FIREBEG_A...NSV_FIREEND_A
+!
+INTEGER,DIMENSION(JPMODELMAX)::NSV_SNW_A = 0 ! number of blowing snow scalar
+INTEGER,DIMENSION(JPMODELMAX)::NSV_SNWBEG_A = 0 ! with indices in the range :
+INTEGER,DIMENSION(JPMODELMAX)::NSV_SNWEND_A = 0 ! NSV_SNWBEG_A...NSV_SNWEND_A
+!
+!###############################################################################
+!
+! variables updated for the current model
+!
+CHARACTER(LEN=NMNHNAMELGTMAX), DIMENSION(:), POINTER :: CSV_CHEM_LIST !Names of all the chemical variables
+TYPE(tfieldmetadata), DIMENSION(:), POINTER :: TSVLIST !Metadata of all the scalar variables
+
+CHARACTER(LEN=6), DIMENSION(:), ALLOCATABLE :: CSV ! name of the scalar variables
+
+INTEGER :: NSV = 0 ! total number of user scalar variables
+!
+INTEGER :: NSV_CHEM_LIST = 0 ! total number of chemical variables (including dust, salt...)
+!
+INTEGER :: NSV_USER = 0 ! number of user scalar variables with indices
+ ! in the range : 1...NSV_USER
+INTEGER :: NSV_C2R2 = 0 ! number of liq scalar used in C2R2 and in C3R5
+INTEGER :: NSV_C2R2BEG = 0 ! with indices in the range :
+INTEGER :: NSV_C2R2END = 0 ! NSV_C2R2BEG...NSV_C2R2END
+!
+INTEGER :: NSV_C1R3 = 0 ! number of ice scalar used in C3R5
+INTEGER :: NSV_C1R3BEG = 0 ! with indices in the range :
+INTEGER :: NSV_C1R3END = 0 ! NSV_C1R3BEG...NSV_C1R3END
+!
+INTEGER :: NSV_ELEC = 0 ! number of scalar variables used in ELEC
+INTEGER :: NSV_ELECBEG = 0 ! with indices in the range :
+INTEGER :: NSV_ELECEND = 0 ! NSV_ELECBEG...NSV_ELECEND
+!
+INTEGER :: NSV_CHEM = 0 ! number of chemical scalar variables
+INTEGER :: NSV_CHEMBEG = 0 ! with indices in the range :
+INTEGER :: NSV_CHEMEND = 0 ! NSV_CHEMBEG...NSV_CHEMEND
+!
+INTEGER :: NSV_CHGS = 0 ! number of gas-phase chemicals
+INTEGER :: NSV_CHGSBEG = 0 ! with indices in the range :
+INTEGER :: NSV_CHGSEND = 0 ! NSV_CHGSBEG...NSV_CHGSEND
+!
+INTEGER :: NSV_CHAC = 0 ! number of aqueous-phase chemicals
+INTEGER :: NSV_CHACBEG = 0 ! with indices in the range :
+INTEGER :: NSV_CHACEND = 0 ! NSV_CHACBEG...NSV_CHACEND
+!
+INTEGER :: NSV_CHIC = 0 ! number of ice-phase chemicals
+INTEGER :: NSV_CHICBEG = 0 ! with indices in the range :
+INTEGER :: NSV_CHICEND = 0 ! NSV_CHICBEG...NSV_CHICEND
+!
+INTEGER :: NSV_LG = 0 ! number of lagrangian
+INTEGER :: NSV_LGBEG = 0 ! with indices in the range :
+INTEGER :: NSV_LGEND = 0 ! NSV_LGBEG...NSV_LGEND
+!
+INTEGER :: NSV_LNOX = 0 ! number of lightning NOx variables
+INTEGER :: NSV_LNOXBEG = 0 ! with indices in the range :
+INTEGER :: NSV_LNOXEND = 0 ! NSV_LNOXBEG...NSV_LNOXEND
+!
+INTEGER :: NSV_DST = 0 ! number of dust scalar variables
+INTEGER :: NSV_DSTBEG = 0 ! with indices in the range :
+INTEGER :: NSV_DSTEND = 0 ! NSV_DSTBEG...NSV_DSTEND
+
+INTEGER :: NSV_SLT = 0 ! number of sea salt scalar variables
+INTEGER :: NSV_SLTBEG = 0 ! with indices in the range :
+INTEGER :: NSV_SLTEND = 0 ! NSV_SLTBEG...NSV_SLTEND
+
+INTEGER :: NSV_AER = 0 ! number of aerosol scalar variables
+INTEGER :: NSV_AERBEG = 0 ! with indices in the range :
+INTEGER :: NSV_AEREND = 0 ! NSV_AERBEG...NSV_AEREND
+
+INTEGER :: NSV_DSTDEP = 0 ! number of aerosol scalar variables
+INTEGER :: NSV_DSTDEPBEG = 0 ! with indices in the range :
+INTEGER :: NSV_DSTDEPEND = 0 ! NSV_AERBEG...NSV_AEREND
+!
+INTEGER :: NSV_AERDEP = 0 ! number of aerosol scalar variables
+INTEGER :: NSV_AERDEPBEG = 0 ! with indices in the range :
+INTEGER :: NSV_AERDEPEND = 0 ! NSV_AERBEG...NSV_AEREND
+
+INTEGER :: NSV_SLTDEP = 0 ! number of aerosol scalar variables
+INTEGER :: NSV_SLTDEPBEG = 0 ! with indices in the range :
+INTEGER :: NSV_SLTDEPEND = 0 ! NSV_AERBEG...NSV_AEREND
+!
+INTEGER :: NSV_PP = 0 ! number of passive pollutants
+INTEGER :: NSV_PPBEG = 0 ! with indices in the range :
+INTEGER :: NSV_PPEND = 0 ! NSV_PPBEG...NSV_PPEND
+!
+INTEGER :: NSV_CS = 0 ! number of condit.samplings
+INTEGER :: NSV_CSBEG = 0 ! with indices in the range :
+INTEGER :: NSV_CSEND = 0 ! NSV_CSBEG...NSV_CSEND
+!
+INTEGER :: NSV_LIMA ! number of scalar in LIMA
+INTEGER :: NSV_LIMA_BEG ! with indices in the range :
+INTEGER :: NSV_LIMA_END ! NSV_LIMA_BEG_A...NSV_LIMA_END_A
+INTEGER :: NSV_LIMA_NC !
+INTEGER :: NSV_LIMA_NR !
+INTEGER :: NSV_LIMA_CCN_FREE !
+INTEGER :: NSV_LIMA_CCN_ACTI !
+INTEGER :: NSV_LIMA_SCAVMASS !
+INTEGER :: NSV_LIMA_NI !
+INTEGER :: NSV_LIMA_NS !
+INTEGER :: NSV_LIMA_NG !
+INTEGER :: NSV_LIMA_NH !
+INTEGER :: NSV_LIMA_IFN_FREE !
+INTEGER :: NSV_LIMA_IFN_NUCL !
+INTEGER :: NSV_LIMA_IMM_NUCL !
+INTEGER :: NSV_LIMA_HOM_HAZE !
+INTEGER :: NSV_LIMA_SPRO !
+!
+#ifdef MNH_FOREFIRE
+INTEGER :: NSV_FF = 0 ! number of ForeFire scalar variables
+INTEGER :: NSV_FFBEG = 0 ! with indices in the range :
+INTEGER :: NSV_FFEND = 0 ! NSV_FFBEG...NSV_FFEND
+!
+#endif
+! Blaze smoke
+INTEGER :: NSV_FIRE = 0 ! number of Blaze smoke scalar variables
+INTEGER :: NSV_FIREBEG = 0 ! with indices in the range :
+INTEGER :: NSV_FIREEND = 0 ! NSV_FIREBEG...NSV_FIREEND
+!
+INTEGER :: NSV_SNW = 0 ! number of blowing snow scalar variables
+INTEGER :: NSV_SNWBEG = 0 ! with indices in the range :
+INTEGER :: NSV_SNWEND = 0 ! NSV_SNWBEG...NSV_SNWEND
+!
+INTEGER :: NSV_CO2 = 0 ! index for CO2
+!
+END MODULE MODD_NSV
diff --git a/src/PHYEX/aux/mode_budget_phy.f90 b/src/PHYEX/aux/mode_budget_phy.f90
new file mode 100644
index 0000000000000000000000000000000000000000..04a610d2066ab9f38f9879b3edc31c62c38bfdb7
--- /dev/null
+++ b/src/PHYEX/aux/mode_budget_phy.f90
@@ -0,0 +1,62 @@
+!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! Modifications
+! P. Wautelet 28/01/2020: new SUBROUTINEs: Budget_store_init, Budget_store_end and Budget_source_id_find in new module mode_budget
+! P. Wautelet 17/08/2020: treat LES budgets correctly
+! P. Wautelet 05/03/2021: measure cpu_time for budgets
+!-----------------------------------------------------------------
+
+!#################
+MODULE MODE_BUDGET_PHY
+!#################
+
+USE MODD_BUDGET, ONLY: TBUDGETDATA
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+
+IMPLICIT NONE
+
+PRIVATE
+
+PUBLIC :: Budget_store_init_phy
+PUBLIC :: Budget_store_end_phy
+PUBLIC :: Budget_store_add_phy
+
+CONTAINS
+
+SUBROUTINE Budget_store_init_phy(D, tpbudget, hsource, pvars)
+ USE MODE_BUDGET, ONLY: BUDGET_STORE_INIT
+ TYPE(DIMPHYEX_t), INTENT(IN) :: D
+ type(tbudgetdata), intent(inout) :: tpbudget ! Budget datastructure
+ character(len=*), intent(in) :: hsource ! Name of the source term
+ real, dimension(D%NIT,D%NJT,D%NKT), intent(in) :: pvars ! Current value to be stored
+!
+ CALL Budget_store_init(tpbudget, hsource, pvars)
+!
+END SUBROUTINE Budget_store_init_phy
+!
+SUBROUTINE Budget_store_end_phy(D, tpbudget, hsource, pvars)
+ USE MODE_BUDGET, ONLY: BUDGET_STORE_END
+ TYPE(DIMPHYEX_t), INTENT(IN) :: D
+ type(tbudgetdata), intent(inout) :: tpbudget ! Budget datastructure
+ character(len=*), intent(in) :: hsource ! Name of the source term
+ real, dimension(D%NIT,D%NJT,D%NKT), intent(in) :: pvars ! Current value to be stored
+!
+ CALL Budget_store_end(tpbudget, hsource, pvars)
+!
+END SUBROUTINE Budget_store_end_phy
+!
+SUBROUTINE Budget_store_add_phy(D, tpbudget, hsource, pvars)
+ USE MODE_BUDGET, ONLY: BUDGET_STORE_ADD
+ TYPE(DIMPHYEX_t), INTENT(IN) :: D
+ type(tbudgetdata), intent(inout) :: tpbudget ! Budget datastructure
+ character(len=*), intent(in) :: hsource ! Name of the source term
+ real, dimension(D%NIT,D%NJT,D%NKT), intent(in) :: pvars ! Current value to be stored
+!
+ CALL Budget_store_add(tpbudget, hsource, pvars)
+!
+END SUBROUTINE Budget_store_add_phy
+!
+END MODULE MODE_BUDGET_PHY
diff --git a/src/PHYEX/aux/gradient_m_phy.f90 b/src/PHYEX/aux/mode_gradient_m_phy.f90
similarity index 99%
rename from src/PHYEX/aux/gradient_m_phy.f90
rename to src/PHYEX/aux/mode_gradient_m_phy.f90
index 348dea22e2e0f2301f5b7e15a5ad8dd6bb750b48..6f3c34f01c872849d90154f8b73a90b649854bd3 100644
--- a/src/PHYEX/aux/gradient_m_phy.f90
+++ b/src/PHYEX/aux/mode_gradient_m_phy.f90
@@ -166,7 +166,7 @@ SUBROUTINE GX_M_M_PHY(D,OFLAT,PA,PDXX,PDZZ,PDZX,PGX_M_M)
!
!
USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
-USE SHUMAN_PHY, ONLY: DXF_PHY, MZF_PHY, DZM_PHY, MXF_PHY, MXM_PHY
+USE MODE_SHUMAN_PHY, ONLY: DXF_PHY, MZF_PHY, DZM_PHY, MXF_PHY, MXM_PHY
!
IMPLICIT NONE
!
@@ -290,7 +290,7 @@ END SUBROUTINE GX_M_M_PHY
!
!
USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
-USE SHUMAN_PHY, ONLY: DYF_PHY, MZF_PHY, DZM_PHY, MYF_PHY, MYM_PHY
+USE MODE_SHUMAN_PHY, ONLY: DYF_PHY, MZF_PHY, DZM_PHY, MYF_PHY, MYM_PHY
!
IMPLICIT NONE
!
diff --git a/src/PHYEX/aux/gradient_u_phy.f90 b/src/PHYEX/aux/mode_gradient_u_phy.f90
similarity index 98%
rename from src/PHYEX/aux/gradient_u_phy.f90
rename to src/PHYEX/aux/mode_gradient_u_phy.f90
index ff685a0c1319532998fddd9a0051fd17dd1fc4eb..f66dfeff79fac30aeabb45fe0d91866866caa170 100644
--- a/src/PHYEX/aux/gradient_u_phy.f90
+++ b/src/PHYEX/aux/mode_gradient_u_phy.f90
@@ -53,7 +53,7 @@ CONTAINS
!* 0. DECLARATIONS
!
!
-USE SHUMAN_PHY, ONLY : DZM_PHY, MXM_PHY
+USE MODE_SHUMAN_PHY, ONLY : DZM_PHY, MXM_PHY
USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
!
IMPLICIT NONE
@@ -158,7 +158,7 @@ END SUBROUTINE GZ_U_UW_PHY
!* 0. DECLARATIONS
!
!
-USE SHUMAN_PHY, ONLY : DZM_PHY, DXF_PHY, MXF_PHY, MZF_PHY
+USE MODE_SHUMAN_PHY, ONLY : DZM_PHY, DXF_PHY, MXF_PHY, MZF_PHY
USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
!
IMPLICIT NONE
diff --git a/src/PHYEX/aux/gradient_v_phy.f90 b/src/PHYEX/aux/mode_gradient_v_phy.f90
similarity index 98%
rename from src/PHYEX/aux/gradient_v_phy.f90
rename to src/PHYEX/aux/mode_gradient_v_phy.f90
index 66ec0b4ca7708bd3dffd385752e336a49910f9d6..0e29c0064d67e01b07396f7c7e544ae9968592b6 100644
--- a/src/PHYEX/aux/gradient_v_phy.f90
+++ b/src/PHYEX/aux/mode_gradient_v_phy.f90
@@ -54,7 +54,7 @@ CONTAINS
!* 0. DECLARATIONS
!
!
-USE SHUMAN_PHY, ONLY : DZM_PHY, MYM_PHY
+USE MODE_SHUMAN_PHY, ONLY : DZM_PHY, MYM_PHY
USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
!
IMPLICIT NONE
@@ -154,7 +154,7 @@ END SUBROUTINE GZ_V_VW_PHY
!* 0. DECLARATIONS
!
!
-USE SHUMAN_PHY, ONLY : DZM_PHY, DYF_PHY, MYF_PHY, MZF_PHY
+USE MODE_SHUMAN_PHY, ONLY : DZM_PHY, DYF_PHY, MYF_PHY, MZF_PHY
USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
!
IMPLICIT NONE
diff --git a/src/PHYEX/aux/gradient_w_phy.f90 b/src/PHYEX/aux/mode_gradient_w_phy.f90
similarity index 98%
rename from src/PHYEX/aux/gradient_w_phy.f90
rename to src/PHYEX/aux/mode_gradient_w_phy.f90
index 0377f0991ceffd5f90533f5af1091b9bc653dc36..0f8db721bfbc5be4d986dd23373fb00eb0f36b2f 100644
--- a/src/PHYEX/aux/gradient_w_phy.f90
+++ b/src/PHYEX/aux/mode_gradient_w_phy.f90
@@ -50,7 +50,7 @@ CONTAINS
!* 0. DECLARATIONS
!
!
-USE SHUMAN_PHY, ONLY: MZF_PHY, DZF_PHY, MXM_PHY, DXM_PHY, MZM_PHY, DZM_PHY
+USE MODE_SHUMAN_PHY, ONLY: MZF_PHY, DZF_PHY, MXM_PHY, DXM_PHY, MZM_PHY, DZM_PHY
USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
!
IMPLICIT NONE
@@ -162,7 +162,7 @@ END SUBROUTINE GX_W_UW_PHY
!* 0. DECLARATIONS
!
!
-USE SHUMAN_PHY, ONLY: MZF_PHY, DZF_PHY, MYM_PHY, DYM_PHY, MZM_PHY, DZM_PHY
+USE MODE_SHUMAN_PHY, ONLY: MZF_PHY, DZF_PHY, MYM_PHY, DYM_PHY, MZM_PHY, DZM_PHY
USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
!
IMPLICIT NONE
@@ -280,7 +280,7 @@ END SUBROUTINE GY_W_VW_PHY
!* 0. DECLARATIONS
!
!
-USE SHUMAN_PHY, ONLY: MZF_PHY, DZF_PHY
+USE MODE_SHUMAN_PHY, ONLY: MZF_PHY, DZF_PHY
USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
!
IMPLICIT NONE
diff --git a/src/PHYEX/aux/mode_io_field_write_phy.f90 b/src/PHYEX/aux/mode_io_field_write_phy.f90
new file mode 100644
index 0000000000000000000000000000000000000000..785677a4a967a515e81bfa2ff8360deed6c0f115
--- /dev/null
+++ b/src/PHYEX/aux/mode_io_field_write_phy.f90
@@ -0,0 +1,93 @@
+!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.
+!-----------------------------------------------------------------
+! Modifications:
+! Q.Rodier 02/2023 Creation call to mode_io_field_write inside PHYEX
+!-----------------------------------------------------------------
+!
+MODULE MODE_IO_FIELD_WRITE_PHY
+ USE MODD_IO, ONLY: TFILEDATA
+ USE MODD_FIELD, ONLY: TFIELDMETADATA
+ IMPLICIT NONE
+ INTERFACE IO_Field_write_phy
+ MODULE PROCEDURE IO_Field_write_phy_byfield_X2, IO_Field_write_phy_byfield_X1
+ END INTERFACE
+CONTAINS
+ SUBROUTINE IO_Field_write_phy_byfield_X2(D, TPFILE, TPFIELD, PFIELD, KRESP, koffset )
+ USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+ !
+ IMPLICIT NONE
+ !
+ !* 0.1 Declarations of arguments
+ !
+ TYPE(DIMPHYEX_t), INTENT(IN) :: D
+ TYPE(TFILEDATA), INTENT(IN) :: TPFILE
+ TYPE(TFIELDMETADATA), INTENT(IN) :: TPFIELD
+ REAL,DIMENSION(D%NIJT,D%NKT),TARGET, INTENT(IN) :: PFIELD ! array containing the data field
+ INTEGER, OPTIONAL, INTENT(OUT) :: KRESP ! return-code
+ integer, dimension(3), optional, intent(in) :: koffset
+ !
+ CALL IO_Field_write_phy_unpack2D(D,TPFILE, TPFIELD, PFIELD, KRESP, koffset )
+ !
+ END SUBROUTINE IO_Field_write_phy_byfield_X2
+!
+ SUBROUTINE IO_Field_write_phy_unpack2D(D, TPFILE, TPFIELD, PFIELD, KRESP, koffset )
+ USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+ USE MODE_IO_FIELD_WRITE, ONLY: IO_Field_write
+ !
+ IMPLICIT NONE
+ !
+ !* 0.1 Declarations of arguments
+ !
+ TYPE(DIMPHYEX_t), INTENT(IN) :: D
+ TYPE(TFILEDATA), INTENT(IN) :: TPFILE
+ TYPE(TFIELDMETADATA), INTENT(IN) :: TPFIELD
+ REAL,DIMENSION(D%NIT,D%NJT,D%NKT),TARGET, INTENT(IN) :: PFIELD ! array containing the data field
+ INTEGER, OPTIONAL, INTENT(OUT) :: KRESP ! return-code
+ integer, dimension(3), optional, intent(in) :: koffset
+ !
+ CALL IO_Field_write(TPFILE, TPFIELD, PFIELD, KRESP, koffset )
+ !
+ END SUBROUTINE IO_Field_write_phy_unpack2D
+!
+ SUBROUTINE IO_Field_write_phy_byfield_X1(D, TPFILE, TPFIELD, PFIELD, KRESP, koffset )
+ USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+ !
+ IMPLICIT NONE
+ !
+ !* 0.1 Declarations of arguments
+ !
+ TYPE(DIMPHYEX_t), INTENT(IN) :: D
+ TYPE(TFILEDATA), INTENT(IN) :: TPFILE
+ TYPE(TFIELDMETADATA), INTENT(IN) :: TPFIELD
+ REAL,DIMENSION(D%NIJT),TARGET, INTENT(IN) :: PFIELD ! array containing the data field
+ INTEGER, OPTIONAL, INTENT(OUT) :: KRESP ! return-code
+ integer, dimension(3), optional, intent(in) :: koffset
+ !
+ CALL IO_Field_write_phy_unpack1D(D,TPFILE, TPFIELD, PFIELD, KRESP, koffset )
+ !
+ END SUBROUTINE IO_Field_write_phy_byfield_X1
+!
+ SUBROUTINE IO_Field_write_phy_unpack1D(D, TPFILE, TPFIELD, PFIELD, KRESP, koffset )
+ USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+ USE MODE_IO_FIELD_WRITE, ONLY: IO_Field_write
+ !
+ IMPLICIT NONE
+ !
+ !* 0.1 Declarations of arguments
+ !
+ TYPE(DIMPHYEX_t), INTENT(IN) :: D
+ TYPE(TFILEDATA), INTENT(IN) :: TPFILE
+ TYPE(TFIELDMETADATA), INTENT(IN) :: TPFIELD
+ REAL,DIMENSION(D%NIT,D%NJT),TARGET, INTENT(IN) :: PFIELD ! array containing the data field
+ INTEGER, OPTIONAL, INTENT(OUT) :: KRESP ! return-code
+ integer, dimension(3), optional, intent(in) :: koffset
+ !
+ CALL IO_Field_write(TPFILE, TPFIELD, PFIELD, KRESP, koffset )
+ !
+ END SUBROUTINE IO_Field_write_phy_unpack1D
+!
+!
+END MODULE MODE_IO_FIELD_WRITE_PHY
diff --git a/src/PHYEX/aux/modi_gradient_u.f90 b/src/PHYEX/aux/modi_gradient_u.f90
deleted file mode 100644
index 14de7c2623bc70f52b55b78f400e6a07e190f312..0000000000000000000000000000000000000000
--- a/src/PHYEX/aux/modi_gradient_u.f90
+++ /dev/null
@@ -1,53 +0,0 @@
-!MNH_LIC Copyright 1994-2020 CNRS, Meteo-France and Universite Paul Sabatier
-!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!MNH_LIC for details. version 1.
-!-----------------------------------------------------------------
-! ######################
- MODULE MODI_GRADIENT_U
-! ######################
-!
-INTERFACE
-!
-!
-FUNCTION GX_U_M(PA,PDXX,PDZZ,PDZX, KKA, KKU, KL) RESULT(PGX_U_M)
-INTEGER, INTENT(IN),OPTIONAL :: KKA, KKU ! near ground and uppest atmosphere array indexes
-INTEGER, INTENT(IN),OPTIONAL :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the U point
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX ! metric coefficient dxx
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZX ! metric coefficient dzx
-!
-REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PGX_U_M ! result mass point
-!
-END FUNCTION GX_U_M
-!
-!
-FUNCTION GY_U_UV(PA,PDYY,PDZZ,PDZY, KKA, KKU, KL) RESULT(PGY_U_UV)
-!
-INTEGER, INTENT(IN),OPTIONAL :: KKA, KKU ! near ground and uppest atmosphere array indexes
-INTEGER, INTENT(IN),OPTIONAL :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the U point
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDYY ! metric coefficient dyy
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZY ! metric coefficient dzy
-!
-REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PGY_U_UV ! result UV point
-!
-END FUNCTION GY_U_UV
-!
-!
-FUNCTION GZ_U_UW(PA,PDZZ, KKA, KKU, KL) RESULT(PGZ_U_UW)
-!
-INTEGER, INTENT(IN),OPTIONAL :: KKA, KKU ! near ground and uppest atmosphere array indexes
-INTEGER, INTENT(IN),OPTIONAL :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the U point
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
-!
-REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PGZ_U_UW ! result UW point
-!
-END FUNCTION GZ_U_UW
-!
-END INTERFACE
-!
-END MODULE MODI_GRADIENT_U
diff --git a/src/PHYEX/aux/modi_gradient_v.f90 b/src/PHYEX/aux/modi_gradient_v.f90
deleted file mode 100644
index 406ff5450e3b23da921a0bf128899818bb6fc3d4..0000000000000000000000000000000000000000
--- a/src/PHYEX/aux/modi_gradient_v.f90
+++ /dev/null
@@ -1,54 +0,0 @@
-!MNH_LIC Copyright 1994-2020 CNRS, Meteo-France and Universite Paul Sabatier
-!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!MNH_LIC for details. version 1.
-!-----------------------------------------------------------------
-! ######################
- MODULE MODI_GRADIENT_V
-! ######################
-!
-INTERFACE
-!
-!
-FUNCTION GY_V_M(PA,PDYY,PDZZ,PDZY, KKA, KKU, KL) RESULT(PGY_V_M)
-!
-INTEGER, INTENT(IN),OPTIONAL :: KKA, KKU ! near ground and uppest atmosphere array indexes
-INTEGER, INTENT(IN),OPTIONAL :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the V point
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDYY ! metric coefficient dyy
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZY ! metric coefficient dzy
-!
-REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PGY_V_M ! result mass point
-!
-END FUNCTION GY_V_M
-!
-FUNCTION GX_V_UV(PA,PDXX,PDZZ,PDZX, KKA, KKU, KL) RESULT(PGX_V_UV)
-!
-INTEGER, INTENT(IN),OPTIONAL :: KKA, KKU ! near ground and uppest atmosphere array indexes
-INTEGER, INTENT(IN),OPTIONAL :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the V point
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX ! metric coefficient dxx
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZX ! metric coefficient dzx
-!
-REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PGX_V_UV ! result UV point
-!
-END FUNCTION GX_V_UV
-!
-!
-FUNCTION GZ_V_VW(PA,PDZZ, KKA, KKU, KL) RESULT(PGZ_V_VW)
-!
-INTEGER, INTENT(IN),OPTIONAL :: KKA, KKU ! near ground and uppest atmosphere array indexes
-INTEGER, INTENT(IN),OPTIONAL :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the V point
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
-!
-REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PGZ_V_VW ! result VW point
-!
-END FUNCTION GZ_V_VW
-!
-!
-END INTERFACE
-!
-END MODULE MODI_GRADIENT_V
diff --git a/src/PHYEX/aux/modi_gradient_w.f90 b/src/PHYEX/aux/modi_gradient_w.f90
deleted file mode 100644
index a277d269440d717c9eca7a8971c24627fbfc016a..0000000000000000000000000000000000000000
--- a/src/PHYEX/aux/modi_gradient_w.f90
+++ /dev/null
@@ -1,54 +0,0 @@
-!MNH_LIC Copyright 1994-2020 CNRS, Meteo-France and Universite Paul Sabatier
-!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!MNH_LIC for details. version 1.
-!-----------------------------------------------------------------
-! ######################
- MODULE MODI_GRADIENT_W
-! ######################
-!
-INTERFACE
-!
-!
-FUNCTION GZ_W_M(PA,PDZZ, KKA, KKU, KL) RESULT(PGZ_W_M)
-!
-INTEGER, INTENT(IN),OPTIONAL :: KKA, KKU ! near ground and uppest atmosphere array indexes
-INTEGER, INTENT(IN),OPTIONAL :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the W point
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
-!
-REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PGZ_W_M ! result mass point
-!
-END FUNCTION GZ_W_M
-!
-FUNCTION GX_W_UW(PA,PDXX,PDZZ,PDZX, KKA, KKU, KL) RESULT(PGX_W_UW)
-!
-INTEGER, INTENT(IN),OPTIONAL :: KKA, KKU ! near ground and uppest atmosphere array indexes
-INTEGER, INTENT(IN),OPTIONAL :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the W point
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX ! metric coefficient dxx
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZX ! metric coefficient dzx
-!
-REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PGX_W_UW ! result UW point
-!
-END FUNCTION GX_W_UW
-!
-!
-FUNCTION GY_W_VW(PA,PDYY,PDZZ,PDZY, KKA, KKU, KL) RESULT(PGY_W_VW)
-!
-INTEGER, INTENT(IN),OPTIONAL :: KKA, KKU ! near ground and uppest atmosphere array indexes
-INTEGER, INTENT(IN),OPTIONAL :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the W point
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDYY ! metric coefficient dyy
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZY ! metric coefficient dzy
-!
-REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PGY_W_VW ! result VW point
-!
-END FUNCTION GY_W_VW
-!
-!
-END INTERFACE
-!
-END MODULE MODI_GRADIENT_W
diff --git a/src/PHYEX/aux/sources_neg_correct.f90 b/src/PHYEX/aux/sources_neg_correct.f90
index a1e83273438f5385109ad6a35844d083b44317ca..0302839408bb4045ae0b78adc29bdc812452c071 100644
--- a/src/PHYEX/aux/sources_neg_correct.f90
+++ b/src/PHYEX/aux/sources_neg_correct.f90
@@ -53,7 +53,7 @@ use modd_budget, only: lbudget_th, lbudget_rv, lbudget_rc, lbudget_rr, lbudg
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_param_lima, only: lcold_lima => lcold, lrain_lima => lrain, lspro_lima => lspro, lwarm_lima => lwarm, &
+use modd_param_lima, only: lspro_lima => lspro, &
xctmin_lima => xctmin, xrtmin_lima => xrtmin
use mode_budget, only: Budget_store_init, Budget_store_end
diff --git a/src/PHYEX/ext/boundaries.f90 b/src/PHYEX/ext/boundaries.f90
new file mode 100644
index 0000000000000000000000000000000000000000..111dbc701d5c112ccc4d00cbf6331afb089f129c
--- /dev/null
+++ b/src/PHYEX/ext/boundaries.f90
@@ -0,0 +1,1281 @@
+!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+!#####################
+MODULE MODI_BOUNDARIES
+!#####################
+!
+INTERFACE
+!
+ SUBROUTINE BOUNDARIES ( &
+ PTSTEP,HLBCX,HLBCY,KRR,KSV,KTCOUNT, &
+ PLBXUM,PLBXVM,PLBXWM,PLBXTHM,PLBXTKEM,PLBXRM,PLBXSVM, &
+ PLBYUM,PLBYVM,PLBYWM,PLBYTHM,PLBYTKEM,PLBYRM,PLBYSVM, &
+ PLBXUS,PLBXVS,PLBXWS,PLBXTHS,PLBXTKES,PLBXRS,PLBXSVS, &
+ PLBYUS,PLBYVS,PLBYWS,PLBYTHS,PLBYTKES,PLBYRS,PLBYSVS, &
+ PRHODJ,PRHODREF, &
+ PUT,PVT,PWT,PTHT,PTKET,PRT,PSVT,PSRCT )
+!
+REAL, INTENT(IN) :: PTSTEP ! time step dt
+CHARACTER(LEN=4), DIMENSION(2), INTENT(IN) :: HLBCX,HLBCY ! X and Y-direc. LBC type
+!
+INTEGER, INTENT(IN) :: KRR ! Number of moist variables
+INTEGER, INTENT(IN) :: KSV ! Number of Scalar Variables
+INTEGER, INTENT(IN) :: KTCOUNT ! Temporal loop COUNTer
+ ! (=1 at the segment beginning)
+!
+! Lateral Boundary fields at time t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLBXUM,PLBXVM,PLBXWM ! Wind
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLBXTHM ! Mass
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLBYUM,PLBYVM,PLBYWM ! Wind
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLBYTHM ! Mass
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLBXTKEM ! TKE
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLBYTKEM
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PLBXRM ,PLBXSVM ! Moisture and SV
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PLBYRM ,PLBYSVM ! in x and y-dir.
+! temporal derivative of the Lateral Boundary fields
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLBXUS,PLBXVS,PLBXWS ! Wind
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLBXTHS ! Mass
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLBYUS,PLBYVS,PLBYWS ! Wind
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLBYTHS ! Mass
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLBXTKES ! TKE
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLBYTKES
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PLBXRS ,PLBXSVS ! Moisture and SV
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PLBYRS ,PLBYSVS ! in x and y-dir.
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Jacobian * dry density of
+ ! the reference state
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PUT,PVT,PWT,PTHT,PTKET,PSRCT
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRT,PSVT
+ ! Variables at t
+!
+END SUBROUTINE BOUNDARIES
+!
+END INTERFACE
+!
+
+END MODULE MODI_BOUNDARIES
+!
+!
+! ####################################################################
+ SUBROUTINE BOUNDARIES ( &
+ PTSTEP,HLBCX,HLBCY,KRR,KSV,KTCOUNT, &
+ PLBXUM,PLBXVM,PLBXWM,PLBXTHM,PLBXTKEM,PLBXRM,PLBXSVM, &
+ PLBYUM,PLBYVM,PLBYWM,PLBYTHM,PLBYTKEM,PLBYRM,PLBYSVM, &
+ PLBXUS,PLBXVS,PLBXWS,PLBXTHS,PLBXTKES,PLBXRS,PLBXSVS, &
+ PLBYUS,PLBYVS,PLBYWS,PLBYTHS,PLBYTKES,PLBYRS,PLBYSVS, &
+ PRHODJ,PRHODREF, &
+ PUT,PVT,PWT,PTHT,PTKET,PRT,PSVT,PSRCT )
+! ####################################################################
+!
+!!**** *BOUNDARIES* - routine to prepare the Lateral Boundary Conditions for
+!! all variables at a scalar localization relative to the
+!! considered boundary.
+!!
+!! PURPOSE
+!! -------
+! Fill up the left and right lateral EXTernal zones, for all prognostic
+! variables, at time t and t-dt, to avoid particular cases close to
+! the Lateral Boundaries in routines computing the evolution terms, in
+! particular in the advection routines.
+!
+!!** METHOD
+!! ------
+!! 3 different options are proposed: 'WALL' 'CYCL' 'OPEN'
+!! to define the Boundary Condition type,
+!! though the variables HLBCX and HLBCY (for the X and Y-directions
+!! respectively).
+!! For the 'OPEN' type of LBC, the treatment depends
+!! on the flow configuration: i.e. INFLOW or OUTFLOW conditions.
+!!
+!! EXTERNAL
+!! --------
+!! GET_INDICE_ll : get physical sub-domain bounds
+!! LWEAST_ll,LEAST_ll,LNORTH_ll,LSOUTH_ll : position functions
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_PARAMETERS :
+!! JPHEXT ,JPVEXT
+!!
+!! Module MODD_CONF :
+!! CCONF
+!!
+!! Module MODE_UPDATE_NSV :
+!! NSV_CHEM, NSV_CHEMBEG, NSV_CHEMEND
+!!
+!! Module MODD_CTURB :
+!! XTKEMIN
+!!
+!! REFERENCE
+!! ---------
+!! Book1 and book2 of documentation (routine BOUNDARIES)
+!!
+!! AUTHOR
+!! ------
+!! J.-P. Lafore J. Stein * Meteo France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 17/10/94
+!! Modification 02/11/94 (J.Stein) copy for t-dt at the external points
+!! + change the copy formulation
+!! Modification 18/11/94 (J.Stein) bug correction in the normal velocity
+!! prescription in the WALL cases
+!! Modification 13/02/95 (Lafore) to account for the OPEN case and
+!! for the LS fields introduction
+!! Modification 03/03/95 (Mallet) corrections in variables names in
+!! the Y-OPEN case
+!! 16/03/95 (J.Stein) remove R from the historical variables
+!! Modification 31/05/95 (Lafore) MASTER_DEV2.1 preparation after the
+!! LBC tests performed by I. Mallet
+!! Modification 15/03/96 (Richard) bug correction for OPEN CASE: (TOP Y-LBC)
+!! Rv case
+!! Modification 15/03/96 (Shure) bug correction for SV variable in
+!! open x right case
+!! Modification 24/10/96 (Masson) initialization of outer points in
+!! wall cases for spawning interpolations
+!! Modification 13/03/97 (Lafore) "surfacic" LS-fields introduction
+!! Modification 10/04/97 (Lafore) proper treatment of minima for TKE and EPS
+!! Modification 01/09/97 (Masson) minimum value for water and passive
+!! scalars set to zero at instants M,T
+!! Modification 20/10/97 (Lafore) introduction of DAVI type of lbc
+!! suppression of NEST type
+!! Modification 12/11/97 ( Stein ) use the lB fields
+!! Modification 02/06/98 (Lafore) declaration of local variables (PLBXUM
+!! and PLBXWM do'nt have the same size)
+!! Modification 24/08/98 (Jabouille) parallelize the code
+!! Modification 20/04/99 ( Stein ) use the same conditions for times t
+!! and t-dt
+!! Modification 11/04/00 (Mari) special conditions for chemical variables
+!! Modification 10/01/01 (Tulet) update for MOCAGE boundary conditions
+!! Modification 22/01/01 (Gazen) use NSV_CHEM,NSV_CHEMBEG,NSV_CHEMEND variables
+!! Modification 22/06/01(Jabouille) use XSVMIN
+!! Modification 20/11/01(Gazen & Escobar) rewrite GCHBOUNDARY for portability
+!! Modification 14/03/05 (Tulet) bug : in case of CYCL do not call ch_boundaries
+!! Modification 14/05/05 (Tulet) add aerosols / dust
+!! Modification 05/06 Suppression of DAVI type of lbc
+!! Modification 05/06 Remove EPS
+!! Modification 12/2010 (Chong) Add boundary condition for ions
+!! (fair weather profiles)
+!! Modification 07/2013 (Bosseur & Filippi) adds Forefire
+!! Modification 04/2013 (C.Lac) Remove instant M
+!! Modification 01/2015 (JL Redelsperger) Introduction of ponderation
+!! for non normal velocity and potential temp
+!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
+!! Redelsperger & Pianezze : 08/2015 : add XPOND coefficient
+!! Modification 01/2016 (JP Pinty) Add LIMA that is LBC for CCN and IFN
+!! Modification 18/07/17 (Vionnet) Add blowing snow variables
+!! Modification 01/2018 (JL Redelsperger) Correction for TKE treatment
+!! Modification 03/02/2020 (B. Vié) Correction for SV with LIMA
+! P. Wautelet 04/06/2020: correct call to Set_conc_lima
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+!
+USE MODD_BLOWSNOW, ONLY : LBLOWSNOW,NBLOWSNOW_2D
+USE MODD_BLOWSNOW_n
+USE MODD_CH_AEROSOL , ONLY : LORILAM
+USE MODD_CH_MNHC_n, ONLY : LUSECHEM, LUSECHIC
+USE MODD_CONDSAMP, ONLY : LCONDSAMP
+USE MODD_CONF
+USE MODD_CTURB
+USE MODD_DUST
+USE MODD_GRID_n, ONLY : XZZ
+USE MODD_ELEC_DESCR
+USE MODD_ELEC_n
+#ifdef MNH_FOREFIRE
+USE MODD_FOREFIRE, ONLY : LFOREFIRE
+#endif
+USE MODD_LBC_n, ONLY : XPOND
+USE MODE_ll
+USE MODD_NESTING, ONLY : NDAD
+USE MODD_NSV
+USE MODD_PARAMETERS
+USE MODD_PARAM_LIMA, ONLY : NMOD_CCN, NMOD_IFN, LBOUND
+USE MODD_PARAM_n, ONLY : CELEC,CCLOUD
+USE MODD_PASPOL, ONLY : LPASPOL
+USE MODD_PRECISION, ONLY: MNHREAL32
+USE MODD_REF_n
+USE MODD_SALT, ONLY : LSALT
+
+USE MODE_MODELN_HANDLER
+USE MODE_SET_CONC_LIMA
+
+USE MODI_CH_BOUNDARIES
+USE MODI_INIT_AEROSOL_CONCENTRATION
+USE MODI_ION_BOUNDARIES
+
+IMPLICIT NONE
+!
+!
+!* 0.1 declarations of arguments
+!
+!
+!
+!
+REAL, INTENT(IN) :: PTSTEP ! time step dt
+CHARACTER(LEN=4), DIMENSION(2), INTENT(IN) :: HLBCX,HLBCY ! X and Y-direc. LBC type
+!
+INTEGER, INTENT(IN) :: KRR ! Number of moist variables
+INTEGER, INTENT(IN) :: KSV ! Number of Scalar Variables
+INTEGER, INTENT(IN) :: KTCOUNT ! Temporal loop COUNTer
+ ! (=1 at the segment beginning)
+!
+! Lateral Boundary fields at time t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLBXUM,PLBXVM,PLBXWM ! Wind
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLBXTHM ! Mass
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLBYUM,PLBYVM,PLBYWM ! Wind
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLBYTHM ! Mass
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLBXTKEM ! TKE
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLBYTKEM
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PLBXRM ,PLBXSVM ! Moisture and SV
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PLBYRM ,PLBYSVM ! in x and y-dir.
+! temporal derivative of the Lateral Boundary fields
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLBXUS,PLBXVS,PLBXWS ! Wind
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLBXTHS ! Mass
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLBYUS,PLBYVS,PLBYWS ! Wind
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLBYTHS ! Mass
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLBXTKES ! TKE
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLBYTKES
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PLBXRS ,PLBXSVS ! Moisture and SV
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PLBYRS ,PLBYSVS ! in x and y-dir.
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Jacobian * dry density of
+ ! the reference state
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PUT,PVT,PWT,PTHT,PTKET,PSRCT
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRT,PSVT
+ ! Variables at t
+!
+!* 0.2 declarations of local variables
+!
+INTEGER :: IIB ! indice I Beginning in x direction
+INTEGER :: IJB ! indice J Beginning in y direction
+INTEGER :: IKB ! indice K Beginning in z direction
+INTEGER :: IIE ! indice I End in x direction
+INTEGER :: IJE ! indice J End in y direction
+INTEGER :: IKE ! indice K End in z direction
+INTEGER :: JEXT ! Loop index for EXTernal points
+INTEGER :: JRR ! Loop index for RR variables (water)
+INTEGER :: JSV ! Loop index for Scalar Variables
+INTEGER :: IMI ! Model Index
+REAL :: ZTSTEP ! effective time step
+REAL :: ZPOND ! Coeff PONDERATION LS
+INTEGER :: ILBX,ILBY ! size of LB fields' arrays
+LOGICAL, SAVE, DIMENSION(:), ALLOCATABLE :: GCHBOUNDARY, GAERBOUNDARY,&
+ GDSTBOUNDARY, GSLTBOUNDARY, GPPBOUNDARY, &
+ GCSBOUNDARY, GICBOUNDARY, GLIMABOUNDARY,GSNWBOUNDARY
+LOGICAL, SAVE :: GFIRSTCALL1 = .TRUE.
+LOGICAL, SAVE :: GFIRSTCALL2 = .TRUE.
+LOGICAL, SAVE :: GFIRSTCALL3 = .TRUE.
+LOGICAL, SAVE :: GFIRSTCALL5 = .TRUE.
+LOGICAL, SAVE :: GFIRSTCALLPP = .TRUE.
+LOGICAL, SAVE :: GFIRSTCALLCS = .TRUE.
+LOGICAL, SAVE :: GFIRSTCALLIC = .TRUE.
+LOGICAL, SAVE :: GFIRSTCALLLIMA = .TRUE.
+!
+REAL, DIMENSION(SIZE(PLBXWM,1),SIZE(PLBXWM,2),SIZE(PLBXWM,3)) :: &
+ ZLBXVT,ZLBXWT,ZLBXTHT
+REAL, DIMENSION(SIZE(PLBYWM,1),SIZE(PLBYWM,2),SIZE(PLBYWM,3)) :: &
+ ZLBYUT,ZLBYWT,ZLBYTHT
+REAL, DIMENSION(SIZE(PLBXTKEM,1),SIZE(PLBXTKEM,2),SIZE(PLBXTKEM,3)) :: &
+ ZLBXTKET
+REAL, DIMENSION(SIZE(PLBYTKEM,1),SIZE(PLBYTKEM,2),SIZE(PLBYTKEM,3)) :: &
+ ZLBYTKET
+REAL, DIMENSION(SIZE(PLBXRM,1),SIZE(PLBXRM,2),SIZE(PLBXRM,3),SIZE(PLBXRM,4)) :: &
+ ZLBXRT
+REAL, DIMENSION(SIZE(PLBYRM,1),SIZE(PLBYRM,2),SIZE(PLBYRM,3),SIZE(PLBYRM,4)) :: &
+ ZLBYRT
+REAL, DIMENSION(SIZE(PLBXSVM,1),SIZE(PLBXSVM,2),SIZE(PLBXSVM,3),SIZE(PLBXSVM,4)) :: &
+ ZLBXSVT
+REAL, DIMENSION(SIZE(PLBYSVM,1),SIZE(PLBYSVM,2),SIZE(PLBYSVM,3),SIZE(PLBYSVM,4)) :: &
+ ZLBYSVT
+LOGICAL :: GCHTMP
+LOGICAL :: GPPTMP
+LOGICAL :: GCSTMP
+!
+LOGICAL, SAVE :: GFIRSTCALL4 = .TRUE.
+!
+#ifdef MNH_FOREFIRE
+LOGICAL, SAVE, DIMENSION(:), ALLOCATABLE :: GFFBOUNDARY
+LOGICAL, SAVE :: GFIRSTCALLFF = .TRUE.
+LOGICAL :: GFFTMP
+#endif
+!
+INTEGER :: JI,JJ
+!
+REAL, DIMENSION(SIZE(PSVT,1),SIZE(PSVT,2),SIZE(PSVT,3),SIZE(PSVT,4)) :: ZSVT
+REAL, DIMENSION(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3),SIZE(PRT,4)) :: ZRT
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. COMPUTE DIMENSIONS OF ARRAYS AND OTHER INDICES:
+! ----------------------------------------------
+CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
+IKB = 1 + JPVEXT
+IKE = SIZE(PUT,3) - JPVEXT
+IMI = GET_CURRENT_MODEL_INDEX()
+!
+!-------------------------------------------------------------------------------
+!
+!* 2. UPPER AND LOWER BC FILLING:
+! ---------------------------
+!
+!* 2.1 COMPUTE THE FIELD EXTRAPOLATIONS AT THE GROUND
+!
+
+!
+! at the instant t
+!
+IF(SIZE(PUT) /= 0) PUT (:,:,IKB-1) = PUT (:,:,IKB)
+IF(SIZE(PVT) /= 0) PVT (:,:,IKB-1) = PVT (:,:,IKB)
+IF(SIZE(PWT) /= 0) PWT (:,:,IKB-1) = PWT (:,:,IKB)
+IF(SIZE(PTHT) /= 0) PTHT (:,:,IKB-1) = PTHT (:,:,IKB)
+IF(SIZE(PTKET) /= 0) PTKET(:,:,IKB-1) = PTKET(:,:,IKB)
+IF(SIZE(PRT) /= 0) PRT (:,:,IKB-1,:)= PRT (:,:,IKB,:)
+IF(SIZE(PSVT)/= 0) PSVT (:,:,IKB-1,:)= PSVT (:,:,IKB,:)
+IF(SIZE(PSRCT) /= 0) PSRCT(:,:,IKB-1) = PSRCT(:,:,IKB)
+!
+!
+!* 2.2 COMPUTE THE FIELD EXTRAPOLATIONS AT THE TOP
+!
+! at the instant t
+!
+IF(SIZE(PWT) /= 0) PWT (:,:,IKE+1) = 0.
+IF(SIZE(PUT) /= 0) PUT (:,:,IKE+1) = PUT (:,:,IKE)
+IF(SIZE(PVT) /= 0) PVT (:,:,IKE+1) = PVT (:,:,IKE)
+IF(SIZE(PTHT) /= 0) PTHT (:,:,IKE+1) = PTHT (:,:,IKE)
+IF(SIZE(PTKET) /= 0) PTKET(:,:,IKE+1) = PTKET(:,:,IKE)
+IF(SIZE(PRT) /= 0) PRT (:,:,IKE+1,:) = PRT (:,:,IKE,:)
+IF(SIZE(PSVT)/= 0) PSVT (:,:,IKE+1,:) = PSVT (:,:,IKE,:)
+IF(SIZE(PSRCT) /= 0) PSRCT(:,:,IKE+1) = PSRCT(:,:,IKE)
+
+! specific for positive and negative ions mixing ratios (1/kg)
+
+IF (NSV_ELEC .NE. 0) THEN
+!
+ IF (SIZE(PWT) /= 0) THEN
+ WHERE ( PWT(:,:,IKE+1) .GE. 0.) ! Outflow
+ PSVT (:,:,IKE+1,NSV_ELECBEG) = 2.*PSVT (:,:,IKE,NSV_ELECBEG) - &
+ PSVT (:,:,IKE-1,NSV_ELECBEG)
+ PSVT (:,:,IKE+1,NSV_ELECEND) = 2.*PSVT (:,:,IKE,NSV_ELECEND) - &
+ PSVT (:,:,IKE-1,NSV_ELECEND)
+ ELSE WHERE ! Inflow from the top
+ PSVT (:,:,IKE+1,NSV_ELECBEG) = XCION_POS_FW(:,:,IKE+1)
+ PSVT (:,:,IKE+1,NSV_ELECEND) = XCION_NEG_FW(:,:,IKE+1)
+ END WHERE
+ ENDIF
+!
+END IF
+
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 3. COMPUTE LB FIELDS AT TIME T
+! ---------------------------
+!
+!
+IF ( KTCOUNT == 1) THEN
+ ZTSTEP = 0.
+ELSE
+ ZTSTEP = PTSTEP
+END IF
+!
+!
+IF ( SIZE(PLBXTHS,1) /= 0 .AND. &
+ ( HLBCX(1)=='OPEN' .OR. HLBCX(2)=='OPEN') ) THEN
+ ZLBXVT(:,:,:) = PLBXVM(:,:,:) + ZTSTEP * PLBXVS(:,:,:)
+ ZLBXWT(:,:,:) = PLBXWM(:,:,:) + ZTSTEP * PLBXWS(:,:,:)
+ ZLBXTHT(:,:,:) = PLBXTHM(:,:,:) + ZTSTEP * PLBXTHS(:,:,:)
+ IF ( SIZE(PTKET,1) /= 0 ) THEN
+ ZLBXTKET(:,:,:) = PLBXTKEM(:,:,:) + ZTSTEP * PLBXTKES(:,:,:)
+ END IF
+ IF ( KRR > 0) THEN
+ ZLBXRT(:,:,:,:) = PLBXRM(:,:,:,:) + ZTSTEP * PLBXRS(:,:,:,:)
+ END IF
+ IF ( KSV > 0) THEN
+ ZLBXSVT(:,:,:,:) = PLBXSVM(:,:,:,:) + ZTSTEP * PLBXSVS(:,:,:,:)
+ END IF
+!
+ELSE
+!
+ ZLBXVT(:,:,:) = PLBXVM(:,:,:)
+ ZLBXWT(:,:,:) = PLBXWM(:,:,:)
+ ZLBXTHT(:,:,:) = PLBXTHM(:,:,:)
+ IF ( SIZE(PTKET,1) /= 0 ) THEN
+ ZLBXTKET(:,:,:) = PLBXTKEM(:,:,:)
+ END IF
+ IF ( KRR > 0) THEN
+ ZLBXRT(:,:,:,:) = PLBXRM(:,:,:,:)
+ END IF
+ IF ( KSV > 0) THEN
+ ZLBXSVT(:,:,:,:) = PLBXSVM(:,:,:,:)
+ END IF
+!
+END IF
+!
+! ============================================================
+!
+! Reproductibility for RSTART -> truncate ZLB to real(knd=4) to have reproductible result
+!
+ZLBXVT(:,:,:) = real(ZLBXVT(:,:,:),kind=MNHREAL32)
+ZLBXWT(:,:,:) = real(ZLBXWT(:,:,:),kind=MNHREAL32)
+ZLBXTHT(:,:,:) = real(ZLBXTHT(:,:,:),kind=MNHREAL32)
+IF ( SIZE(PTKET,1) /= 0 ) THEN
+ ZLBXTKET(:,:,:) = real(ZLBXTKET(:,:,:),kind=MNHREAL32)
+END IF
+IF ( KRR > 0) THEN
+ ZLBXRT(:,:,:,:) = real(ZLBXRT(:,:,:,:),kind=MNHREAL32)
+END IF
+IF ( KSV > 0) THEN
+ ZLBXSVT(:,:,:,:) = real(ZLBXSVT(:,:,:,:),kind=MNHREAL32)
+END IF
+! ============================================================
+!
+IF ( SIZE(PLBYTHS,1) /= 0 .AND. &
+ ( HLBCY(1)=='OPEN' .OR. HLBCY(2)=='OPEN' )) THEN
+ ZLBYUT(:,:,:) = PLBYUM(:,:,:) + ZTSTEP * PLBYUS(:,:,:)
+ ZLBYWT(:,:,:) = PLBYWM(:,:,:) + ZTSTEP * PLBYWS(:,:,:)
+ ZLBYTHT(:,:,:) = PLBYTHM(:,:,:) + ZTSTEP * PLBYTHS(:,:,:)
+ IF ( SIZE(PTKET,1) /= 0 ) THEN
+ ZLBYTKET(:,:,:) = PLBYTKEM(:,:,:) + ZTSTEP * PLBYTKES(:,:,:)
+ END IF
+ IF ( KRR > 0) THEN
+ ZLBYRT(:,:,:,:) = PLBYRM(:,:,:,:) + ZTSTEP * PLBYRS(:,:,:,:)
+ END IF
+ IF ( KSV > 0) THEN
+ ZLBYSVT(:,:,:,:) = PLBYSVM(:,:,:,:) + ZTSTEP * PLBYSVS(:,:,:,:)
+ END IF
+!
+ELSE
+!
+ ZLBYUT(:,:,:) = PLBYUM(:,:,:)
+ ZLBYWT(:,:,:) = PLBYWM(:,:,:)
+ ZLBYTHT(:,:,:) = PLBYTHM(:,:,:)
+ IF ( SIZE(PTKET,1) /= 0 ) THEN
+ ZLBYTKET(:,:,:) = PLBYTKEM(:,:,:)
+ END IF
+ IF ( KRR > 0) THEN
+ ZLBYRT(:,:,:,:) = PLBYRM(:,:,:,:)
+ END IF
+ IF ( KSV > 0) THEN
+ ZLBYSVT(:,:,:,:) = PLBYSVM(:,:,:,:)
+ END IF
+!
+END IF
+!
+!
+! ============================================================
+!
+! Reproductibility for RSTART -> truncate ZLB to real(knd=4) to have reproductible result
+!
+ZLBYUT(:,:,:) = real(ZLBYUT(:,:,:),kind=MNHREAL32)
+ZLBYWT(:,:,:) = real(ZLBYWT(:,:,:),kind=MNHREAL32)
+ZLBYTHT(:,:,:) = real(ZLBYTHT(:,:,:),kind=MNHREAL32)
+IF ( SIZE(PTKET,1) /= 0 ) THEN
+ ZLBYTKET(:,:,:) = real(ZLBYTKET(:,:,:),kind=MNHREAL32)
+END IF
+IF ( KRR > 0) THEN
+ ZLBYRT(:,:,:,:) = real(ZLBYRT(:,:,:,:),kind=MNHREAL32)
+END IF
+IF ( KSV > 0) THEN
+ ZLBYSVT(:,:,:,:) = real(ZLBYSVT(:,:,:,:),kind=MNHREAL32)
+END IF
+! ============================================================
+!
+!-------------------------------------------------------------------------------
+! PONDERATION COEFF for Non-Normal velocities and pot temperature
+!
+ZPOND = XPOND
+!
+!* 4. LBC FILLING IN THE X DIRECTION (LEFT WEST SIDE):
+! ------------------------------------------------
+IF (LWEST_ll( )) THEN
+!
+!
+SELECT CASE ( HLBCX(1) )
+!
+!* 4.1 WALL CASE:
+! =========
+!
+ CASE ('WALL')
+!
+ DO JEXT=1,JPHEXT
+ IF(SIZE(PUT) /= 0) PUT (IIB-JEXT,:,:) = PUT (IIB ,:,:) ! never used during run
+ IF(SIZE(PVT) /= 0) PVT (IIB-JEXT,:,:) = PVT (IIB-1+JEXT,:,:)
+ IF(SIZE(PWT) /= 0) PWT (IIB-JEXT,:,:) = PWT (IIB-1+JEXT,:,:)
+ IF(SIZE(PTHT) /= 0) PTHT(IIB-JEXT,:,:) = PTHT (IIB-1+JEXT,:,:)
+ IF(SIZE(PTKET)/= 0) PTKET(IIB-JEXT,:,:) = PTKET(IIB-1+JEXT,:,:)
+ IF(SIZE(PRT) /= 0) PRT (IIB-JEXT,:,:,:) = PRT (IIB-1+JEXT,:,:,:)
+ IF(SIZE(PSVT) /= 0) PSVT(IIB-JEXT,:,:,:) = PSVT (IIB-1+JEXT,:,:,:)
+ IF(SIZE(PSRCT) /= 0) PSRCT (IIB-JEXT,:,:) = PSRCT (IIB-1+JEXT,:,:)
+ IF(LBLOWSNOW) XSNWCANO(IIB-JEXT,:,:) = XSNWCANO(IIB-1+JEXT,:,:)
+!
+ END DO
+!
+ IF(SIZE(PUT) /= 0) PUT(IIB ,:,:) = 0. ! set the normal velocity
+!
+!
+!* 4.2 OPEN CASE:
+! =========
+!
+ CASE ('OPEN')
+!
+ IF(SIZE(PUT) /= 0) THEN
+ DO JI=JPHEXT,1,-1
+ PUT(JI,:,:)=0.
+ WHERE ( PUT(IIB,:,:) <= 0. ) ! OUTFLOW condition
+ PVT (JI,:,:) = 2.*PVT (JI+1,:,:) -PVT (JI+2,:,:)
+ PWT (JI,:,:) = 2.*PWT (JI+1,:,:) -PWT (JI+2,:,:)
+ PTHT (JI,:,:) = 2.*PTHT (JI+1,:,:) -PTHT (JI+2,:,:)
+ !
+ ELSEWHERE ! INFLOW condition
+ PVT (JI,:,:) = ZPOND*ZLBXVT (JI,:,:) + (1.-ZPOND)* PVT(JI+1,:,:) ! 1
+ PWT (JI,:,:) = ZPOND*ZLBXWT (JI,:,:) + (1.-ZPOND)* PWT(JI+1,:,:) ! 1
+ PTHT (JI,:,:) = ZPOND*ZLBXTHT (JI,:,:) + (1.-ZPOND)* PTHT(JI+1,:,:)! 1
+ ENDWHERE
+ ENDDO
+ ENDIF
+!
+!
+ IF(SIZE(PTKET) /= 0) THEN
+ DO JI=JPHEXT,1,-1
+ WHERE ( PUT(IIB,:,:) <= 0. ) ! OUTFLOW condition
+ PTKET(JI,:,:) = MAX(XTKEMIN, 2.*PTKET(JI+1,:,:)-PTKET(JI+2,:,:))
+ ELSEWHERE ! INFLOW condition
+ PTKET(JI,:,:) = MAX(XTKEMIN, ZPOND*ZLBXTKET(JI,:,:) + (1.-ZPOND)*PTKET(JI+1,:,:))
+ ENDWHERE
+ ENDDO
+ END IF
+ !
+! Case with KRR moist variables
+!
+!
+!
+ DO JRR =1 ,KRR
+ IF(SIZE(PUT) /= 0) THEN
+ DO JI=JPHEXT,1,-1
+ WHERE ( PUT(IIB,:,:) <= 0. ) ! OUTFLOW condition
+ PRT(JI,:,:,JRR) = MAX(0.,2.*PRT(JI+1,:,:,JRR) -PRT(JI+2,:,:,JRR))
+ ELSEWHERE ! INFLOW condition
+ PRT(JI,:,:,JRR) = MAX(0.,ZLBXRT(JI,:,:,JRR)) ! 1
+ END WHERE
+ END DO
+ END IF
+ !
+ END DO
+!
+ IF(SIZE(PSRCT) /= 0) THEN
+ DO JI=JPHEXT,1,-1
+ PSRCT (JI,:,:) = PSRCT (JI+1,:,:)
+ END DO
+ END IF
+!
+! Case with KSV scalar variables
+ DO JSV=1 ,KSV
+ IF(SIZE(PUT) /= 0) THEN
+ DO JI=JPHEXT,1,-1
+ WHERE ( PUT(IIB,:,:) <= 0. ) ! OUTFLOW condition
+ PSVT(JI,:,:,JSV) = MAX(XSVMIN(JSV),2.*PSVT(JI+1,:,:,JSV) - &
+ PSVT(JI+2,:,:,JSV))
+ ELSEWHERE ! INFLOW condition
+ PSVT(JI,:,:,JSV) = MAX(XSVMIN(JSV),ZLBXSVT(JI,:,:,JSV)) ! 1
+ END WHERE
+ END DO
+ END IF
+ !
+ END DO
+ !
+ IF(LBLOWSNOW) THEN
+ DO JSV=1 ,NBLOWSNOW_2D
+ WHERE ( PUT(IIB,:,IKB) <= 0. ) ! OUTFLOW condition
+ XSNWCANO(IIB-1,:,JSV) = MAX(0.,2.*XSNWCANO(IIB,:,JSV) - &
+ XSNWCANO(IIB+1,:,JSV))
+ ELSEWHERE ! INFLOW condition
+ XSNWCANO(IIB-1,:,JSV) = 0. ! Assume no snow enter throug
+ ! boundaries
+ END WHERE
+ END DO
+ DO JSV=NSV_SNWBEG ,NSV_SNWEND
+ IF(SIZE(PUT) /= 0) THEN
+ WHERE ( PUT(IIB,:,:) <= 0. ) ! OUTFLOW condition
+ PSVT(IIB-1,:,:,JSV) = MAX(0.,2.*PSVT(IIB,:,:,JSV) - &
+ PSVT(IIB+1,:,:,JSV))
+ ELSEWHERE ! INFLOW condition
+ PSVT(IIB-1,:,:,JSV) = 0. ! Assume no snow enter throug
+ ! boundaries
+ END WHERE
+ END IF
+ !
+ END DO
+ ENDIF
+!
+!
+END SELECT
+!
+END IF
+!-------------------------------------------------------------------------------
+!
+!* 5 LBC FILLING IN THE X DIRECTION (RIGHT EAST SIDE):
+! ===============--------------------------------
+!
+IF (LEAST_ll( )) THEN
+!
+SELECT CASE ( HLBCX(2) )
+!
+!* 5.1 WALL CASE:
+! =========
+!
+ CASE ('WALL')
+!
+ DO JEXT=1,JPHEXT
+ IF(SIZE(PUT) /= 0) PUT (IIE+JEXT,:,:) = PUT (IIE ,:,:) ! never used during run
+ IF(SIZE(PVT) /= 0) PVT (IIE+JEXT,:,:) = PVT (IIE+1-JEXT,:,:)
+ IF(SIZE(PWT) /= 0) PWT (IIE+JEXT,:,:) = PWT (IIE+1-JEXT,:,:)
+ IF(SIZE(PTHT) /= 0) PTHT (IIE+JEXT,:,:) = PTHT (IIE+1-JEXT,:,:)
+ IF(SIZE(PTKET) /= 0) PTKET(IIE+JEXT,:,:) = PTKET(IIE+1-JEXT,:,:)
+ IF(SIZE(PRT) /= 0) PRT (IIE+JEXT,:,:,:) = PRT (IIE+1-JEXT,:,:,:)
+ IF(SIZE(PSVT) /= 0) PSVT(IIE+JEXT,:,:,:) = PSVT (IIE+1-JEXT,:,:,:)
+ IF(SIZE(PSRCT) /= 0) PSRCT (IIE+JEXT,:,:)= PSRCT (IIE+1-JEXT,:,:)
+ IF(LBLOWSNOW) XSNWCANO(IIE+JEXT,:,:) = XSNWCANO(IIE+1-JEXT,:,:)
+!
+ END DO
+!
+ IF(SIZE(PUT) /= 0) PUT(IIE+1 ,:,:) = 0. ! set the normal velocity
+!
+!* 5.2 OPEN CASE:
+! =========
+!
+ CASE ('OPEN')
+!
+ ILBX = SIZE(PLBXVM,1)
+ IF(SIZE(PUT) /= 0) THEN
+ DO JI=1,JPHEXT
+ WHERE ( PUT(IIE+1,:,:) >= 0. ) ! OUTFLOW condition
+ PVT (IIE+JI,:,:) = 2.*PVT (IIE+JI-1,:,:) -PVT (IIE+JI-2,:,:)
+ PWT (IIE+JI,:,:) = 2.*PWT (IIE+JI-1,:,:) -PWT (IIE+JI-2,:,:)
+ PTHT (IIE+JI,:,:) = 2.*PTHT (IIE+JI-1,:,:) -PTHT (IIE+JI-2,:,:)
+ !
+ ELSEWHERE ! INFLOW condition
+ PVT (IIE+JI,:,:) = ZPOND*ZLBXVT (ILBX-JPHEXT+JI,:,:) + (1.-ZPOND)* PVT(IIE+JI-1,:,:)
+ PWT (IIE+JI,:,:) = ZPOND*ZLBXWT (ILBX-JPHEXT+JI,:,:) + (1.-ZPOND)* PWT(IIE+JI-1,:,:)
+ PTHT (IIE+JI,:,:) = ZPOND*ZLBXTHT (ILBX-JPHEXT+JI,:,:) + (1.-ZPOND)* PTHT(IIE+JI-1,:,:)
+ ENDWHERE
+ END DO
+ ENDIF
+ !
+ IF(SIZE(PTKET) /= 0) THEN
+ ILBX = SIZE(PLBXTKEM,1)
+ DO JI=1,JPHEXT
+ WHERE ( PUT(IIE+1,:,:) >= 0. ) ! OUTFLOW condition
+ PTKET(IIE+JI,:,:) = MAX(XTKEMIN, 2.*PTKET(IIE+JI-1,:,:)-PTKET(IIE+JI-2,:,:))
+ ELSEWHERE ! INFLOW condition
+ PTKET(IIE+JI,:,:) = MAX(XTKEMIN, ZPOND*ZLBXTKET(ILBX-JPHEXT+JI,:,:) + &
+ (1.-ZPOND)*PTKET(IIE+JI-1,:,:))
+ ENDWHERE
+ END DO
+ END IF
+ !
+!
+! Case with KRR moist variables
+!
+!
+ DO JRR =1 ,KRR
+ ILBX=SIZE(PLBXRM,1)
+ !
+ IF(SIZE(PUT) /= 0) THEN
+ DO JI=1,JPHEXT
+ WHERE ( PUT(IIE+1,:,:) >= 0. ) ! OUTFLOW condition
+ PRT(IIE+JI,:,:,JRR) = MAX(0.,2.*PRT(IIE+JI-1,:,:,JRR) -PRT(IIE+JI-2,:,:,JRR))
+ ELSEWHERE ! INFLOW condition
+ PRT(IIE+JI,:,:,JRR) = MAX(0.,ZLBXRT(ILBX-JPHEXT+JI,:,:,JRR))
+ END WHERE
+ END DO
+ END IF
+ !
+ END DO
+!
+ IF(SIZE(PSRCT) /= 0) THEN
+ DO JI=1,JPHEXT
+ PSRCT (IIE+JI,:,:) = PSRCT (IIE+JI-1,:,:)
+ END DO
+ END IF
+! Case with KSV scalar variables
+ DO JSV=1 ,KSV
+ ILBX=SIZE(PLBXSVM,1)
+ IF(SIZE(PUT) /= 0) THEN
+ DO JI=1,JPHEXT
+ WHERE ( PUT(IIE+1,:,:) >= 0. ) ! OUTFLOW condition
+ PSVT(IIE+JI,:,:,JSV) = MAX(XSVMIN(JSV),2.*PSVT(IIE+JI-1,:,:,JSV) - &
+ PSVT(IIE+JI-2,:,:,JSV))
+ ELSEWHERE ! INFLOW condition
+ PSVT(IIE+JI,:,:,JSV) = MAX(XSVMIN(JSV),ZLBXSVT(ILBX-JPHEXT+JI,:,:,JSV))
+ END WHERE
+ END DO
+ END IF
+ !
+ END DO
+!
+ IF(LBLOWSNOW) THEN
+ DO JSV=1 ,3
+ WHERE ( PUT(IIE+1,:,IKB) >= 0. ) ! OUTFLOW condition
+ XSNWCANO(IIE+1,:,JSV) = MAX(0.,2.*XSNWCANO(IIE,:,JSV) - &
+ XSNWCANO(IIE-1,:,JSV))
+ ELSEWHERE ! INFLOW condition
+ XSNWCANO(IIE+1,:,JSV) = 0. ! Assume no snow enter throug
+ ! boundaries
+ END WHERE
+ END DO
+ DO JSV=NSV_SNWBEG ,NSV_SNWEND
+ IF(SIZE(PUT) /= 0) THEN
+ WHERE ( PUT(IIE+1,:,:) >= 0. ) ! OUTFLOW condition
+ PSVT(IIE+1,:,:,JSV) = MAX(0.,2.*PSVT(IIE,:,:,JSV) - &
+ PSVT(IIE-1,:,:,JSV))
+ ELSEWHERE ! INFLOW condition
+ PSVT(IIE+1,:,:,JSV) = 0. ! Assume no snow enter throug
+ ! boundaries
+ END WHERE
+ END IF
+ !
+ END DO
+ END IF
+!
+END SELECT
+!
+END IF
+!-------------------------------------------------------------------------------
+!
+!* 6. LBC FILLING IN THE Y DIRECTION (BOTTOM SOUTH SIDE):
+! ------------------------------
+IF (LSOUTH_ll( )) THEN
+!
+SELECT CASE ( HLBCY(1) )
+!
+!* 6.1 WALL CASE:
+! =========
+!
+ CASE ('WALL')
+!
+ DO JEXT=1,JPHEXT
+ IF(SIZE(PUT) /= 0) PUT (:,IJB-JEXT,:) = PUT (:,IJB-1+JEXT,:)
+ IF(SIZE(PVT) /= 0) PVT (:,IJB-JEXT,:) = PVT (:,IJB ,:) ! never used during run
+ IF(SIZE(PWT) /= 0) PWT (:,IJB-JEXT,:) = PWT (:,IJB-1+JEXT,:)
+ IF(SIZE(PTHT) /= 0) PTHT (:,IJB-JEXT,:) = PTHT (:,IJB-1+JEXT,:)
+ IF(SIZE(PTKET) /= 0) PTKET(:,IJB-JEXT,:) = PTKET(:,IJB-1+JEXT,:)
+ IF(SIZE(PRT) /= 0) PRT (:,IJB-JEXT,:,:) = PRT (:,IJB-1+JEXT,:,:)
+ IF(SIZE(PSVT) /= 0) PSVT (:,IJB-JEXT,:,:)= PSVT (:,IJB-1+JEXT,:,:)
+ IF(SIZE(PSRCT) /= 0) PSRCT(:,IJB-JEXT,:) = PSRCT(:,IJB-1+JEXT,:)
+ IF(LBLOWSNOW) XSNWCANO(:,IJB-JEXT,:) = XSNWCANO(:,IJB-1+JEXT,:)
+!
+ END DO
+!
+ IF(SIZE(PVT) /= 0) PVT(:,IJB ,:) = 0. ! set the normal velocity
+!
+!* 6.2 OPEN CASE:
+! =========
+!
+ CASE ('OPEN')
+!
+ IF(SIZE(PVT) /= 0) THEN
+ DO JJ=JPHEXT,1,-1
+ PVT(:,JJ,:)=0.
+ WHERE ( PVT(:,IJB,:) <= 0. ) ! OUTFLOW condition
+ PUT (:,JJ,:) = 2.*PUT (:,JJ+1,:) -PUT (:,JJ+2,:)
+ PWT (:,JJ,:) = 2.*PWT (:,JJ+1,:) -PWT (:,JJ+2,:)
+ PTHT (:,JJ,:) = 2.*PTHT (:,JJ+1,:) -PTHT (:,JJ+2,:)
+ ELSEWHERE ! INFLOW condition
+ PUT (:,JJ,:) = ZPOND*ZLBYUT (:,JJ,:) + (1.-ZPOND)* PUT(:,JJ+1,:)
+ PWT (:,JJ,:) = ZPOND*ZLBYWT (:,JJ,:) + (1.-ZPOND)* PWT(:,JJ+1,:)
+ PTHT (:,JJ,:) = ZPOND*ZLBYTHT (:,JJ,:) + (1.-ZPOND)* PTHT(:,JJ+1,:)
+ ENDWHERE
+ END DO
+ ENDIF
+!
+ IF(SIZE(PTKET) /= 0) THEN
+ DO JJ=JPHEXT,1,-1
+ WHERE ( PVT(:,IJB,:) <= 0. ) ! OUTFLOW condition
+ PTKET(:,JJ,:) = MAX(XTKEMIN, 2.*PTKET(:,JJ+1,:)-PTKET(:,JJ+2,:))
+ ELSEWHERE ! INFLOW condition
+ PTKET(:,JJ,:) = MAX(XTKEMIN,ZPOND*ZLBYTKET(:,JJ,:) + &
+ (1.-ZPOND)*PTKET(:,JJ+1,:))
+ ENDWHERE
+ END DO
+ END IF
+ !
+!
+! Case with KRR moist variables
+!
+!
+ DO JRR =1 ,KRR
+ IF(SIZE(PVT) /= 0) THEN
+ DO JJ=JPHEXT,1,-1
+ WHERE ( PVT(:,IJB,:) <= 0. ) ! OUTFLOW condition
+ PRT(:,JJ,:,JRR) = MAX(0.,2.*PRT(:,JJ+1,:,JRR) -PRT(:,JJ+2,:,JRR))
+ ELSEWHERE ! INFLOW condition
+ PRT(:,JJ,:,JRR) = MAX(0.,ZLBYRT(:,JJ,:,JRR))
+ END WHERE
+ END DO
+ END IF
+ !
+ END DO
+!
+ IF(SIZE(PSRCT) /= 0) THEN
+ DO JJ=JPHEXT,1,-1
+ PSRCT(:,JJ,:) = PSRCT(:,JJ+1,:)
+ END DO
+ END IF
+!
+! Case with KSV scalar variables
+!
+ DO JSV=1 ,KSV
+ IF(SIZE(PVT) /= 0) THEN
+ DO JJ=JPHEXT,1,-1
+ WHERE ( PVT(:,IJB,:) <= 0. ) ! OUTFLOW condition
+ PSVT(:,JJ,:,JSV) = MAX(XSVMIN(JSV),2.*PSVT(:,JJ+1,:,JSV) - &
+ PSVT(:,JJ+2,:,JSV))
+ ELSEWHERE ! INFLOW condition
+ PSVT(:,JJ,:,JSV) = MAX(XSVMIN(JSV),ZLBYSVT(:,JJ,:,JSV))
+ END WHERE
+ END DO
+ END IF
+ !
+ END DO
+!
+ IF(LBLOWSNOW) THEN
+ DO JSV=1 ,3
+ WHERE ( PVT(:,IJB,IKB) <= 0. ) ! OUTFLOW condition
+ XSNWCANO(:,IJB-1,JSV) = MAX(0.,2.*XSNWCANO(:,IJB,JSV) - &
+ XSNWCANO(:,IJB+1,JSV))
+ ELSEWHERE ! INFLOW condition
+ XSNWCANO(:,IJB-1,JSV) = 0. ! Assume no snow enter throug
+ ! boundaries
+ END WHERE
+ END DO
+ DO JSV=NSV_SNWBEG ,NSV_SNWEND
+ IF(SIZE(PVT) /= 0) THEN
+ WHERE ( PVT(:,IJB,:) <= 0. ) ! OUTFLOW condition
+ PSVT(:,IJB-1,:,JSV) = MAX(0.,2.*PSVT(:,IJB,:,JSV) - &
+ PSVT(:,IJB+1,:,JSV))
+ ELSEWHERE ! INFLOW condition
+ PSVT(:,IJB-1,:,JSV) = 0. ! Assume no snow enter throug
+ ! boundaries
+ END WHERE
+ END IF
+ !
+ END DO
+ END IF
+!
+!
+END SELECT
+!
+END IF
+!-------------------------------------------------------------------------------
+!
+!* 7. LBC FILLING IN THE Y DIRECTION (TOP NORTH SIDE):
+! ===============
+!
+IF (LNORTH_ll( )) THEN
+!
+SELECT CASE ( HLBCY(2) )
+!
+!* 4.3.1 WALL CASE:
+! =========
+!
+ CASE ('WALL')
+!
+ DO JEXT=1,JPHEXT
+ IF(SIZE(PUT) /= 0) PUT (:,IJE+JEXT,:) = PUT (:,IJE+1-JEXT,:)
+ IF(SIZE(PVT) /= 0) PVT (:,IJE+JEXT,:) = PVT (:,IJE ,:) ! never used during run
+ IF(SIZE(PWT) /= 0) PWT (:,IJE+JEXT,:) = PWT (:,IJE+1-JEXT,:)
+ IF(SIZE(PTHT) /= 0) PTHT (:,IJE+JEXT,:) = PTHT (:,IJE+1-JEXT,:)
+ IF(SIZE(PTKET) /= 0) PTKET(:,IJE+JEXT,:) = PTKET(:,IJE+1-JEXT,:)
+ IF(SIZE(PRT) /= 0) PRT (:,IJE+JEXT,:,:) = PRT (:,IJE+1-JEXT,:,:)
+ IF(SIZE(PSVT) /= 0) PSVT (:,IJE+JEXT,:,:)= PSVT (:,IJE+1-JEXT,:,:)
+ IF(SIZE(PSRCT) /= 0) PSRCT(:,IJE+JEXT,:) = PSRCT(:,IJE+1-JEXT,:)
+ IF(LBLOWSNOW) XSNWCANO(:,IJE+JEXT,:) = XSNWCANO(:,IJE+1-JEXT,:)
+!
+ END DO
+!
+ IF(SIZE(PVT) /= 0) PVT(:,IJE+1 ,:) = 0. ! set the normal velocity
+!
+!* 4.3.2 OPEN CASE:
+! =========
+!
+ CASE ('OPEN')
+!
+!
+ ILBY=SIZE(PLBYUM,2)
+ IF(SIZE(PVT) /= 0) THEN
+ DO JJ=1,JPHEXT
+ WHERE ( PVT(:,IJE+1,:) >= 0. ) ! OUTFLOW condition
+ PUT (:,IJE+JJ,:) = 2.*PUT (:,IJE+JJ-1,:) -PUT (:,IJE+JJ-2,:)
+ PWT (:,IJE+JJ,:) = 2.*PWT (:,IJE+JJ-1,:) -PWT (:,IJE+JJ-2,:)
+ PTHT (:,IJE+JJ,:) = 2.*PTHT (:,IJE+JJ-1,:) -PTHT (:,IJE+JJ-2,:)
+ ELSEWHERE ! INFLOW condition
+ PUT (:,IJE+JJ,:) = ZPOND*ZLBYUT (:,ILBY-JPHEXT+JJ,:) + (1.-ZPOND)* PUT(:,IJE+JJ-1,:)
+ PWT (:,IJE+JJ,:) = ZPOND*ZLBYWT (:,ILBY-JPHEXT+JJ,:) + (1.-ZPOND)* PWT(:,IJE+JJ-1,:)
+ PTHT (:,IJE+JJ,:) = ZPOND*ZLBYTHT (:,ILBY-JPHEXT+JJ,:) + (1.-ZPOND)* PTHT(:,IJE+JJ-1,:)
+ ENDWHERE
+ END DO
+ ENDIF
+!
+ IF(SIZE(PTKET) /= 0) THEN
+ ILBY=SIZE(PLBYTKEM,2)
+ DO JJ=1,JPHEXT
+ WHERE ( PVT(:,IJE+1,:) >= 0. ) ! OUTFLOW condition
+ PTKET(:,IJE+JJ,:) = MAX(XTKEMIN, 2.*PTKET(:,IJE+JJ-1,:)-PTKET(:,IJE+JJ-2,:))
+ ELSEWHERE ! INFLOW condition
+ PTKET(:,IJE+JJ,:) = MAX(XTKEMIN,ZPOND*ZLBYTKET(:,ILBY-JPHEXT+JJ,:) + &
+ (1.-ZPOND)*PTKET(:,IJE+JJ-1,:))
+ ENDWHERE
+ END DO
+ ENDIF
+ !
+! Case with KRR moist variables
+!
+!
+ DO JRR =1 ,KRR
+ ILBY=SIZE(PLBYRM,2)
+ !
+ IF(SIZE(PVT) /= 0) THEN
+ DO JJ=1,JPHEXT
+ WHERE ( PVT(:,IJE+1,:) >= 0. ) ! OUTFLOW condition
+ PRT(:,IJE+JJ,:,JRR) = MAX(0.,2.*PRT(:,IJE+JJ-1,:,JRR) -PRT(:,IJE+JJ-2,:,JRR))
+ ELSEWHERE ! INFLOW condition
+ PRT(:,IJE+JJ,:,JRR) = MAX(0.,ZLBYRT(:,ILBY-JPHEXT+JJ,:,JRR))
+ END WHERE
+ END DO
+ END IF
+ !
+ END DO
+!
+ IF(SIZE(PSRCT) /= 0) THEN
+ DO JJ=1,JPHEXT
+ PSRCT(:,IJE+JJ,:) = PSRCT(:,IJE+JJ-1,:)
+ END DO
+ END IF
+!
+! Case with KSV scalar variables
+ DO JSV=1 ,KSV
+ ILBY=SIZE(PLBYSVM,2)
+ !
+ IF(SIZE(PVT) /= 0) THEN
+ DO JJ=1,JPHEXT
+ WHERE ( PVT(:,IJE+1,:) >= 0. ) ! OUTFLOW condition
+ PSVT(:,IJE+JJ,:,JSV) = MAX(XSVMIN(JSV),2.*PSVT(:,IJE+JJ-1,:,JSV) - &
+ PSVT(:,IJE+JJ-2,:,JSV))
+ ELSEWHERE ! INFLOW condition
+ PSVT(:,IJE+JJ,:,JSV) = MAX(XSVMIN(JSV),ZLBYSVT(:,ILBY-JPHEXT+JJ,:,JSV))
+ END WHERE
+ END DO
+ END IF
+ !
+ END DO
+!
+ IF(LBLOWSNOW) THEN
+ DO JSV=1 ,3
+ WHERE ( PVT(:,IJE+1,IKB) >= 0. ) ! OUTFLOW condition
+ XSNWCANO(:,IJE+1,JSV) = MAX(0.,2.*XSNWCANO(:,IJE,JSV) - &
+ XSNWCANO(:,IJE-1,JSV))
+ ELSEWHERE ! INFLOW condition
+ XSNWCANO(:,IJE+1,JSV) = 0. ! Assume no snow enter throug
+ ! boundaries
+ END WHERE
+ END DO
+ DO JSV=NSV_SNWBEG ,NSV_SNWEND
+ !
+ IF(SIZE(PVT) /= 0) THEN
+ WHERE ( PVT(:,IJE+1,:) >= 0. ) ! OUTFLOW condition
+ PSVT(:,IJE+1,:,JSV) = MAX(0.,2.*PSVT(:,IJE,:,JSV) - &
+ PSVT(:,IJE-1,:,JSV))
+ ELSEWHERE ! INFLOW condition
+ PSVT(:,IJE+1,:,JSV) = 0. ! Assume no snow enter throug
+ ! boundaries
+ END WHERE
+ END IF
+ !
+ END DO
+ ENDIF
+!
+END SELECT
+END IF
+!
+!
+IF (CCLOUD == 'LIMA' .AND. IMI == 1 .AND. CPROGRAM=='MESONH') THEN
+
+ ZSVT=PSVT
+ ZRT=PRT
+
+ IF (GFIRSTCALLLIMA) THEN
+ ALLOCATE(GLIMABOUNDARY(NSV_LIMA))
+ GFIRSTCALLLIMA = .FALSE.
+ DO JSV=NSV_LIMA_BEG,NSV_LIMA_END
+ GCHTMP = .FALSE.
+ IF (LWEST_ll().AND.HLBCX(1)=='OPEN') GCHTMP = GCHTMP .OR. ALL(PLBXSVM(JPHEXT,:,:,JSV)==0)
+ IF (LEAST_ll().AND.HLBCX(2)=='OPEN') GCHTMP = GCHTMP .OR. ALL(PLBXSVM(ILBX-JPHEXT+1,:,:,JSV)==0)
+ IF (LSOUTH_ll().AND.HLBCY(1)=='OPEN') GCHTMP = GCHTMP .OR. ALL(PLBYSVM(:,JPHEXT,:,JSV)==0)
+ IF (LNORTH_ll().AND.HLBCY(2)=='OPEN') GCHTMP = GCHTMP .OR. ALL(PLBYSVM(:,ILBY-JPHEXT+1,:,JSV)==0)
+ GLIMABOUNDARY(JSV-NSV_LIMA_BEG+1) = GCHTMP
+ ENDDO
+ ENDIF
+ CALL INIT_AEROSOL_CONCENTRATION(PRHODREF,ZSVT,XZZ)
+ DO JSV=NSV_LIMA_CCN_FREE,NSV_LIMA_CCN_FREE+NMOD_CCN-1 ! LBC for CCN
+ IF (GLIMABOUNDARY(JSV-NSV_LIMA_BEG+1)) THEN
+ PSVT(IIB-1,:,:,JSV)=ZSVT(IIB-1,:,:,JSV)
+ PSVT(IIE+1,:,:,JSV)=ZSVT(IIE+1,:,:,JSV)
+ PSVT(:,IJB-1,:,JSV)=ZSVT(:,IJB-1,:,JSV)
+ PSVT(:,IJE+1,:,JSV)=ZSVT(:,IJE+1,:,JSV)
+ ENDIF
+ END DO
+ DO JSV=NSV_LIMA_IFN_FREE,NSV_LIMA_IFN_FREE+NMOD_IFN-1 ! LBC for IFN
+ IF (GLIMABOUNDARY(JSV-NSV_LIMA_BEG+1)) THEN
+ PSVT(IIB-1,:,:,JSV)=ZSVT(IIB-1,:,:,JSV)
+ PSVT(IIE+1,:,:,JSV)=ZSVT(IIE+1,:,:,JSV)
+ PSVT(:,IJB-1,:,JSV)=ZSVT(:,IJB-1,:,JSV)
+ PSVT(:,IJE+1,:,JSV)=ZSVT(:,IJE+1,:,JSV)
+ ENDIF
+ END DO
+
+ CALL SET_CONC_LIMA( IMI, 'NONE', PRHODREF, ZRT(:, :, :, :), ZSVT(:, :, :, NSV_LIMA_BEG:NSV_LIMA_END) )
+ IF (NSV_LIMA_NC.GE.1) THEN
+ IF (GLIMABOUNDARY(NSV_LIMA_NC-NSV_LIMA_BEG+1)) THEN
+ PSVT(IIB-1,:,:,NSV_LIMA_NC)=ZSVT(IIB-1,:,:,NSV_LIMA_NC) ! cloud
+ PSVT(IIE+1,:,:,NSV_LIMA_NC)=ZSVT(IIE+1,:,:,NSV_LIMA_NC)
+ PSVT(:,IJB-1,:,NSV_LIMA_NC)=ZSVT(:,IJB-1,:,NSV_LIMA_NC)
+ PSVT(:,IJE+1,:,NSV_LIMA_NC)=ZSVT(:,IJE+1,:,NSV_LIMA_NC)
+ ENDIF
+ ENDIF
+ IF (NSV_LIMA_NR.GE.1) THEN
+ IF (GLIMABOUNDARY(NSV_LIMA_NR-NSV_LIMA_BEG+1)) THEN
+ PSVT(IIB-1,:,:,NSV_LIMA_NR)=ZSVT(IIB-1,:,:,NSV_LIMA_NR) ! rain
+ PSVT(IIE+1,:,:,NSV_LIMA_NR)=ZSVT(IIE+1,:,:,NSV_LIMA_NR)
+ PSVT(:,IJB-1,:,NSV_LIMA_NR)=ZSVT(:,IJB-1,:,NSV_LIMA_NR)
+ PSVT(:,IJE+1,:,NSV_LIMA_NR)=ZSVT(:,IJE+1,:,NSV_LIMA_NR)
+ ENDIF
+ ENDIF
+ IF (NSV_LIMA_NI.GE.1) THEN
+ IF (GLIMABOUNDARY(NSV_LIMA_NI-NSV_LIMA_BEG+1)) THEN
+ PSVT(IIB-1,:,:,NSV_LIMA_NI)=ZSVT(IIB-1,:,:,NSV_LIMA_NI) ! ice
+ PSVT(IIE+1,:,:,NSV_LIMA_NI)=ZSVT(IIE+1,:,:,NSV_LIMA_NI)
+ PSVT(:,IJB-1,:,NSV_LIMA_NI)=ZSVT(:,IJB-1,:,NSV_LIMA_NI)
+ PSVT(:,IJE+1,:,NSV_LIMA_NI)=ZSVT(:,IJE+1,:,NSV_LIMA_NI)
+ ENDIF
+ END IF
+END IF
+!
+!
+IF (LUSECHEM .AND. IMI == 1) THEN
+ IF (GFIRSTCALL1) THEN
+ ALLOCATE(GCHBOUNDARY(NSV_CHEM))
+ GFIRSTCALL1 = .FALSE.
+ DO JSV=NSV_CHEMBEG,NSV_CHEMEND
+ GCHTMP = .FALSE.
+ IF (LWEST_ll().AND.HLBCX(1)=='OPEN') GCHTMP = GCHTMP .OR. ALL(PLBXSVM(JPHEXT,:,:,JSV)==0)
+ IF (LEAST_ll().AND.HLBCX(2)=='OPEN') GCHTMP = GCHTMP .OR. ALL(PLBXSVM(ILBX-JPHEXT+1,:,:,JSV)==0)
+ IF (LSOUTH_ll().AND.HLBCY(1)=='OPEN') GCHTMP = GCHTMP .OR. ALL(PLBYSVM(:,JPHEXT,:,JSV)==0)
+ IF (LNORTH_ll().AND.HLBCY(2)=='OPEN') GCHTMP = GCHTMP .OR. ALL(PLBYSVM(:,ILBY-JPHEXT+1,:,JSV)==0)
+ GCHBOUNDARY(JSV-NSV_CHEMBEG+1) = GCHTMP
+ ENDDO
+ ENDIF
+
+ DO JSV=NSV_CHEMBEG,NSV_CHEMEND
+ IF (GCHBOUNDARY(JSV-NSV_CHEMBEG+1)) THEN
+ IF (SIZE(PSVT)>0) THEN
+ CALL CH_BOUNDARIES (HLBCX,HLBCY,PUT,PVT,PSVT(:,:,:,JSV),XSVMIN(JSV))
+ ENDIF
+ ENDIF
+ ENDDO
+ENDIF
+!
+IF (LUSECHIC .AND. IMI == 1) THEN
+ IF (GFIRSTCALLIC) THEN
+ ALLOCATE(GICBOUNDARY(NSV_CHIC))
+ GFIRSTCALLIC = .FALSE.
+ DO JSV=NSV_CHICBEG,NSV_CHICEND
+ GCHTMP = .FALSE.
+ IF (LWEST_ll().AND.HLBCX(1)=='OPEN') GCHTMP = GCHTMP .OR. ALL(PLBXSVM(JPHEXT,:,:,JSV)==0)
+ IF (LEAST_ll().AND.HLBCX(2)=='OPEN') GCHTMP = GCHTMP .OR. ALL(PLBXSVM(ILBX-JPHEXT+1,:,:,JSV)==0)
+ IF (LSOUTH_ll().AND.HLBCY(1)=='OPEN') GCHTMP = GCHTMP .OR. ALL(PLBYSVM(:,JPHEXT,:,JSV)==0)
+ IF (LNORTH_ll().AND.HLBCY(2)=='OPEN') GCHTMP = GCHTMP .OR. ALL(PLBYSVM(:,ILBY-JPHEXT+1,:,JSV)==0)
+ GICBOUNDARY(JSV-NSV_CHICBEG+1) = GCHTMP
+ ENDDO
+ ENDIF
+
+ DO JSV=NSV_CHICBEG,NSV_CHICEND
+ IF (GICBOUNDARY(JSV-NSV_CHICBEG+1)) THEN
+ IF (SIZE(PSVT)>0) THEN
+ CALL CH_BOUNDARIES (HLBCX,HLBCY,PUT,PVT,PSVT(:,:,:,JSV),XSVMIN(JSV))
+ ENDIF
+ ENDIF
+ ENDDO
+ENDIF
+IF (LORILAM .AND. IMI == 1) THEN
+ IF (GFIRSTCALL2) THEN
+ ALLOCATE(GAERBOUNDARY(NSV_AER))
+ GFIRSTCALL2 = .FALSE.
+ DO JSV=NSV_AERBEG,NSV_AEREND
+ GCHTMP = .FALSE.
+ IF (LWEST_ll().AND.HLBCX(1)=='OPEN') GCHTMP = GCHTMP .OR. ALL(PLBXSVM(JPHEXT,:,:,JSV)==0)
+ IF (LEAST_ll().AND.HLBCX(2)=='OPEN') GCHTMP = GCHTMP .OR. ALL(PLBXSVM(ILBX-JPHEXT+1,:,:,JSV)==0)
+ IF (LSOUTH_ll().AND.HLBCY(1)=='OPEN') GCHTMP = GCHTMP .OR. ALL(PLBYSVM(:,JPHEXT,:,JSV)==0)
+ IF (LNORTH_ll().AND.HLBCY(2)=='OPEN') GCHTMP = GCHTMP .OR. ALL(PLBYSVM(:,ILBY-JPHEXT+1,:,JSV)==0)
+ GAERBOUNDARY(JSV-NSV_AERBEG+1) = GCHTMP
+ ENDDO
+ ENDIF
+
+ DO JSV=NSV_AERBEG,NSV_AEREND
+ IF (GAERBOUNDARY(JSV-NSV_AERBEG+1)) THEN
+ IF (SIZE(PSVT)>0) THEN
+ CALL CH_BOUNDARIES (HLBCX,HLBCY,PUT,PVT,PSVT(:,:,:,JSV),XSVMIN(JSV))
+ ENDIF
+ ENDIF
+ ENDDO
+ENDIF
+!
+IF (LDUST .AND. IMI == 1) THEN
+ IF (GFIRSTCALL3) THEN
+ ALLOCATE(GDSTBOUNDARY(NSV_DST))
+ GFIRSTCALL3 = .FALSE.
+ DO JSV=NSV_DSTBEG,NSV_DSTEND
+ GCHTMP = .FALSE.
+ IF (LWEST_ll().AND.HLBCX(1)=='OPEN') GCHTMP = GCHTMP .OR. ALL(PLBXSVM(JPHEXT,:,:,JSV)==0)
+ IF (LEAST_ll().AND.HLBCX(2)=='OPEN') GCHTMP = GCHTMP .OR. ALL(PLBXSVM(ILBX-JPHEXT+1,:,:,JSV)==0)
+ IF (LSOUTH_ll().AND.HLBCY(1)=='OPEN') GCHTMP = GCHTMP .OR. ALL(PLBYSVM(:,JPHEXT,:,JSV)==0)
+ IF (LNORTH_ll().AND.HLBCY(2)=='OPEN') GCHTMP = GCHTMP .OR. ALL(PLBYSVM(:,ILBY-JPHEXT+1,:,JSV)==0)
+ GDSTBOUNDARY(JSV-NSV_DSTBEG+1) = GCHTMP
+ ENDDO
+ ENDIF
+
+ DO JSV=NSV_DSTBEG,NSV_DSTEND
+ IF (GDSTBOUNDARY(JSV-NSV_DSTBEG+1)) THEN
+ IF (SIZE(PSVT)>0) THEN
+ CALL CH_BOUNDARIES (HLBCX,HLBCY,PUT,PVT,PSVT(:,:,:,JSV),XSVMIN(JSV))
+ ENDIF
+ ENDIF
+ ENDDO
+ENDIF
+!
+IF (LSALT .AND. IMI == 1) THEN
+ IF (GFIRSTCALL5) THEN
+ ALLOCATE(GSLTBOUNDARY(NSV_SLT))
+ GFIRSTCALL5 = .FALSE.
+ DO JSV=NSV_SLTBEG,NSV_SLTEND
+ GCHTMP = .FALSE.
+ IF (LWEST_ll().AND.HLBCX(1)=='OPEN') GCHTMP = GCHTMP .OR. ALL(PLBXSVM(JPHEXT,:,:,JSV)==0)
+ IF (LEAST_ll().AND.HLBCX(2)=='OPEN') GCHTMP = GCHTMP .OR. ALL(PLBXSVM(ILBX-JPHEXT+1,:,:,JSV)==0)
+ IF (LSOUTH_ll().AND.HLBCY(1)=='OPEN') GCHTMP = GCHTMP .OR. ALL(PLBYSVM(:,JPHEXT,:,JSV)==0)
+ IF (LNORTH_ll().AND.HLBCY(2)=='OPEN') GCHTMP = GCHTMP .OR. ALL(PLBYSVM(:,ILBY-JPHEXT+1,:,JSV)==0)
+ GSLTBOUNDARY(JSV-NSV_SLTBEG+1) = GCHTMP
+ ENDDO
+ ENDIF
+
+ DO JSV=NSV_SLTBEG,NSV_SLTEND
+ IF (GSLTBOUNDARY(JSV-NSV_SLTBEG+1)) THEN
+ IF (SIZE(PSVT)>0) THEN
+ CALL CH_BOUNDARIES (HLBCX,HLBCY,PUT,PVT,PSVT(:,:,:,JSV),XSVMIN(JSV))
+ ENDIF
+ ENDIF
+ ENDDO
+ENDIF
+!
+IF ( LPASPOL .AND. IMI == 1) THEN
+ IF (GFIRSTCALLPP) THEN
+ ALLOCATE(GPPBOUNDARY(NSV_PP))
+ GFIRSTCALLPP = .FALSE.
+ DO JSV=NSV_PPBEG,NSV_PPEND
+ GPPTMP = .FALSE.
+ IF (LWEST_ll().AND.HLBCX(1)=='OPEN') GPPTMP = GPPTMP .OR. ALL(PLBXSVM(JPHEXT,:,:,JSV)==0)
+ IF (LEAST_ll().AND.HLBCX(2)=='OPEN') GPPTMP = GPPTMP .OR. ALL(PLBXSVM(ILBX-JPHEXT+1,:,:,JSV)==0)
+ IF (LSOUTH_ll().AND.HLBCY(1)=='OPEN') GPPTMP = GPPTMP .OR. ALL(PLBYSVM(:,JPHEXT,:,JSV)==0)
+ IF (LNORTH_ll().AND.HLBCY(2)=='OPEN') GPPTMP = GPPTMP .OR. ALL(PLBYSVM(:,ILBY-JPHEXT+1,:,JSV)==0)
+ GPPBOUNDARY(JSV-NSV_PPBEG+1) = GPPTMP
+ ENDDO
+ ENDIF
+
+ DO JSV=NSV_PPBEG,NSV_PPEND
+ IF (GPPBOUNDARY(JSV-NSV_PPBEG+1)) THEN
+ IF (SIZE(PSVT)>0) THEN
+ CALL CH_BOUNDARIES (HLBCX,HLBCY,PUT,PVT,PSVT(:,:,:,JSV),XSVMIN(JSV))
+ ENDIF
+ ENDIF
+ ENDDO
+ENDIF
+!
+IF ( LCONDSAMP .AND. IMI == 1) THEN
+ IF (GFIRSTCALLCS) THEN
+ ALLOCATE(GCSBOUNDARY(NSV_CS))
+ GFIRSTCALLCS = .FALSE.
+ DO JSV=NSV_CSBEG,NSV_CSEND
+ GCSTMP = .FALSE.
+ IF (LWEST_ll().AND.HLBCX(1)=='OPEN') GCSTMP = GCSTMP .OR. ALL(PLBXSVM(JPHEXT,:,:,JSV)==0)
+ IF (LEAST_ll().AND.HLBCX(2)=='OPEN') GCSTMP = GCSTMP .OR. ALL(PLBXSVM(ILBX-JPHEXT+1,:,:,JSV)==0)
+ IF (LSOUTH_ll().AND.HLBCY(1)=='OPEN') GCSTMP = GCSTMP .OR. ALL(PLBYSVM(:,JPHEXT,:,JSV)==0)
+ IF (LNORTH_ll().AND.HLBCY(2)=='OPEN') GCSTMP = GCSTMP .OR. ALL(PLBYSVM(:,ILBY-JPHEXT+1,:,JSV)==0)
+ GCSBOUNDARY(JSV-NSV_CSBEG+1) = GCSTMP
+ ENDDO
+ ENDIF
+
+ DO JSV=NSV_CSBEG,NSV_CSEND
+ IF (GCSBOUNDARY(JSV-NSV_CSBEG+1)) THEN
+ IF (SIZE(PSVT)>0) THEN
+ CALL CH_BOUNDARIES (HLBCX,HLBCY,PUT,PVT,PSVT(:,:,:,JSV),XSVMIN(JSV))
+ ENDIF
+ ENDIF
+ ENDDO
+ENDIF
+
+IF (LBLOWSNOW .AND. IMI == 1) THEN
+ IF (GFIRSTCALL3) THEN
+ ALLOCATE(GSNWBOUNDARY(NSV_SNW))
+ GFIRSTCALL3 = .FALSE.
+ DO JSV=NSV_SNWBEG,NSV_SNWEND
+ GCHTMP = .FALSE.
+ IF (LWEST_ll().AND.HLBCX(1)=='OPEN') GCHTMP = GCHTMP .OR. ALL(PLBXSVM(1,:,:,JSV)==0)
+ IF (LEAST_ll().AND.HLBCX(2)=='OPEN') GCHTMP = GCHTMP .OR. ALL(PLBXSVM(ILBX,:,:,JSV)==0)
+ IF (LSOUTH_ll().AND.HLBCY(1)=='OPEN') GCHTMP = GCHTMP .OR. ALL(PLBYSVM(:,1,:,JSV)==0)
+ IF (LNORTH_ll().AND.HLBCY(2)=='OPEN') GCHTMP = GCHTMP .OR. ALL(PLBYSVM(:,ILBY,:,JSV)==0)
+ GSNWBOUNDARY(JSV-NSV_SNWBEG+1) = GCHTMP
+ ENDDO
+ ENDIF
+ENDIF
+
+#ifdef MNH_FOREFIRE
+!ForeFire
+IF ( LFOREFIRE .AND. IMI == 1) THEN
+ IF (GFIRSTCALLFF) THEN
+ ALLOCATE(GFFBOUNDARY(NSV_FF))
+ GFIRSTCALLFF = .FALSE.
+ DO JSV=NSV_FFBEG,NSV_FFEND
+ GFFTMP = .FALSE.
+ IF (LWEST_ll().AND.HLBCX(1)=='OPEN') GFFTMP = GFFTMP .OR. ALL(PLBXSVM(JPHEXT,:,:,JSV)==0)
+ IF (LEAST_ll().AND.HLBCX(2)=='OPEN') GFFTMP = GFFTMP .OR. ALL(PLBXSVM(ILBX-JPHEXT+1,:,:,JSV)==0)
+ IF (LSOUTH_ll().AND.HLBCY(1)=='OPEN') GFFTMP = GFFTMP .OR. ALL(PLBYSVM(:,JPHEXT,:,JSV)==0)
+ IF (LNORTH_ll().AND.HLBCY(2)=='OPEN') GFFTMP = GFFTMP .OR. ALL(PLBYSVM(:,ILBY-JPHEXT+1,:,JSV)==0)
+ GFFBOUNDARY(JSV-NSV_FFBEG+1) = GFFTMP
+ ENDDO
+ ENDIF
+
+ DO JSV=NSV_FFBEG,NSV_FFEND
+ IF (GFFBOUNDARY(JSV-NSV_FFBEG+1)) THEN
+ IF (SIZE(PSVT)>0) THEN
+ CALL CH_BOUNDARIES (HLBCX,HLBCY,PUT,PVT,PSVT(:,:,:,JSV),XSVMIN(JSV))
+ ENDIF
+ ENDIF
+ ENDDO
+ENDIF
+#endif
+!
+IF ( CELEC /= 'NONE' .AND. (NSV_ELEC_A(NDAD(IMI)) == 0 .OR. IMI == 1)) THEN
+ CALL ION_BOUNDARIES (HLBCX,HLBCY,PUT,PVT,PSVT)
+ENDIF
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE BOUNDARIES
diff --git a/src/PHYEX/ext/default_desfmn.f90 b/src/PHYEX/ext/default_desfmn.f90
new file mode 100644
index 0000000000000000000000000000000000000000..6957954a7039d5716b9a4d824943d0636af0d7f3
--- /dev/null
+++ b/src/PHYEX/ext/default_desfmn.f90
@@ -0,0 +1,1491 @@
+!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.
+!-----------------------------------------------------------------
+! ###########################
+ MODULE MODI_DEFAULT_DESFM_n
+! ###########################
+!
+INTERFACE
+!
+SUBROUTINE DEFAULT_DESFM_n(KMI)
+INTEGER, INTENT(IN) :: KMI ! Model index
+END SUBROUTINE DEFAULT_DESFM_n
+!
+END INTERFACE
+!
+END MODULE MODI_DEFAULT_DESFM_n
+!
+!
+!
+! ###############################
+ SUBROUTINE DEFAULT_DESFM_n(KMI)
+! ###############################
+!
+!!**** *DEFAULT_DESFM_n * - set default values for descriptive variables of
+!! model KMI
+!!
+!! PURPOSE
+!! -------
+! The purpose of this routine is to set default values for the variables
+! in descriptor files by filling the corresponding variables which
+! are stored in modules.
+!
+!
+!!** METHOD
+!! ------
+!! Each variable in modules, which can be initialized by reading its
+!! value in the descriptor file is set to a default value.
+!! When this routine is used during INIT, the modules of the first model
+!! are used to temporarily store the variables associated with a nested
+!! model.
+!! When this routine is used during SPAWNING, the modules of a second
+!! model must be initialized.
+!! Default values for variables common to all models are set only
+!! at the first call of DEFAULT_DESFM_n (i.e. when KMI=1)
+!!
+!!
+!! EXTERNAL
+!! --------
+!! NONE
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_PARAMETERS : JPHEXT,JPVEXT
+!!
+!! Module MODD_CONF : CCONF,L2D,L1D,LFLAT,NMODEL,NVERB
+!!
+!! Module MODD_DYN : XSEGLEN,XASSELIN,LCORIO,LNUMDIFF
+!! XALKTOP,XALZBOT
+!!
+!! Module MODD_BAKOUT
+!!
+!! Module MODD_NESTING : NDAD(m),NDTRATIO(m),XWAY(m)
+!!
+!! Module MODD_CONF_n : LUSERV,LUSERC,LUSERR,LUSERI,LUSERS
+!! LUSERG,LUSERH,CSEG,CEXP
+!!
+!! Module MODD_LUNIT_n : CINIFILE,CCPLFILE
+!!
+!!
+!! Module MODD_DYN_n : XTSTEP,CPRESOPT,NITR,XRELAX,LHO_RELAX
+!! LVE_RELAX,XRIMKMAX,NRIMX,NRIMY
+!!
+!! Module MODD_ADV_n : CUVW_ADV_SCHEME,CMET_ADV_SCHEME,CSV_ADV_SCHEME,NLITER
+!!
+!! Module MODD_PARAM_n : CTURB,CRAD,CDCONV,CSCONV
+!!
+!! Module MODD_LBC_n : CLBCX, CLBCY,NLBLX,NLBLY,XCPHASE,XCPHASE_PBL,XPOND
+!!
+!! Module MODD_TURB_n : XIMPL,CTURBLEN,CTURBDIM,LTURB_FLX,LTURB_DIAG,LSUBG_COND
+!! LTGT_FLX
+!!
+!!
+!! Module MODD_PARAM_RAD_n:
+!! XDTRAD,XDTRAD_CLONLY,LCLEAR_SKY,NRAD_COLNBR, NRAD_DIAG
+!!
+!! Module MODD_BUDGET : CBUTYPE,NBUMOD,XBULEN,NBUKL, NBUKH,LBU_KCP,XBUWRI
+!! NBUIL, NBUIH,NBUJL, NBUJH,LBU_ICP,LBU_JCP,NBUMASK
+!!
+!! Module MODD_BLANK_n:
+!!
+!! XDUMMYi, NDUMMYi, LDUMMYi, CDUMMYi
+!!
+!! Module MODD_FRC :
+!!
+!! LGEOST_UV_FRC,LGEOST_TH_FRC,LTEND_THRV_FRC
+!! LVERT_MOTION_FRC,LRELAX_THRV_FRC,LRELAX_UV_FRC,LRELAX_UVMEAN_FRC,
+!! XRELAX_TIME_FRC
+!! XRELAX_HEIGHT_FRC,CRELAX_HEIGHT_TYPE,LTRANS,XUTRANS,XVTRANS,
+!! LPGROUND_FRC
+!!
+!! Module MODD_PARAM_ICE :
+!!
+!! LWARM,CPRISTINE_ICE
+!!
+!! Module MODD_PARAM_KAFR_n :
+!!
+!! XDTCONV,LREFRESH_ALL,LDOWN,NICE,LCHTRANS
+!!
+!! Module MODD_PARAM_MFSHALL_n :
+!!
+!! CMF_UPDRAFT,LMIXUV,CMF_CLOUD,XIMPL_MF,LMF_FLX
+!!
+!!
+!!
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of the documentation (routine DEFAULT_DESFM_n)
+!!
+!!
+!! AUTHOR
+!! ------
+!! V. Ducrocq * Meteo France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 02/06/94
+!! Modifications 17/10/94 (Stein) For LCORIO
+!! Modifications 06/12/94 (Stein) remove LBOUSS+add LABSLAYER, LNUMDIFF
+!! ,LSTEADYLS
+!! Modifications 06/12/94 (Stein) remove LABSLAYER, add LHO_RELAX,
+!! LVE_RELAX, NRIMX, NRIMY, XRIMKMAX
+!! Modifications 09/01/95 (Lafore) add LSTEADY_DMASS
+!! Modifications 09/01/95 (Stein) add the turbulence scheme namelist
+!! Modifications 09/01/95 (Stein) add the 1D switch
+!! Modifications 10/03/95 (Mallet) add the coupling files
+!! 29/06/95 ( Stein, Nicolau, Hereil) add the budgets
+!! Modifications 25/09/95 ( Stein )add the LES tools
+!! Modifications 25/10/95 ( Stein )add the radiations
+!! Modifications 23/10/95 (Vila, lafore) new scalar advection scheme
+!! Modifications 24/02/96 (Stein) change the default value for CCPLFILE
+!! Modifications 12/02/96 (Lafore) transformation to DEFAULT_DESFM_n for
+!! spawning
+!! Modifications 25/04/96 (Suhre) add the blank module
+!! Modifications 29/07/96 (Pinty&Suhre) add module MODD_FRC
+!! Modifications 11/04/96 (Pinty) add the rain-ice scheme and modify
+!! the split arrays in MODD_PARAM_RAD_n
+!! Modifications 11/01/97 (Pinty) add the deep convection scheme
+!! Modifications 24/11/96 (Masson) add LREFRESH_ALL in deep convection
+!! Modifications 12/02/96 (Lafore) transformation to DEFAULT_DESFM_n for spawning
+!! Modifications 22/07/96 (Lafore) gridnesting implementation
+!! Modifications 29/07/96 (Lafore) add the module MODD_FMOUT (renamed MODD_BAKOUT)
+!! Modifications 23/06/97 (Stein) add the equation system name
+!! Modifications 10/07/97 (Masson) add MODD_PARAM_GROUNDn : CROUGH
+!! Modifications 28/07/97 (Masson) remove LREFRESH_ALL and LSTEADY_DMASS
+!! Modifications 08/10/97 (Stein) switch (_n=1) to initialize the
+!! parameters common to all models
+!! Modifications 24/01/98 (Bechtold) add LREFRESH_ALL, LCHTRANS,
+!! LTEND_THRV_FR and LSST_FRC
+!! Modifications 18/07/99 (Stein) add LRAD_DIAG
+!! Modification 15/03/99 (Masson) use of XUNDEF
+!! Modification 11/12/00 (Tomasini) Add CSEA_FLUX to MODD_PARAMn
+!! Modification 22/01/01 (Gazen) delete NSV and add LHORELAX_SVC2R2
+!! LHORELAX_SVCHEM,LHORELAX_SVLG
+!! Modification 15/03/02 (Solmon) radiation scheme: remove NSPOT and add
+!! default for aerosol and cloud rad. prop. control
+!! Modification 22/05/02 (Jabouille) put chimical default here
+!! Modification 01/2004 (Masson) removes surface (externalization)
+!! 09/04 (M. Tomasini) New namelist to modify the
+!! Cloud mixing length
+!! 07/05 (P.Tulet) New namelists for dust and aerosol
+!! Modification 01/2007 (Malardel, Pergaud) Add MODD_PARAM_MFSHALL_n
+!! Modification 10/2009 (Aumond) Add user multimasks for LES
+!! Modification 10/2009 (Aumond) Add MEAN_FIELD
+!! Modification 12/04/07 (Leriche) add LUSECHAQ for aqueous chemistry
+!! Modification 30/05/07 (Leriche) add LCH_PH and XCH_PHINIT for pH
+!! Modification 25/04/08 (Leriche) add XRTMIN_AQ LWC threshold for aq. chemistry
+!! 16/07/10 add LHORELAX_SVIC
+!! 16/09/10 add LUSECHIC
+!! 13/01/11 add LCH_RET_ICE
+!! 01/07/11 (F.Couvreux) Add CONDSAMP
+!! 01/07/11 (B.Aouizerats) Add CAOP
+!! 07/2013 (C.Lac) add WENO, LCHECK
+!! 07/2013 (Bosseur & Filippi) adds Forefire
+!! 08/2015 (Redelsperger & Pianezze) add XPOND coefficient for LBC
+!! Modification 24/03/16 (Leriche) remove LCH_SURFACE_FLUX
+!! put NCH_VEC_LENGTH = 50 instead of 1000
+!!
+!! 04/2016 (C.LAC) negative contribution to the budget split between advection, turbulence and microphysics for KHKO/C2R2
+!! Modification 01/2016 (JP Pinty) Add LIMA
+!! Modification 24/03/16 (Leriche) remove LCH_SURFACE_FLUX
+!! put NCH_VEC_LENGTH = 50 instead of 1000
+!! 10/2016 (C.Lac) VSIGQSAT change from 0 to 0.02 for coherence with AROME
+!! 10/2016 (C.Lac) Add droplet deposition
+!! 10/2016 (R.Honnert and S.Riette) : Improvement of EDKF and adaptation to the grey zone
+!! 10/2016 (F Brosse) add prod/loss terms computation for chemistry
+!! 07/2017 (V. Masson) adds time step for output files writing.
+!! 09/2017 Q.Rodier add LTEND_UV_FRC
+!! 02/2018 Q.Libois ECRAD
+! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+!! 01/2018 (S. Riette) new budgets and variables for ICE3/ICE4
+!! 01/2018 (J.Colin) add VISC and DRAG
+!! 07/2017 (V. Vionnet) add blowing snow variables
+!! 01/2019 (R. Honnert) add reduction of the mass-flux surface closure with the resolution
+!! Bielli S. 02/2019 Sea salt : significant sea wave height influences salt emission; 5 salt modes
+!! 05/2019 F.Brient add tracer emission from the top of the boundary-layer
+!! 11/2019 C.Lac correction in the drag formula and application to building in addition to tree
+! P. Wautelet 17/04/2020: move budgets switch values into modd_budget
+! P. Wautelet 30/06/2020: add NNETURSV, NNEADVSV and NNECONSV variables
+! F. Auguste, T. Nagel 02/2021: add IBM defaults parameters
+! T. Nagel 02/2021: add turbulence recycling defaults parameters
+! P-A Joulin 21/05/2021: add Wind turbines
+! S. Riette 21/05/2021: add options to PDF subgrid scheme
+! D. Ricard 05/2021: add the contribution of Leonard terms in the turbulence scheme
+! JL Redelsperger 06/2021: add parameters allowing to active idealized oceanic convection
+! B. Vie 06/2021: add prognostic supersaturation for LIMA
+! 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
+! 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
+! P. Wautelet 27/04/2022: add namelist for profilers
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+USE MODD_PARAMETERS
+USE MODD_CONF ! For INIT only DEFAULT_DESFM1
+USE MODD_CONFZ
+USE MODD_DYN
+USE MODD_NESTING
+USE MODD_BAKOUT
+USE MODD_SERIES
+USE MODD_CONF_n ! modules used to set the default values is only
+USE MODD_LUNIT_n ! the one corresponding to model 1. These memory
+USE MODD_DIM_n ! addresses will then be filled by the values read in
+USE MODD_DYN_n ! the DESFM corresponding to model n which may have
+USE MODD_ADV_n ! missing values. This is why we affect default values.
+USE MODD_PARAM_n ! For SPAWNING DEFAULT_DESFM2 is also used
+USE MODD_LBC_n
+USE MODD_OUT_n
+USE MODD_TURB_n
+USE MODD_BUDGET
+USE MODD_LES
+USE MODD_PARAM_RAD_n
+#ifdef MNH_ECRAD
+USE MODD_PARAM_ECRAD_n
+#if ( VER_ECRAD == 140 )
+USE MODD_RADIATIONS_n , ONLY : NSWB_MNH, NLWB_MNH
+#endif
+#endif
+USE MODD_BLANK_n
+USE MODD_FRC
+USE MODD_PARAM_ICE
+USE MODD_PARAM_C2R2
+USE MODD_TURB_CLOUD
+USE MODD_PARAM_KAFR_n
+USE MODD_PARAM_MFSHALL_n
+USE MODD_CH_MNHC_n
+USE MODD_SERIES_n
+USE MODD_NUDGING_n
+USE MODD_CH_AEROSOL
+USE MODD_DUST
+USE MODD_SALT
+USE MODD_PASPOL
+USE MODD_CONDSAMP
+USE MODD_MEAN_FIELD
+USE MODD_DRAGTREE_n
+USE MODD_DRAGBLDG_n
+USE MODD_EOL_MAIN
+USE MODD_EOL_ADNR
+USE MODD_EOL_ALM
+USE MODD_EOL_SHARED_IO
+USE MODD_ALLPROFILER_n
+USE MODD_ALLSTATION_n
+!
+!
+USE MODD_PARAM_LIMA, ONLY : LNUCL, LSEDI, LHHONI, LMEYERS, &
+ NMOM_I, NMOM_S, NMOM_G, NMOM_H, &
+ NMOD_IFN, XIFN_CONC, LIFN_HOM, CIFN_SPECIES, &
+ CINT_MIXING, NMOD_IMM, NIND_SPECIE, LMURAKAMI, &
+ YSNOW_T=>LSNOW_T, CPRISTINE_ICE_LIMA, CHEVRIMED_ICE_LIMA, &
+ XFACTNUC_DEP, XFACTNUC_CON, &
+ LACTI, OSEDC=>LSEDC, &
+ OACTIT=>LACTIT, LBOUND, LSPRO, LADJ, LKHKO, NMOM_C, NMOM_R, &
+ NMOD_CCN, XCCN_CONC, LKESSLERAC, &
+ LCCN_HOM, CCCN_MODES, &
+ YALPHAR=>XALPHAR, YNUR=>XNUR, &
+ YALPHAC=>XALPHAC, YNUC=>XNUC, CINI_CCN=>HINI_CCN, &
+ CTYPE_CCN=>HTYPE_CCN, YFSOLUB_CCN=>XFSOLUB_CCN, &
+ YACTEMP_CCN=>XACTEMP_CCN, YAERDIFF=>XAERDIFF, &
+ YAERHEIGHT=>XAERHEIGHT, &
+ LSCAV, LAERO_MASS, NPHILLIPS, &
+ LCIBU, XNDEBRIS_CIBU, LRDSF, &
+ ODEPOC=>LDEPOC, OVDEPOC=>XVDEPOC, OACTTKE=>LACTTKE, &
+ LPTSPLIT, L_LFEEDBACKT=>LFEEDBACKT, L_NMAXITER=>NMAXITER, &
+ L_XMRSTEP=>XMRSTEP, L_XTSTEP_TS=>XTSTEP_TS
+!
+USE MODD_LATZ_EDFLX
+USE MODD_2D_FRC
+USE MODD_BLOWSNOW
+USE MODD_BLOWSNOW_n
+USE MODD_DRAG_n
+USE MODD_VISCOSITY
+USE MODD_RECYCL_PARAM_n
+USE MODD_IBM_PARAM_n
+USE MODD_IBM_LSF
+#ifdef MNH_FOREFIRE
+USE MODD_FOREFIRE
+#endif
+USE MODD_FIRE_n
+!
+IMPLICIT NONE
+!
+!* 0.1 declarations of arguments
+!
+INTEGER, INTENT(IN) :: KMI ! Model index
+!
+!* 0.2 declaration of local variables
+!
+INTEGER :: JM ! loop index
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. SET DEFAULT VALUES FOR MODD_LUNIT_n :
+! ----------------------------------
+!
+! CINIFILE='INIFILE'
+CINIFILEPGD='' !Necessary to keep this line to prevent problems with spawning
+CCPLFILE(:)=' '
+!
+!-------------------------------------------------------------------------------
+!
+!* 2. SET DEFAULT VALUES FOR MODD_CONF AND MODD_CONF_n :
+! ------------------------------------------------
+!
+IF (KMI == 1) THEN
+ CCONF ='START'
+ LTHINSHELL = .FALSE.
+ L2D = .FALSE.
+ L1D = .FALSE.
+ LFLAT = .FALSE.
+ NMODEL = 1
+ CEQNSYS = 'DUR'
+ NVERB = 5
+ CEXP = 'EXP01'
+ CSEG = 'SEG01'
+ LFORCING = .FALSE.
+ L2D_ADV_FRC= .FALSE.
+ L2D_REL_FRC= .FALSE.
+ XRELAX_HEIGHT_BOT = 0.
+ XRELAX_HEIGHT_TOP = 30000.
+ XRELAX_TIME = 864000.
+ LPACK = .TRUE.
+ NHALO = 1
+#ifdef MNH_SX5
+ CSPLIT ='YSPLITTING' ! NEC vectoriel architecture , low number of PROC
+#else
+ CSPLIT ='BSPLITTING' ! Scalaire architecture , high number of PROC
+#endif
+ NZ_PROC = 0 !JUAN Z_SPLITTING :: number of proc in Z splitting
+ NZ_SPLITTING = 10 !JUAN Z_SPLITTING :: for debug NZ=1=flat_inv; NZ=10=flat_invz; NZ=1+2 the two
+ LLG = .FALSE.
+ LINIT_LG = .FALSE.
+ CINIT_LG = 'FMOUT'
+ LNOMIXLG = .FALSE.
+ LCHECK = .FALSE.
+END IF
+!
+CCLOUD = 'NONE'
+LUSERV = .TRUE.
+LUSERC = .FALSE.
+LUSERR = .FALSE.
+LUSERI = .FALSE.
+LUSERS = .FALSE.
+LUSERG = .FALSE.
+LUSERH = .FALSE.
+LOCEAN = .FALSE.
+!NSV = 0
+!NSV_USER = 0
+LUSECI = .FALSE.
+!
+!-------------------------------------------------------------------------------
+!
+!* 3. SET DEFAULT VALUES FOR MODD_DYN AND MODD_DYN_n :
+! -----------------------------------------------
+!
+IF (KMI == 1) THEN
+ XSEGLEN = 43200.
+ XASSELIN = 0.2
+ XASSELIN_SV = 0.02
+ LCORIO = .TRUE.
+ LNUMDIFU = .TRUE.
+ LNUMDIFTH = .FALSE.
+ LNUMDIFSV = .FALSE.
+ XALZBOT = 4000.
+ XALKTOP = 0.01
+ XALKGRD = 0.01
+ XALZBAS = 0.01
+END IF
+!
+XTSTEP = 60.
+CPRESOPT = 'CRESI'
+NITR = 4
+LITRADJ = .TRUE.
+LRES = .FALSE.
+XRES = 1.E-07
+XRELAX = 1.
+LVE_RELAX = .FALSE.
+LVE_RELAX_GRD = .FALSE.
+XRIMKMAX = 0.01 / XTSTEP
+XT4DIFU = 1800.
+XT4DIFTH = 1800.
+XT4DIFSV = 1800.
+!
+IF (KMI == 1) THEN ! for model 1 we have a Large scale information
+ NRIMX = JPRIMMAX ! for U,V,W,TH,Rv used for the hor. relaxation
+ NRIMY = JPRIMMAX
+ELSE
+ NRIMX = 0 ! for inner models we use only surfacic fields to
+ NRIMY = 0 ! give the lbc and no hor. relaxation is used
+END IF
+!
+LHORELAX_UVWTH = .FALSE.
+LHORELAX_RV = .FALSE.
+LHORELAX_RC = .FALSE. ! for all these fields, no large scale is usally available
+LHORELAX_RR = .FALSE. ! for model 1 and for inner models, we only use surfacic
+LHORELAX_RS = .FALSE. ! fiels ( no hor. relax. )
+LHORELAX_RI = .FALSE.
+LHORELAX_RG = .FALSE.
+LHORELAX_RH = .FALSE.
+LHORELAX_TKE = .FALSE.
+LHORELAX_SV(:) = .FALSE.
+LHORELAX_SVC2R2 = .FALSE.
+LHORELAX_SVC1R3 = .FALSE.
+LHORELAX_SVELEC = .FALSE.
+LHORELAX_SVLG = .FALSE.
+LHORELAX_SVCHEM = .FALSE.
+LHORELAX_SVCHIC = .FALSE.
+LHORELAX_SVDST = .FALSE.
+LHORELAX_SVSLT = .FALSE.
+LHORELAX_SVPP = .FALSE.
+LHORELAX_SVCS = .FALSE.
+LHORELAX_SVAER = .FALSE.
+!
+LHORELAX_SVLIMA = .FALSE.
+!
+#ifdef MNH_FOREFIRE
+LHORELAX_SVFF = .FALSE.
+#endif
+LHORELAX_SVSNW = .FALSE.
+LHORELAX_SVFIRE = .FALSE.
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 4. SET DEFAULT VALUES FOR MODD_NESTING :
+! -----------------------------------
+!
+IF (KMI == 1) THEN
+ NDAD(1)=1
+ DO JM=2,JPMODELMAX
+ NDAD(JM) = JM - 1
+ END DO
+ NDTRATIO(:) = 1
+ XWAY(:) = 2. ! two-way interactive gridnesting
+ XWAY(1) = 0. ! except for model 1
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+!* 5. SET DEFAULT VALUES FOR MODD_ADV_n :
+! ----------------------------------
+!
+CUVW_ADV_SCHEME = 'CEN4TH'
+CMET_ADV_SCHEME = 'PPM_01'
+CSV_ADV_SCHEME = 'PPM_01'
+CTEMP_SCHEME = 'RKC4'
+NWENO_ORDER = 3
+NSPLIT = 1
+LSPLIT_CFL = .TRUE.
+LSPLIT_WENO = .TRUE.
+XSPLIT_CFL = 0.8
+LCFL_WRIT = .FALSE.
+!
+!-------------------------------------------------------------------------------
+!
+!* 6. SET DEFAULT VALUES FOR MODD_PARAM_n :
+! -----------------------------------
+!
+CTURB = 'NONE'
+CRAD = 'NONE'
+CDCONV = 'NONE'
+CSCONV = 'NONE'
+CELEC = 'NONE'
+CACTCCN = 'NONE'
+!
+!-------------------------------------------------------------------------------
+!
+!* 7. SET DEFAULT VALUES FOR MODD_LBC_n :
+! ---------------------------------
+!
+CLBCX(1) ='CYCL'
+CLBCX(2) ='CYCL'
+CLBCY(1) ='CYCL'
+CLBCY(2) ='CYCL'
+NLBLX(:) = 1
+NLBLY(:) = 1
+XCPHASE = 20.
+XCPHASE_PBL = 0.
+XCARPKMAX = XUNDEF
+XPOND = 1.0
+!
+!-------------------------------------------------------------------------------
+!
+!* 8. SET DEFAULT VALUES FOR MODD_NUDGING_n :
+! ---------------------------------
+!
+LNUDGING = .FALSE.
+XTNUDGING = 21600.
+!
+!-------------------------------------------------------------------------------
+!
+!* 9. SET DEFAULT VALUES FOR MODD_BAKOUT and MODD_OUT_n :
+! ------------------------------------------------
+!
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 10. SET DEFAULT VALUES FOR MODD_TURB_n :
+! ----------------------------------
+!
+XIMPL = 1.
+XKEMIN = 0.01
+XCEDIS = 0.84
+XCADAP = 0.5
+CTURBLEN = 'BL89'
+CTURBDIM = '1DIM'
+LTURB_FLX =.FALSE.
+LTURB_DIAG=.FALSE.
+LSUBG_COND=.FALSE.
+CSUBG_AUCV='NONE'
+CSUBG_AUCV_RI='NONE'
+LSIGMAS =.TRUE.
+LSIG_CONV =.FALSE.
+LRMC01 =.FALSE.
+CTOM ='NONE'
+VSIGQSAT = 0.02
+CCONDENS='CB02'
+CLAMBDA3='CB'
+CSUBG_MF_PDF='TRIANGLE'
+LLEONARD =.FALSE.
+XCOEFHGRADTHL = 1.0
+XCOEFHGRADRM = 1.0
+XALTHGRAD = 2000.0
+XCLDTHOLD = -1.0
+
+!-------------------------------------------------------------------------------
+!
+!* 10b. SET DEFAULT VALUES FOR MODD_DRAGTREE :
+! ----------------------------------
+!
+LDRAGTREE = .FALSE.
+LDEPOTREE = .FALSE.
+XVDEPOTREE = 0.02 ! 2 cm/s
+!------------------------------------------------------------------------------
+!
+!* 10c. SET DEFAULT VALUES FOR MODD_DRAGB
+! ----------------------------------
+!
+LDRAGBLDG = .FALSE.
+!
+!* 10d. SET DEFAULT VALUES FOR MODD_EOL* :
+! ----------------------------------
+!
+! 10d.i) MODD_EOL_MAIN
+!
+LMAIN_EOL = .FALSE.
+CMETH_EOL = 'ADNR'
+CSMEAR = '3LIN'
+NMODEL_EOL = 1
+!
+! 10d.ii) MODD_EOL_SHARED_IO
+!
+CFARM_CSVDATA = 'data_farm.csv'
+CTURBINE_CSVDATA = 'data_turbine.csv'
+CBLADE_CSVDATA = 'data_blade.csv'
+CAIRFOIL_CSVDATA = 'data_airfoil.csv'
+!
+CINTERP = 'CLS'
+!
+! 10d.iii) MODD_EOL_ALM
+!
+NNB_BLAELT = 42
+LTIMESPLIT = .FALSE.
+LTIPLOSSG = .TRUE.
+LTECOUTPTS = .FALSE.
+!
+!------------------------------------------------------------------------------
+!* 10.e SET DEFAULT VALUES FOR MODD_ALLPROFILER_n :
+! ----------------------------------
+!
+NNUMB_PROF = 0
+XSTEP_PROF = 60.0
+XX_PROF(:) = XUNDEF
+XY_PROF(:) = XUNDEF
+XZ_PROF(:) = XUNDEF
+XLAT_PROF(:) = XUNDEF
+XLON_PROF(:) = XUNDEF
+CNAME_PROF(:) = ''
+CFILE_PROF = 'NO_INPUT_CSV'
+! LDIAG_SURFRAD = .TRUE.
+!------------------------------------------------------------------------------
+!* 10.f SET DEFAULT VALUES FOR MODD_ALLSTATION_n :
+! ----------------------------------
+!
+NNUMB_STAT = 0
+XSTEP_STAT = 60.0
+XX_STAT(:) = XUNDEF
+XY_STAT(:) = XUNDEF
+XZ_STAT(:) = XUNDEF
+XLAT_STAT(:) = XUNDEF
+XLON_STAT(:) = XUNDEF
+CNAME_STAT(:) = ''
+CFILE_STAT = 'NO_INPUT_CSV'
+LDIAG_SURFRAD = .TRUE.
+!
+!-------------------------------------------------------------------------------
+!
+!* 11. SET DEFAULT VALUES FOR MODD_BUDGET :
+! ------------------------------------
+!
+! 11.1 General budget variables
+!
+IF (KMI == 1) THEN
+ CBUTYPE = 'NONE'
+ NBUMOD = 1
+ XBULEN = XSEGLEN
+ XBUWRI = XSEGLEN
+ NBUKL = 1
+ NBUKH = 0
+ LBU_KCP = .TRUE.
+!
+! 11.2 Variables for the cartesian box
+!
+ NBUIL = 1
+ NBUIH = 0
+ NBUJL = 1
+ NBUJH = 0
+ LBU_ICP = .TRUE.
+ LBU_JCP = .TRUE.
+!
+! 11.3 Variables for the mask
+!
+ NBUMASK = 1
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+!* 12. SET DEFAULT VALUES FOR MODD_LES :
+! ---------------------------------
+!
+IF (KMI == 1) THEN
+ LLES_MEAN = .FALSE.
+ LLES_RESOLVED = .FALSE.
+ LLES_SUBGRID = .FALSE.
+ LLES_UPDRAFT = .FALSE.
+ LLES_DOWNDRAFT = .FALSE.
+ LLES_SPECTRA = .FALSE.
+!
+ NLES_LEVELS = NUNDEF
+ XLES_ALTITUDES = XUNDEF
+ NSPECTRA_LEVELS = NUNDEF
+ XSPECTRA_ALTITUDES = XUNDEF
+ NLES_TEMP_SERIE_I = NUNDEF
+ NLES_TEMP_SERIE_J = NUNDEF
+ NLES_TEMP_SERIE_Z = NUNDEF
+ CLES_NORM_TYPE = 'NONE'
+ CBL_HEIGHT_DEF = 'KE'
+ XLES_TEMP_SAMPLING = XUNDEF
+ XLES_TEMP_MEAN_START = XUNDEF
+ XLES_TEMP_MEAN_END = XUNDEF
+ XLES_TEMP_MEAN_STEP = 3600.
+ LLES_CART_MASK = .FALSE.
+ NLES_IINF = NUNDEF
+ NLES_ISUP = NUNDEF
+ NLES_JINF = NUNDEF
+ NLES_JSUP = NUNDEF
+ LLES_NEB_MASK = .FALSE.
+ LLES_CORE_MASK = .FALSE.
+ LLES_MY_MASK = .FALSE.
+ NLES_MASKS_USER = NUNDEF
+ LLES_CS_MASK = .FALSE.
+
+ LLES_PDF = .FALSE.
+ NPDF = 1
+ XTH_PDF_MIN = 270.
+ XTH_PDF_MAX = 350.
+ XW_PDF_MIN = -10.
+ XW_PDF_MAX = 10.
+ XTHV_PDF_MIN = 270.
+ XTHV_PDF_MAX = 350.
+ XRV_PDF_MIN = 0.
+ XRV_PDF_MAX = 20.
+ XRC_PDF_MIN = 0.
+ XRC_PDF_MAX = 1.
+ XRR_PDF_MIN = 0.
+ XRR_PDF_MAX = 1.
+ XRI_PDF_MIN = 0.
+ XRI_PDF_MAX = 1.
+ XRS_PDF_MIN = 0.
+ XRS_PDF_MAX = 1.
+ XRG_PDF_MIN = 0.
+ XRG_PDF_MAX = 1.
+ XRT_PDF_MIN = 0.
+ XRT_PDF_MAX = 20.
+ XTHL_PDF_MIN = 270.
+ XTHL_PDF_MAX = 350.
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+!* 13. SET DEFAULT VALUES FOR MODD_PARAM_RAD_n :
+! ---------------------------------------
+!
+XDTRAD = XTSTEP
+XDTRAD_CLONLY = XTSTEP
+LCLEAR_SKY =.FALSE.
+NRAD_COLNBR = 1000
+NRAD_DIAG = 0
+CLW ='RRTM'
+CAER='SURF'
+CAOP='CLIM'
+CEFRADL='MART'
+CEFRADI='LIOU'
+COPWSW = 'FOUQ'
+COPISW = 'EBCU'
+COPWLW = 'SMSH'
+COPILW = 'EBCU'
+XFUDG = 1.
+LAERO_FT=.FALSE.
+LFIX_DAT=.FALSE.
+!
+#ifdef MNH_ECRAD
+!* 13bis. SET DEFAULT VALUES FOR MODD_PARAM_ECRAD_n :
+! ---------------------------------------
+!
+#if ( VER_ECRAD == 101 )
+NSWSOLVER = 0 ! 0: 'McICA 1: 'SPARTACUS' 2: 'SPARTACUS' + 3D effect
+NLWSOLVER = 0 ! 0: 'McICA 1: 'SPARTACUS' 2: 'SPARTACUS' + 3D effect
+#endif
+#if ( VER_ECRAD == 140 )
+LSPEC_ALB = .FALSE.
+LSPEC_EMISS = .FALSE.
+
+
+!ALLOCATE(USER_ALB_DIFF(NSWB_MNH))
+!ALLOCATE(USER_ALB_DIR(NSWB_MNH))
+!ALLOCATE(USER_EMISS(NLWB_MNH))
+!PRINT*,USER_ALB_DIFF
+!USER_ALB_DIFF = (/0,0,0,0,0,0,0,0,0,0,0,0,0,0/)
+!USER_ALB_DIR = (/0,0,0,0,0,0,0,0,0,0,0,0,0,0/)
+!USER_EMISS = (/0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0/)
+SURF_TYPE="SNOW"
+
+NLWSOLVER = 1 ! 0: 'McICA 1: 'SPARTACUS' 2: 'SPARTACUS' + 3D effect
+NSWSOLVER = 1 ! 0: 'McICA 1: 'SPARTACUS' 2: 'SPARTACUS' + 3D effect
+#endif
+! LEFF3D = .TRUE.
+! LSIDEM = .TRUE.
+NREG = 3 ! Number of cloudy regions (3=TripleClouds)
+! LLWCSCA = .TRUE. ! LW cloud scattering
+! LLWASCA = .TRUE. ! LW aerosols scattering
+NLWSCATTERING = 2
+NAERMACC = 0
+! CGAS = 'RRTMG-IFS' ! Gas optics model
+NOVLP = 1 ! overlap assumption ; 0= 'Max-Ran' ; 1= 'Exp-Ran'; 2 = 'Exp-Exp'
+NLIQOPT = 3 ! 1: 'Monochromatic', 2: 'HuStamnes', 3: 'SOCRATES', 4: 'Slingo'
+NICEOPT = 3 ! 1: 'Monochromatic', 2: 'Fu-PSRAD', 3: 'Fu-IFS', 4: 'Baran', 5: 'Baran2016', 6: 'Baran2017'
+! LSW_ML_E = .FALSE.
+! LLW_ML_E = .FALSE.
+! LPSRAD = .FALSE.
+!
+NRADLP = 1 ! 0: ERA-15, 1: Zhang and Rossow, 2: Martin (1994) et Woods (2000)
+NRADIP = 1 ! 0: 40 mum, 1: Liou and Ou (1994), 2: Liou and Ou (1994) improved, 3: Sun and Rikus (1999)
+XCLOUD_FRAC_STD = 1.0_JPRB ! change to 0.75 for more realistic distribution
+#endif
+!-------------------------------------------------------------------------------
+!
+!* 14. SET DEFAULT VALUES FOR MODD_BLANK_n :
+! -----------------------------------
+!
+XDUMMY1 = 0.
+XDUMMY2 = 0.
+XDUMMY3 = 0.
+XDUMMY4 = 0.
+XDUMMY5 = 0.
+XDUMMY6 = 0.
+XDUMMY7 = 0.
+XDUMMY8 = 0.
+!
+NDUMMY1 = 0
+NDUMMY2 = 0
+NDUMMY3 = 0
+NDUMMY4 = 0
+NDUMMY5 = 0
+NDUMMY6 = 0
+NDUMMY7 = 0
+NDUMMY8 = 0
+!
+LDUMMY1 = .TRUE.
+LDUMMY2 = .TRUE.
+LDUMMY3 = .TRUE.
+LDUMMY4 = .TRUE.
+LDUMMY5 = .TRUE.
+LDUMMY6 = .TRUE.
+LDUMMY7 = .TRUE.
+LDUMMY8 = .TRUE.
+!
+CDUMMY1 = ' '
+CDUMMY2 = ' '
+CDUMMY3 = ' '
+CDUMMY4 = ' '
+CDUMMY5 = ' '
+CDUMMY6 = ' '
+CDUMMY7 = ' '
+CDUMMY8 = ' '
+!
+!------------------------------------------------------------------------------
+!
+!* 15. SET DEFAULT VALUES FOR MODD_FRC :
+! ---------------------------------
+!
+IF (KMI == 1) THEN
+ LGEOST_UV_FRC = .FALSE.
+ LGEOST_TH_FRC = .FALSE.
+ LTEND_THRV_FRC = .FALSE.
+ LTEND_UV_FRC = .FALSE.
+ LVERT_MOTION_FRC = .FALSE.
+ LRELAX_THRV_FRC = .FALSE.
+ LRELAX_UV_FRC = .FALSE.
+ LRELAX_UVMEAN_FRC = .FALSE.
+ XRELAX_TIME_FRC = 10800.
+ XRELAX_HEIGHT_FRC = 0.
+ CRELAX_HEIGHT_TYPE = "FIXE"
+ LTRANS = .FALSE.
+ XUTRANS = 0.0
+ XVTRANS = 0.0
+ LPGROUND_FRC = .FALSE.
+ LDEEPOC = .FALSE.
+ XCENTX_OC = 16000.
+ XCENTY_OC = 16000.
+ XRADX_OC = 8000.
+ XRADY_OC = 8000.
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 16. SET DEFAULT VALUES FOR MODD_PARAM_ICE :
+! ---------------------------------------
+!
+IF (KMI == 1) THEN
+ LRED = .TRUE.
+ LWARM = .TRUE.
+ CPRISTINE_ICE = 'PLAT'
+ LSEDIC = .TRUE.
+ LCONVHG = .FALSE.
+ CSEDIM = 'SPLI'
+ LFEEDBACKT = .TRUE.
+ LEVLIMIT = .TRUE.
+ LNULLWETG = .TRUE.
+ LWETGPOST = .TRUE.
+ LNULLWETH = .TRUE.
+ LWETHPOST = .TRUE.
+ CSNOWRIMING = 'M90 '
+ CSUBG_RC_RR_ACCR = 'NONE'
+ CSUBG_RR_EVAP = 'NONE'
+ CSUBG_PR_PDF = 'SIGM'
+ XFRACM90 = 0.1
+ LCRFLIMIT = .TRUE.
+ NMAXITER = 5
+ XMRSTEP = 0.00005
+ XTSTEP_TS = 0.
+ LADJ_BEFORE = .TRUE.
+ LADJ_AFTER = .TRUE.
+ CFRAC_ICE_ADJUST = 'S'
+ XSPLIT_MAXCFL = 0.8
+ CFRAC_ICE_SHALLOW_MF = 'S'
+ LSEDIM_AFTER = .FALSE.
+ LDEPOSC = .FALSE.
+ XVDEPOSC= 0.02 ! 2 cm/s
+ LSNOW_T=.FALSE.
+ LPACK_INTERP=.TRUE.
+ LPACK_MICRO=.TRUE. ! Meso-NH does not work with LPACK_MICRO=.FALSE.
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 17. SET DEFAULT VALUES FOR MODD_PARAM_KAFR_n :
+! --------------------------------------------
+!
+XDTCONV = MAX( 300.0,XTSTEP )
+NICE = 1
+LREFRESH_ALL = .TRUE.
+LCHTRANS = .FALSE.
+LDOWN = .TRUE.
+LSETTADJ = .FALSE.
+XTADJD = 3600.
+XTADJS = 10800.
+LDIAGCONV = .FALSE.
+NENSM = 0
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 18. SET DEFAULT VALUES FOR MODD_PARAM_MFSHALL_n :
+! --------------------------------------------
+!
+XIMPL_MF = 1.
+CMF_UPDRAFT = 'EDKF'
+CMF_CLOUD = 'DIRE'
+LMIXUV = .TRUE.
+LMF_FLX = .FALSE.
+!
+XALP_PERT = 0.3
+XABUO = 1.
+XBENTR = 1.
+XBDETR = 0.
+XCMF = 0.065
+XENTR_MF = 0.035
+XCRAD_MF = 50.
+XENTR_DRY = 0.55
+XDETR_DRY = 10.
+XDETR_LUP = 1.
+XKCF_MF = 2.75
+XKRC_MF = 1.
+XTAUSIGMF = 600.
+XPRES_UV = 0.5
+XFRAC_UP_MAX= 0.33
+XALPHA_MF = 2.
+XSIGMA_MF = 20.
+!
+XA1 = 2./3.
+XB = 0.002
+XC = 0.012
+XBETA1 = 0.9
+XR = 2.
+XLAMBDA_MF= 0.
+LGZ = .FALSE.
+XGZ = 1.83 ! between 1.83 and 1.33
+!
+!-------------------------------------------------------------------------------
+!
+!* 19. SET DEFAULT VALUES FOR MODD_PARAM_C2R2 :
+! ----------------------------------------
+!
+IF (KMI == 1) THEN
+ XNUC = 1.0
+ XALPHAC = 3.0
+ XNUR = 2.0
+ XALPHAR = 1.0
+!
+ LRAIN = .TRUE.
+ LSEDC = .TRUE.
+ LACTIT = .FALSE.
+ LSUPSAT = .FALSE.
+ LDEPOC = .FALSE.
+ XVDEPOC = 0.02 ! 2 cm/s
+ LACTTKE = .TRUE.
+!
+ HPARAM_CCN = 'XXX'
+ HINI_CCN = 'XXX'
+ HTYPE_CCN = 'X'
+!
+ XCHEN = 0.0
+ XKHEN = 0.0
+ XMUHEN = 0.0
+ XBETAHEN = 0.0
+!
+ XCONC_CCN = 0.0
+ XAERDIFF = 0.0
+ XAERHEIGHT = 2000
+ XR_MEAN_CCN = 0.0
+ XLOGSIG_CCN = 0.0
+ XFSOLUB_CCN = 1.0
+ XACTEMP_CCN = 280.
+ENDIF
+!
+!-------------------------------------------------------------------------------
+!
+!* 19.BIS SET DEFAULT VALUES FOR MODD_PARAM_LIMA :
+! ----------------------------------------
+!
+IF (KMI == 1) THEN
+ LPTSPLIT = .TRUE.
+ L_LFEEDBACKT = .TRUE.
+ L_NMAXITER = 1
+ L_XMRSTEP = 0.
+ L_XTSTEP_TS = 0.
+!
+ YNUC = 1.0
+ YALPHAC = 3.0
+ YNUR = 2.0
+ YALPHAR = 1.0
+!
+ LACTI = .TRUE.
+ OSEDC = .TRUE.
+ OACTIT = .FALSE.
+ LADJ = .TRUE.
+ LSPRO = .FALSE.
+ LKHKO = .FALSE.
+ ODEPOC = .TRUE.
+ LBOUND = .FALSE.
+ OACTTKE = .TRUE.
+ LKESSLERAC = .FALSE.
+!
+ NMOM_C = 2
+ NMOM_R = 2
+!
+ OVDEPOC = 0.02 ! 2 cm/s
+!
+ CINI_CCN = 'AER'
+ CTYPE_CCN(:) = 'M'
+!
+ YAERDIFF = 0.0
+ YAERHEIGHT = 2000.
+! YR_MEAN_CCN = 0.0 ! In case of 'CCN' initialization
+! YLOGSIG_CCN = 0.0
+ YFSOLUB_CCN = 1.0
+ YACTEMP_CCN = 280.
+!
+ NMOD_CCN = 1
+!
+!* AP Scavenging
+!
+ LSCAV = .FALSE.
+ LAERO_MASS = .FALSE.
+!
+ LCCN_HOM = .TRUE.
+ CCCN_MODES = 'COPT'
+ XCCN_CONC(:)=300.
+!
+ LHHONI = .FALSE.
+ LNUCL = .TRUE.
+ LSEDI = .TRUE.
+ YSNOW_T = .FALSE.
+ LMURAKAMI = .TRUE.
+ CPRISTINE_ICE_LIMA = 'PLAT'
+ CHEVRIMED_ICE_LIMA = 'GRAU'
+ XFACTNUC_DEP = 1.0
+ XFACTNUC_CON = 1.0
+ NMOM_I = 2
+ NMOM_S = 1
+ NMOM_G = 1
+ NMOM_H = 1
+ NMOD_IFN = 1
+ NIND_SPECIE = 1
+ LMEYERS = .FALSE.
+ LIFN_HOM = .TRUE.
+ CIFN_SPECIES = 'PHILLIPS'
+ CINT_MIXING = 'DM2'
+ XIFN_CONC(:) = 100.
+ NMOD_IMM = 0
+ NPHILLIPS=8
+ LCIBU = .FALSE.
+ XNDEBRIS_CIBU = 50.0
+ LRDSF = .FALSE.
+ENDIF
+!
+!-------------------------------------------------------------------------------
+!
+!* 20. SET DEFAULT VALUES FOR MODD_CH_MNHC_n
+! -------------------------------------
+!
+LUSECHEM = .FALSE.
+LUSECHAQ = .FALSE.
+LUSECHIC = .FALSE.
+LCH_INIT_FIELD = .FALSE.
+LCH_CONV_SCAV = .FALSE.
+LCH_CONV_LINOX = .FALSE.
+LCH_PH = .FALSE.
+LCH_RET_ICE = .FALSE.
+XCH_PHINIT = 5.2
+XRTMIN_AQ = 5.e-8
+CCHEM_INPUT_FILE = 'EXSEG1.nam'
+CCH_TDISCRETIZATION = 'SPLIT'
+NCH_SUBSTEPS = 1
+LCH_TUV_ONLINE = .FALSE.
+CCH_TUV_LOOKUP = 'PHOTO.TUV39'
+CCH_TUV_CLOUDS = 'NONE'
+XCH_TUV_ALBNEW = -1.
+XCH_TUV_DOBNEW = -1.
+XCH_TUV_TUPDATE = 600.
+CCH_VEC_METHOD = 'MAX'
+NCH_VEC_LENGTH = 50
+XCH_TS1D_TSTEP = 600.
+CCH_TS1D_COMMENT = 'no comment'
+CCH_TS1D_FILENAME = 'IO1D'
+CSPEC_PRODLOSS = ''
+CSPEC_BUDGET = ''
+!
+!-------------------------------------------------------------------------------
+!
+!* 21. SET DEFAULT VALUES FOR MODD_SERIES AND MODD_SERIE_n
+! ---------------------------------------------------
+!
+IF (KMI == 1) THEN
+ LSERIES = .FALSE.
+ LMASKLANDSEA = .FALSE.
+ LWMINMAX = .FALSE.
+ LSURF = .FALSE.
+ENDIF
+!
+NIBOXL = 1 !+ JPHEXT
+NIBOXH = 1 !+ 2*JPHEXT
+NJBOXL = 1 !+ JPHEXT
+NJBOXH = 1 !+ 2*JPHEXT
+NKCLS = 1 !+ JPVEXT
+NKLOW = 1 !+ JPVEXT
+NKMID = 1 !+ JPVEXT
+NKUP = 1 !+ JPVEXT
+NKCLA = 1 !+ JPVEXT
+NBJSLICE = 1
+NJSLICEL(:) = 1 !+ JPHEXT
+NJSLICEH(:) = 1 !+ 2*JPHEXT
+NFREQSERIES = INT(XSEGLEN /(100.*XTSTEP) )
+NFREQSERIES = MAX(NFREQSERIES,1)
+!
+!-------------------------------------------------------------------------------
+!
+!* 22. SET DEFAULT VALUES FOR MODD_TURB_CLOUD
+! --------------------------------------
+!
+IF (KMI == 1) THEN
+ NMODEL_CLOUD = NUNDEF
+ CTURBLEN_CLOUD = 'DELT'
+ XCOEF_AMPL_SAT = 5.
+ XCEI_MIN = 0.001E-06
+ XCEI_MAX = 0.01E-06
+ENDIF
+!-------------------------------------------------------------------------------
+!
+!* 22. SET DEFAULT VALUES FOR MODD_MEAN_FIELD
+! --------------------------------------
+!
+IF (KMI == 1) THEN
+ LMEAN_FIELD = .FALSE.
+ LCOV_FIELD = .FALSE.
+ENDIF
+!
+!-------------------------------------------------------------------------------
+!
+!* 22. SET DEFAULT VALUES FOR MODD_AEROSOL
+! -----------------------------------
+IF (KMI == 1) THEN ! other values are defined in modd_ch_aerosol
+!
+! aerosol lognormal parameterization
+
+LVARSIGI = .FALSE. ! switch to active pronostic dispersion for I mode
+LVARSIGJ = .FALSE. ! switch to active pronostic dispersion for J mode
+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
+CNUCLEATION = "NONE" ! sulfates nucleation scheme
+LDEPOS_AER(:) = .FALSE.
+
+ENDIF
+
+!* 23. SET DEFAULT VALUES FOR MODD_DUST and MODD_SALT
+! ----------------------------------------------
+!
+IF (KMI == 1) THEN ! other values initialized in modd_dust
+ LDUST = .FALSE.
+ NMODE_DST = 3
+ LVARSIG = .FALSE.
+ LSEDIMDUST = .FALSE.
+ LDEPOS_DST(:) = .FALSE.
+
+ LSALT = .FALSE.
+ LVARSIG_SLT= .FALSE.
+ LSEDIMSALT = .FALSE.
+ LDEPOS_SLT(:) = .FALSE.
+ENDIF
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 24. SET DEFAULT VALUES FOR MODD_PASPOL
+! ----------------------------------
+!
+! other values initialized in modd_paspol
+!
+IF (KMI == 1) THEN
+ LPASPOL = .FALSE.
+ NRELEASE = 0
+ CPPINIT(:) ='1PT'
+ XPPLAT(:) = 0.
+ XPPLON (:) = 0.
+ XPPMASS(:) = 0.
+ XPPBOT(:) = 0.
+ XPPTOP(:) = 0.
+ CPPT1(:) = "20010921090000"
+ CPPT2(:) = "20010921090000"
+ CPPT3(:) = "20010921091500"
+ CPPT4(:) = "20010921091500"
+ENDIF
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 25. SET DEFAULT VALUES FOR MODD_CONDSAMP
+! ----------------------------------
+!
+! other values initialized in modd_condsamp
+!
+IF (KMI == 1) THEN
+ LCONDSAMP = .FALSE.
+ NCONDSAMP = 3
+ XRADIO(:) = 900.
+ XSCAL(:) = 1.
+ XHEIGHT_BASE = 100.
+ XDEPTH_BASE = 100.
+ XHEIGHT_TOP = 100.
+ XDEPTH_TOP = 100.
+ NFINDTOP = 0
+ XTHVP = 0.25
+ LTPLUS = .TRUE.
+ENDIF
+!-------------------------------------------------------------------------------
+!
+!
+!* 26. SET DEFAULT VALUES FOR MODD_LATZ_EDFLX
+! ----------------------------------
+!
+IF (KMI == 1) THEN
+ LUV_FLX=.FALSE.
+ XUV_FLX1=3.E+14
+ XUV_FLX2=0.
+ LTH_FLX=.FALSE.
+ XTH_FLX=0.75
+ENDIF
+#ifdef MNH_FOREFIRE
+!-------------------------------------------------------------------------------
+!
+!* 27. SET DEFAULT VALUES FOR MODD_FOREFIRE
+! ----------------------------------
+!
+! other values initialized in modd_forefire
+!
+IF (KMI == 1) THEN
+ LFOREFIRE = .FALSE.
+ LFFCHEM = .FALSE.
+ COUPLINGRES = 100.
+ NFFSCALARS = 0
+ENDIF
+#endif
+!-------------------------------------------------------------------------------
+!
+!* 28. SET DEFAULT VALUES FOR MODD_BLOWSNOW AND MODD_BLOWSNOW_n
+! ----------------------------------------
+!
+IF (KMI == 1) THEN
+ LBLOWSNOW = .FALSE.
+ XALPHA_SNOW = 3.
+ XRSNOW = 4.
+ CSNOWSEDIM = 'TABC'
+END IF
+LSNOWSUBL = .FALSE.
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 29. SET DEFAULT VALUES FOR MODD_VISC
+! ----------------------------------
+!
+! other values initialized in modd_VISC
+!
+IF (KMI == 1) THEN
+ LVISC = .FALSE.
+ LVISC_UVW = .FALSE.
+ LVISC_TH = .FALSE.
+ LVISC_SV = .FALSE.
+ LVISC_R = .FALSE.
+ XMU_V = 0.
+ XPRANDTL = 0.
+ENDIF
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 30. SET DEFAULT VALUES FOR MODD_DRAG
+! ----------------------------------
+!
+! other values initialized in modd_DRAG
+!
+IF (KMI == 1) THEN
+ LDRAG = .FALSE.
+ LMOUNT = .FALSE.
+ NSTART = 1
+ XHSTART = 0.
+ENDIF
+!
+!-------------------------------------------------------------------------------
+!
+!* 31. SET DEFAULT VALUES FOR MODD_IBM_PARAMn
+! --------------------------------------
+!
+ LIBM = .FALSE.
+ LIBM_TROUBLE = .FALSE.
+ CIBM_ADV = 'NOTHIN'
+ XIBM_EPSI = 1.E-9
+ XIBM_IEPS = 1.E+9
+ NIBM_ITR = 8
+ XIBM_RUG = 0.01 ! (m^1.s^-0)
+ XIBM_VISC = 1.56e-5 ! (m^2.s^-1)
+ XIBM_CNU = 0.06 ! (m^0.s^-0)
+
+ NIBM_LAYER_P = 2
+ NIBM_LAYER_Q = 2
+ NIBM_LAYER_R = 2
+ NIBM_LAYER_S = 2
+ NIBM_LAYER_T = 2
+ NIBM_LAYER_E = 2
+ NIBM_LAYER_V = 2
+
+ XIBM_RADIUS_P = 2.
+ XIBM_RADIUS_Q = 2.
+ XIBM_RADIUS_R = 2.
+ XIBM_RADIUS_S = 2.
+ XIBM_RADIUS_T = 2.
+ XIBM_RADIUS_E = 2.
+ XIBM_RADIUS_V = 2.
+
+ XIBM_POWERS_P = 1.
+ XIBM_POWERS_Q = 1.
+ XIBM_POWERS_R = 1.
+ XIBM_POWERS_S = 1.
+ XIBM_POWERS_T = 1.
+ XIBM_POWERS_E = 1.
+ XIBM_POWERS_V = 1.
+
+ CIBM_MODE_INTE3_P = 'LAI'
+ CIBM_MODE_INTE3_Q = 'LAI'
+ CIBM_MODE_INTE3_R = 'LAI'
+ CIBM_MODE_INTE3_S = 'LAI'
+ CIBM_MODE_INTE3_T = 'LAI'
+ CIBM_MODE_INTE3_E = 'LAI'
+ CIBM_MODE_INTE3_V = 'LAI'
+
+ CIBM_MODE_INTE1_P = 'CL2'
+ CIBM_MODE_INTE1_Q = 'CL2'
+ CIBM_MODE_INTE1_R = 'CL2'
+ CIBM_MODE_INTE1_S = 'CL2'
+ CIBM_MODE_INTE1_T = 'CL2'
+ CIBM_MODE_INTE1_E = 'CL2'
+ CIBM_MODE_INTE1NV = 'CL2'
+ CIBM_MODE_INTE1TV = 'CL2'
+ CIBM_MODE_INTE1CV = 'CL2'
+
+ CIBM_MODE_BOUND_P = 'SYM'
+ CIBM_MODE_BOUND_Q = 'SYM'
+ CIBM_MODE_BOUND_R = 'SYM'
+ CIBM_MODE_BOUND_S = 'SYM'
+ CIBM_MODE_BOUND_T = 'SYM'
+ CIBM_MODE_BOUND_E = 'SYM'
+ CIBM_MODE_BOUNT_V = 'ASY'
+ CIBM_MODE_BOUNN_V = 'ASY'
+ CIBM_MODE_BOUNC_V = 'ASY'
+
+ XIBM_FORC_BOUND_P = 0.
+ XIBM_FORC_BOUND_Q = 0.
+ XIBM_FORC_BOUND_R = 0.
+ XIBM_FORC_BOUND_S = 0.
+ XIBM_FORC_BOUND_T = 0.
+ XIBM_FORC_BOUND_E = 0.
+ XIBM_FORC_BOUNN_V = 0.
+ XIBM_FORC_BOUNT_V = 0.
+ XIBM_FORC_BOUNC_V = 0.
+
+ CIBM_TYPE_BOUND_P = 'NEU'
+ CIBM_TYPE_BOUND_Q = 'NEU'
+ CIBM_TYPE_BOUND_R = 'NEU'
+ CIBM_TYPE_BOUND_S = 'NEU'
+ CIBM_TYPE_BOUND_T = 'NEU'
+ CIBM_TYPE_BOUND_E = 'NEU'
+ CIBM_TYPE_BOUNT_V = 'DIR'
+ CIBM_TYPE_BOUNN_V = 'DIR'
+ CIBM_TYPE_BOUNC_V = 'DIR'
+
+ CIBM_FORC_BOUND_P = 'CST'
+ CIBM_FORC_BOUND_Q = 'CST'
+ CIBM_FORC_BOUND_R = 'CST'
+ CIBM_FORC_BOUND_S = 'CST'
+ CIBM_FORC_BOUND_T = 'CST'
+ CIBM_FORC_BOUND_E = 'CST'
+ CIBM_FORC_BOUNN_V = 'CST'
+ CIBM_FORC_BOUNT_V = 'CST'
+ CIBM_FORC_BOUNC_V = 'CST'
+ CIBM_FORC_BOUNR_V = 'CST'
+
+!
+!-------------------------------------------------------------------------------
+!
+!* 32. SET DEFAULT VALUES FOR MODD_RECYCL_PARAMn
+! --------------------------------------
+!
+ LRECYCL = .FALSE.
+ LRECYCLN = .FALSE.
+ LRECYCLW = .FALSE.
+ LRECYCLE = .FALSE.
+ LRECYCLS = .FALSE.
+ XDRECYCLN = 0.
+ XARECYCLN = 0.
+ XDRECYCLW = 0.
+ XARECYCLW = 0.
+ XDRECYCLS = 0.
+ XARECYCLS = 0.
+ XDRECYCLE = 0.
+ XARECYCLE = 0.
+ NTMOY = 0
+ NTMOYCOUNT = 0
+ NNUMBELT = 28
+ XRCOEFF = 0.2
+ XTBVTOP = 500.
+ XTBVBOT = 300.
+!
+!-------------------------------------------------------------------------------
+!
+!* 33. SET DEFAULT VALUES FOR MODD_FIRE_n
+! ----------------------------------
+!
+! Blaze fire model namelist
+!
+LBLAZE = .FALSE. ! Flag for Fire model use, default FALSE
+!
+CPROPAG_MODEL = 'SANTONI2011' ! Fire propagation model (default SANTONI2011)
+!
+CHEAT_FLUX_MODEL = 'EXS' ! Sensible heat flux injection model (default EXS)
+CLATENT_FLUX_MODEL = 'EXP' ! latent heat flux injection model (default EXP)
+XFERR = 0.8 ! Energy released in flamming stage (only for EXP)
+!
+CFIRE_CPL_MODE = '2WAYCPL' ! Coupling mode (default 2way coupled)
+CBMAPFILE = CINIFILE ! File name of BMAP for FIR2ATM mode
+LINTERPWIND = .TRUE. ! Horizontal interpolation of wind
+LSGBAWEIGHT = .FALSE. ! Flag for use of weighted average method for SubGrid Burning Area computation
+!
+NFIRE_WENO_ORDER = 3 ! Weno order (1,3,5)
+NFIRE_RK_ORDER = 3 ! Runge Kutta order (1,2,3,4)
+!
+NREFINX = 1 ! Refinement ratio X
+NREFINY = 1 ! Refinement ratio Y
+!
+XCFLMAXFIRE = 0.8 ! Max CFL on fire mesh
+XLSDIFFUSION = 0.1 ! Numerical diffusion of LevelSet
+XROSDIFFUSION = 0.05 ! Numerical diffusion of ROS
+!
+XFLUXZEXT = 3. ! Flux distribution on vertical caracteristic length
+XFLUXZMAX = 4. * XFLUXZEXT ! Flux distribution on vertical max injetion height
+!
+XFLXCOEFTMP = 1. ! Flux multiplicator. For testing
+!
+LWINDFILTER = .FALSE. ! Fire wind filtering flag
+CWINDFILTER = 'EWAM' ! Wind filter method (EWAM or WLIM)
+XEWAMTAU = 20. ! Time averaging constant for EWAM method (s)
+XWLIMUTH = 8. ! Thresehold wind value for WLIM method (m/s)
+XWLIMUTMAX = 9. ! Maximum wind value for WLIM method (m/s) (needs to be >= XWLIMUTH )
+!
+NNBSMOKETRACER = 1 ! Nb of smoke tracers
+!
+NWINDSLOPECPLMODE = 0 ! Flag for use of wind/slope in ROS (0 = wind + slope, 1 = wind only, 2 = slope only (U0=0))
+!
+!
+!
+!! DO NOT CHANGE BELOW PARAMETERS
+XFIREMESHSIZE(:) = 0. ! Fire mesh size (dxf,dyf)
+LRESTA_ASE = .FALSE. ! Flag for using ASE in RESTA file
+LRESTA_AWC = .FALSE. ! Flag for using AWC in RESTA file
+LRESTA_EWAM = .FALSE. ! Flag for using EWAM in RESTA file
+LRESTA_WLIM = .FALSE. ! Flag for using WLIM in RESTA file
+
+!-------------------------------------------------------------------------------
+END SUBROUTINE DEFAULT_DESFM_n
diff --git a/src/PHYEX/ext/drag_veg.f90 b/src/PHYEX/ext/drag_veg.f90
new file mode 100644
index 0000000000000000000000000000000000000000..de7fba893e0ef87438979ff249a803c7fd382864
--- /dev/null
+++ b/src/PHYEX/ext/drag_veg.f90
@@ -0,0 +1,362 @@
+!MNH_LIC Copyright 2009-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_DRAG_VEG
+! #######################
+!
+INTERFACE
+
+SUBROUTINE DRAG_VEG(PTSTEP,PUT,PVT,PTKET,ODEPOTREE, PVDEPOTREE, &
+ HCLOUD,PPABST,PTHT,PRT,PSVT, &
+ PRHODJ,PZZ,PRUS, PRVS, PRTKES, &
+ PRRS,PSVS)
+!
+REAL, INTENT(IN) :: PTSTEP ! Time step
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PUT, PVT ! variables
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKET ! at t
+LOGICAL, INTENT(IN) :: ODEPOTREE ! Droplet deposition on tree
+REAL, INTENT(IN) :: PVDEPOTREE! Velocity deposition on tree
+CHARACTER (LEN=4), INTENT(IN) :: HCLOUD ! Kind of microphysical scheme
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! at t
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT ! at t
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVT ! at t
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! dry Density * Jacobian
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Height (z)
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRUS, PRVS ! Sources of Momentum
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRTKES ! Sources of Tke
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRRS
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVS
+!
+END SUBROUTINE DRAG_VEG
+
+END INTERFACE
+
+END MODULE MODI_DRAG_VEG
+!
+! ###################################################################
+SUBROUTINE DRAG_VEG(PTSTEP,PUT,PVT,PTKET,ODEPOTREE, PVDEPOTREE, &
+ HCLOUD,PPABST,PTHT,PRT,PSVT, &
+ PRHODJ,PZZ,PRUS, PRVS, PRTKES, &
+ PRRS,PSVS)
+! ###################################################################
+!
+!!**** *DRAG_VEG_n * -
+!!
+!! PURPOSE
+!! -------
+!
+!!** METHOD
+!! ------
+!!
+!! REFERENCE
+!! ---------
+!!
+!!
+!! AUTHOR
+!! ------
+!! P. Aumond
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 07/2009
+!! C.Lac 07/2011 : Add budgets
+!! S. Donier 06/2015 : bug surface aerosols
+!! C.Lac 07/2016 : Add droplet deposition
+!! C.Lac 10/2017 : Correction on deposition
+! C. Lac 11/2019: correction in the drag formula and application to building in addition to tree
+! P. Wautelet 28/01/2020: use the new data structures and subroutines for budgets for U
+! C. Lac 02/2020: correction missing condition for budget on RC and SV
+! P. Wautelet 04/02/2021: budgets: bugfixes for LDRAGTREE if LIMA + small optimisations and verifications
+! R. Schoetter 04/2022: bug add update halo for vegetation drag variables
+!!---------------------------------------------------------------
+!
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_ARGSLIST_ll, ONLY: LIST_ll
+use modd_budget, only: lbudget_u, lbudget_v, lbudget_rc, lbudget_sv, lbudget_tke, &
+ NBUDGET_U, NBUDGET_V, NBUDGET_RC, NBUDGET_SV1, NBUDGET_TKE, &
+ tbudgets
+USE MODD_CONF
+USE MODD_CST
+USE MODD_DYN
+USE MODD_DYN_n
+USE MODD_GROUND_PAR
+USE MODD_NSV
+USE MODD_PARAM_C2R2
+USE MODD_PARAM_LIMA, ONLY: NMOM_C
+USE MODD_PARAM_n, only: CSURF, CTURB
+USE MODD_PGDFIELDS
+USE MODD_VEG_n
+
+use mode_budget, only: Budget_store_init, Budget_store_end
+use mode_msg
+USE MODE_ll
+
+USE MODI_MNHGET_SURF_PARAM_n
+USE MODI_SHUMAN
+
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+REAL, INTENT(IN) :: PTSTEP ! Time step
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PUT, PVT ! variables
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKET ! at t
+LOGICAL, INTENT(IN) :: ODEPOTREE ! Droplet deposition on tree
+REAL, INTENT(IN) :: PVDEPOTREE! Velocity deposition on tree
+CHARACTER (LEN=4), INTENT(IN) :: HCLOUD ! Kind of microphysical scheme
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! at t
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT ! at t
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVT ! at t
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! dry Density * Jacobian
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Height (z)
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRUS, PRVS ! Sources of Momentum
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRTKES ! Sources of Tke
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRRS
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVS
+!
+!* 0.2 Declarations of local variables :
+!
+INTEGER :: IIU,IJU,IKU,IKV ! array size along the k direction
+INTEGER :: JI, JJ, JK ! loop index
+INTEGER :: IINFO_ll
+TYPE(LIST_ll), POINTER :: TZFIELDS_ll ! list of fields to exchange
+!
+!
+REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: &
+ ZWORK1, ZWORK2, ZWORK3, ZUT_SCAL, ZVT_SCAL, &
+ ZUS, ZVS, ZTKES, ZTKET
+REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: &
+ ZCDRAG, ZDENSITY
+REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2)) :: &
+ ZH,ZLAI ! LAI, Vegetation height
+REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)):: ZT,ZEXN,ZLV,ZCPH
+LOGICAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) &
+ :: GDEP
+REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)):: ZWDEPR,ZWDEPS
+
+IF ( CSURF /= 'EXTE' ) CALL PRINT_MSG( NVERB_FATAL, 'GEN', 'DRAG_VEG', 'CSURF/=EXTE not allowed' )
+
+!Condition necessary because PTKET is used (and must be allocated)
+IF ( CTURB /= 'TKEL' ) CALL PRINT_MSG( NVERB_FATAL, 'GEN', 'DRAG_VEG', 'CTURB/=TKEL not allowed' )
+!
+if ( lbudget_u ) call Budget_store_init( tbudgets(NBUDGET_U ), 'DRAG', prus (:, :, :) )
+if ( lbudget_v ) call Budget_store_init( tbudgets(NBUDGET_V ), 'DRAG', prvs (:, :, :) )
+if ( lbudget_tke ) call Budget_store_init( tbudgets(NBUDGET_TKE), 'DRAG', prtkes(:, :, :) )
+
+if ( odepotree ) then
+ if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'DEPOTR', prrs(:, :, :, 2) )
+ if ( lbudget_sv .and. ( hcloud=='C2R2' .or. hcloud=='KHKO' ) ) &
+ call Budget_store_init( tbudgets(NBUDGET_SV1-1+(NSV_C2R2BEG+1)), 'DEPOTR', psvs(:, :, :, NSV_C2R2BEG+1) )
+ if ( lbudget_sv .and. hcloud=='LIMA' ) &
+ call Budget_store_init( tbudgets(NBUDGET_SV1-1+NSV_LIMA_NC), 'DEPOTR', psvs(:, :, :, NSV_LIMA_NC) )
+end if
+
+IIU = SIZE(PUT,1)
+IJU = SIZE(PUT,2)
+IKU = SIZE(PUT,3)
+!
+ZUS (:,:,:) = 0.0
+ZVS (:,:,:) = 0.0
+ZTKES (:,:,:) = 0.0
+!
+ZH (:,:) = XUNDEF
+ZLAI(:,:) = XUNDEF
+!
+ZCDRAG (:,:,:) = 0.
+ZDENSITY (:,:,:) = 0.
+!
+CALL MNHGET_SURF_PARAM_n( PH_TREE = ZH, PLAI_TREE = ZLAI )
+!
+WHERE ( ZH (:,:) > (XUNDEF-1.) ) ZH (:,:) = 0.0
+WHERE ( ZLAI (:,:) > (XUNDEF-1.) ) ZLAI (:,:) = 0.0
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 1. COMPUTES THE TRUE VELOCITY COMPONENTS
+! -------------------------------------
+!
+ZUT_SCAL(:,:,:) = MXF(PUT(:,:,:))
+ZVT_SCAL(:,:,:) = MYF(PVT(:,:,:))
+ZTKET(:,:,:) = PTKET(:,:,:)
+!
+! Update halo
+!
+NULLIFY(TZFIELDS_ll)
+CALL ADD3DFIELD_ll( TZFIELDS_ll, ZUT_SCAL, 'DRAG_VEG::ZUT_SCAL')
+CALL ADD3DFIELD_ll( TZFIELDS_ll, ZVT_SCAL, 'DRAG_VEG::ZVT_SCAL')
+CALL ADD3DFIELD_ll( TZFIELDS_ll, ZTKET , 'DRAG_VEG::ZTKET' )
+CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
+CALL CLEANLIST_ll(TZFIELDS_ll)
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. Computations of wind tendency due to canopy drag
+! ------------------------------------------------
+!
+!
+!
+! Ext = - Cdrag * u- * u- * Sv tree canopy drag
+! - u'w'(ground) * Sh horizontal surfaces (ground)
+!
+!* 1.1 Drag coefficient by vegetation (Patton et al 2001)
+! ------------------------------
+!
+GDEP(:,:,:) = .FALSE.
+!
+DO JJ=2,(IJU-1)
+ DO JI=2,(IIU-1)
+ !
+ ! Set density and drag coefficient for vegetation
+ !
+ IF (ZH(JI,JJ) /= 0) THEN
+ !
+ DO JK=2,(IKU-1)
+ !
+ IF ( (PZZ(JI,JJ,JK)-PZZ(JI,JJ,2)) .LT. ZH(JI,JJ) ) THEN
+ !
+ IF ((HCLOUD=='C2R2') .OR. (HCLOUD=='KHKO')) THEN
+ IF ((PRRS(JI,JJ,JK,2) >0.) .AND. (PSVS(JI,JJ,JK,NSV_C2R2BEG+1) >0.)) &
+ GDEP(JI,JJ,JK) = .TRUE.
+ ELSE IF (HCLOUD /= 'NONE' .AND. HCLOUD /= 'REVE') THEN
+ IF (PRRS(JI,JJ,JK,2) >0.) GDEP(JI,JJ,JK) = .TRUE.
+ ENDIF
+ !
+ ZCDRAG(JI,JJ,JK) = 0.2 !0.075
+ ZDENSITY(JI,JJ,JK) = MAX((4 * (ZLAI(JI,JJ) *&
+ (PZZ(JI,JJ,JK)-PZZ(JI,JJ,2)) *&
+ (PZZ(JI,JJ,JK)-PZZ(JI,JJ,2)) *&
+ (ZH(JI,JJ)-(PZZ(JI,JJ,JK)-PZZ(JI,JJ,2)))/&
+ ZH(JI,JJ)**3)-&
+ (0.30*((ZLAI(JI,JJ) *&
+ (PZZ(JI,JJ,JK)-PZZ(JI,JJ,2)) *&
+ (PZZ(JI,JJ,JK)-PZZ(JI,JJ,2)) *&
+ (PZZ(JI,JJ,JK)-PZZ(JI,JJ,2)) /&
+ (ZH(JI,JJ)**3))-ZLAI(JI,JJ))))/&
+ ZH(JI,JJ), 0.)
+ !
+ ENDIF
+ !
+ ENDDO
+ ENDIF
+ !
+ ENDDO
+ENDDO
+!
+! To exclude the first vertical level already dealt in rain_ice or rain_c2r2_khko
+GDEP(:,:,2) = .FALSE.
+!
+! Update halo
+!
+NULLIFY(TZFIELDS_ll)
+CALL ADD3DFIELD_ll( TZFIELDS_ll, ZCDRAG , 'DRAG_VEG::ZCDRAG')
+CALL ADD3DFIELD_ll( TZFIELDS_ll, ZDENSITY, 'DRAG_VEG::ZDENSITY')
+CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
+CALL CLEANLIST_ll(TZFIELDS_ll)
+!
+!
+!* 1.2 Drag force by wall surfaces
+! ---------------------------
+!
+!* drag force by vertical surfaces
+!
+ZUS(:,:,:) = PUT(:,:,:)/( 1.0 + MXM ( ZCDRAG(:,:,:) * ZDENSITY(:,:,:) &
+ * PTSTEP * SQRT(ZUT_SCAL(:,:,:)**2+ZVT_SCAL(:,:,:)**2) ) )
+!
+ZVS(:,:,:) = PVT(:,:,:)/( 1.0 + MYM ( ZCDRAG(:,:,:) * ZDENSITY(:,:,:) &
+ * PTSTEP * SQRT(ZUT_SCAL(:,:,:)**2+ZVT_SCAL(:,:,:)**2) ) )
+!
+PRUS(:,:,:) = PRUS(:,:,:) + (ZUS(:,:,:)-PUT(:,:,:)) * MXM(PRHODJ(:,:,:)) / PTSTEP
+!
+PRVS(:,:,:) = PRVS(:,:,:) + (ZVS(:,:,:)-PVT(:,:,:)) * MYM(PRHODJ(:,:,:)) / PTSTEP
+!
+IF (ODEPOTREE) THEN
+ IF ( HCLOUD == 'NONE' ) CALL PRINT_MSG( NVERB_FATAL, 'GEN', 'DRAG_VEG', 'LDEPOTREE=T not allowed if CCLOUD=NONE' )
+ IF ( HCLOUD == 'LIMA' .AND. NMOM_C.EQ.0 ) &
+ CALL PRINT_MSG( NVERB_FATAL, 'GEN', 'DRAG_VEG', 'LDEPOTREE=T not allowed if CCLOUD=LIMA and NMOM_C=0' )
+
+ ZEXN(:,:,:)= (PPABST(:,:,:)/XP00)**(XRD/XCPD)
+ ZT(:,:,:)= PTHT(:,:,:)*ZEXN(:,:,:)
+ ZLV(:,:,:)=XLVTT +(XCPV-XCL) *(ZT(:,:,:)-XTT)
+ ZCPH(:,:,:)=XCPD +XCPV*PRT(:,:,:,1)
+ ZWDEPR(:,:,:)= 0.
+ ZWDEPS(:,:,:)= 0.
+ WHERE (GDEP)
+ ZWDEPR(:,:,:)= PVDEPOTREE * PRT(:,:,:,2) * PRHODJ(:,:,:)
+ END WHERE
+ IF ( HCLOUD == 'C2R2' .OR. HCLOUD == 'KHKO' ) THEN
+ WHERE (GDEP)
+ ZWDEPS(:,:,:)= PVDEPOTREE * PSVT(:,:,:,NSV_C2R2BEG+1) * PRHODJ(:,:,:)
+ END WHERE
+ ELSE IF ( HCLOUD == 'LIMA' ) THEN
+ WHERE (GDEP)
+ ZWDEPS(:,:,:)= PVDEPOTREE * PSVT(:,:,:,NSV_LIMA_NC) * PRHODJ(:,:,:)
+ END WHERE
+ END IF
+ DO JJ=2,(IJU-1)
+ DO JI=2,(IIU-1)
+ DO JK=2,(IKU-2)
+ IF (GDEP(JI,JJ,JK)) THEN
+ PRRS(JI,JJ,JK,2) = PRRS(JI,JJ,JK,2) + (ZWDEPR(JI,JJ,JK+1)-ZWDEPR(JI,JJ,JK))/ &
+ (PZZ(JI,JJ,JK+1)-PZZ(JI,JJ,JK))
+ IF ( HCLOUD == 'C2R2' .OR. HCLOUD == 'KHKO' ) THEN
+ PSVS(JI,JJ,JK,NSV_C2R2BEG+1) = PSVS(JI,JJ,JK,NSV_C2R2BEG+1) + &
+ (ZWDEPS(JI,JJ,JK+1)-ZWDEPS(JI,JJ,JK))/(PZZ(JI,JJ,JK+1)-PZZ(JI,JJ,JK))
+ ELSE IF ( HCLOUD == 'LIMA' ) THEN
+ PSVS(JI,JJ,JK,NSV_LIMA_NC) = PSVS(JI,JJ,JK,NSV_LIMA_NC) + &
+ (ZWDEPS(JI,JJ,JK+1)-ZWDEPS(JI,JJ,JK))/(PZZ(JI,JJ,JK+1)-PZZ(JI,JJ,JK))
+ END IF
+ END IF
+ END DO
+ END DO
+ END DO
+!
+!
+END IF
+!
+!* 3. Computations of TKE tendency due to canopy drag
+! ------------------------------------------------
+
+!* 3.1 Creation of TKE by wake
+! -----------------------
+!
+! from Kanda and Hino (1994)
+!
+! Ext = + Cd * u+^3 * Sv/Vair vertical surfaces or trees
+! Ext = - Cd * e * u * Sv trees Destruction of TKE due to
+! small-scale motions forced by leaves from Kanda and Hino (1994)
+!
+! with Vair = Vair/Vtot * Vtot = (Vair/Vtot) * Stot * Dz
+! and Sv/Vair = (Sv/Stot) * Stot/Vair = (Sv/Stot) / (Vair/Vtot) / Dz
+!
+ZTKES(:,:,:)= ( ZTKET(:,:,:) + PTSTEP * ZCDRAG(:,:,:) * ZDENSITY(:,:,:) &
+ * (SQRT( ZUT_SCAL(:,:,:)**2 + ZVT_SCAL(:,:,:)**2 ))**3 ) / &
+ ( 1. + PTSTEP * ZCDRAG(:,:,:) * ZDENSITY(:,:,:) * SQRT(ZUT_SCAL(:,:,:)**2+ZVT_SCAL(:,:,:)**2))
+!
+PRTKES(:,:,:) = PRTKES(:,:,:) + (ZTKES(:,:,:)-ZTKET(:,:,:))*PRHODJ(:,:,:)/PTSTEP
+
+if ( lbudget_u ) call Budget_store_end( tbudgets(NBUDGET_U ), 'DRAG', prus (:, :, :) )
+if ( lbudget_v ) call Budget_store_end( tbudgets(NBUDGET_V ), 'DRAG', prvs (:, :, :) )
+if ( lbudget_tke ) call Budget_store_end( tbudgets(NBUDGET_TKE), 'DRAG', prtkes(:, :, :) )
+
+if ( odepotree ) then
+ if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'DEPOTR', prrs(:, :, :, 2) )
+ if ( lbudget_sv .and. ( hcloud=='C2R2' .or. hcloud=='KHKO' ) ) &
+ call Budget_store_end( tbudgets(NBUDGET_SV1-1+(NSV_C2R2BEG+1)), 'DEPOTR', psvs(:, :, :, NSV_C2R2BEG+1) )
+ if ( lbudget_sv .and. hcloud=='LIMA' ) &
+ call Budget_store_end( tbudgets(NBUDGET_SV1-1+NSV_LIMA_NC), 'DEPOTR', psvs(:, :, :, NSV_LIMA_NC) )
+end if
+
+END SUBROUTINE DRAG_VEG
diff --git a/src/PHYEX/ext/ini_budget.f90 b/src/PHYEX/ext/ini_budget.f90
new file mode 100644
index 0000000000000000000000000000000000000000..ebcaec1c7ac8cd89aca300cd3662cf18ff2be3a2
--- /dev/null
+++ b/src/PHYEX/ext/ini_budget.f90
@@ -0,0 +1,4886 @@
+!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.
+!-----------------------------------------------------------------
+! Modifications:
+! P. Wautelet 17/08/2020: add Budget_preallocate subroutine
+!-----------------------------------------------------------------
+module mode_ini_budget
+
+ use mode_msg
+
+ implicit none
+
+ private
+
+ public :: Budget_preallocate, Ini_budget
+
+ integer, parameter :: NSOURCESMAX = 60 !Maximum number of sources in a budget
+
+contains
+
+subroutine Budget_preallocate()
+
+use modd_budget, only: nbudgets, tbudgets, &
+ NBUDGET_U, NBUDGET_V, NBUDGET_W, NBUDGET_TH, NBUDGET_TKE, &
+ NBUDGET_RV, NBUDGET_RC, NBUDGET_RR, NBUDGET_RI, NBUDGET_RS, &
+ NBUDGET_RG, NBUDGET_RH, NBUDGET_SV1
+use modd_nsv, only: nsv, tsvlist
+
+integer :: ibudget
+integer :: jsv
+
+call Print_msg( NVERB_DEBUG, 'BUD', 'Budget_preallocate', 'called' )
+
+if ( allocated( tbudgets ) ) then
+ call Print_msg( NVERB_WARNING, 'BUD', 'Budget_preallocate', 'tbudgets already allocated' )
+ return
+end if
+
+nbudgets = NBUDGET_SV1 - 1 + nsv
+allocate( tbudgets( nbudgets ) )
+
+tbudgets(NBUDGET_U)%cname = "UU"
+tbudgets(NBUDGET_U)%ccomment = "Budget for U"
+tbudgets(NBUDGET_U)%nid = NBUDGET_U
+
+tbudgets(NBUDGET_V)%cname = "VV"
+tbudgets(NBUDGET_V)%ccomment = "Budget for V"
+tbudgets(NBUDGET_V)%nid = NBUDGET_V
+
+tbudgets(NBUDGET_W)%cname = "WW"
+tbudgets(NBUDGET_W)%ccomment = "Budget for W"
+tbudgets(NBUDGET_W)%nid = NBUDGET_W
+
+tbudgets(NBUDGET_TH)%cname = "TH"
+tbudgets(NBUDGET_TH)%ccomment = "Budget for potential temperature"
+tbudgets(NBUDGET_TH)%nid = NBUDGET_TH
+
+tbudgets(NBUDGET_TKE)%cname = "TK"
+tbudgets(NBUDGET_TKE)%ccomment = "Budget for turbulent kinetic energy"
+tbudgets(NBUDGET_TKE)%nid = NBUDGET_TKE
+
+tbudgets(NBUDGET_RV)%cname = "RV"
+tbudgets(NBUDGET_RV)%ccomment = "Budget for water vapor mixing ratio"
+tbudgets(NBUDGET_RV)%nid = NBUDGET_RV
+
+tbudgets(NBUDGET_RC)%cname = "RC"
+tbudgets(NBUDGET_RC)%ccomment = "Budget for cloud water mixing ratio"
+tbudgets(NBUDGET_RC)%nid = NBUDGET_RC
+
+tbudgets(NBUDGET_RR)%cname = "RR"
+tbudgets(NBUDGET_RR)%ccomment = "Budget for rain water mixing ratio"
+tbudgets(NBUDGET_RR)%nid = NBUDGET_RR
+
+tbudgets(NBUDGET_RI)%cname = "RI"
+tbudgets(NBUDGET_RI)%ccomment = "Budget for cloud ice mixing ratio"
+tbudgets(NBUDGET_RI)%nid = NBUDGET_RI
+
+tbudgets(NBUDGET_RS)%cname = "RS"
+tbudgets(NBUDGET_RS)%ccomment = "Budget for snow/aggregate mixing ratio"
+tbudgets(NBUDGET_RS)%nid = NBUDGET_RS
+
+tbudgets(NBUDGET_RG)%cname = "RG"
+tbudgets(NBUDGET_RG)%ccomment = "Budget for graupel mixing ratio"
+tbudgets(NBUDGET_RG)%nid = NBUDGET_RG
+
+tbudgets(NBUDGET_RH)%cname = "RH"
+tbudgets(NBUDGET_RH)%ccomment = "Budget for hail mixing ratio"
+tbudgets(NBUDGET_RH)%nid = NBUDGET_RH
+
+do jsv = 1, nsv
+ ibudget = NBUDGET_SV1 - 1 + jsv
+ tbudgets(ibudget)%cname = Trim( tsvlist(jsv)%cmnhname )
+ tbudgets(ibudget)%ccomment = 'Budget for scalar variable ' // Trim( tsvlist(jsv)%cmnhname )
+ tbudgets(ibudget)%nid = ibudget
+end do
+
+
+end subroutine Budget_preallocate
+
+
+! #################################################################
+ SUBROUTINE Ini_budget(KLUOUT,PTSTEP,KSV,KRR, &
+ ONUMDIFU,ONUMDIFTH,ONUMDIFSV, &
+ 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, &
+ HRAD,HDCONV,HSCONV,HTURB,HTURBDIM,HCLOUD )
+! #################################################################
+!
+!!**** *INI_BUDGET* - routine to initialize the parameters for the budgets
+!!
+!! PURPOSE
+!! -------
+! The purpose of this routine is to set or compute the parameters used
+! by the MESONH budgets. Names of files for budget recording are processed
+! and storage arrays are initialized.
+!
+!!** METHOD
+!! ------
+!! The essential of information is passed by modules. The choice of budgets
+!! and processes set by the user as integers is converted in "actions"
+!! readable by the subroutine BUDGET under the form of string characters.
+!! For each complete process composed of several elementary processes, names
+!! of elementary processes are concatenated in order to have an explicit name
+!! in the comment of the recording file for budget.
+!!
+!!
+!! EXTERNAL
+!! --------
+!! None
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Modules MODD_*
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation (routine INI_BUDGET)
+!!
+!!
+!! AUTHOR
+!! ------
+!! P. Hereil * Meteo France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 01/03/95
+!! J. Stein 25/06/95 put the sources in phase with the code
+!! J. Stein 20/07/95 reset to FALSE of all the switches when
+!! CBUTYPE /= MASK or CART
+!! J. Stein 26/06/96 add the new sources + add the increment between
+!! 2 active processes
+!! J.-P. Pinty 13/12/96 Allowance of multiple SVs
+!! J.-P. Pinty 11/01/97 Includes deep convection ice and forcing processes
+!! J.-P. Lafore 10/02/98 Allocation of the RHODJs for budget
+!! V. Ducrocq 04/06/99 //
+!! N. Asencio 18/06/99 // MASK case : delete KIMAX and KJMAX arguments,
+!! GET_DIM_EXT_ll initializes the dimensions of the
+!! extended local domain.
+!! LBU_MASK and NBUSURF are allocated on the extended
+!! local domain.
+!! add 3 local variables IBUDIM1,IBUDIM2,IBUDIM3
+!! to define the dimensions of the budget arrays
+!! in the different cases CART and MASK
+!! J.-P. Pinty 23/09/00 add budget for C2R2
+!! V. Masson 18/11/02 add budget for 2way nesting
+!! O.Geoffroy 03/2006 Add KHKO scheme
+!! J.-P. Pinty 22/04/97 add the explicit hail processes
+!! C.Lac 10/08/07 Add ADV for PPM without contribution
+!! of each direction
+!! C. Barthe 19/11/09 Add atmospheric electricity
+!! C.Lac 01/07/11 Add vegetation drag
+!! P. Peyrille, M. Tomasini : include in the forcing term the 2D forcing
+!! terms in term 2DFRC search for modif PP . but Not very clean!
+!! C .Lac 27/05/14 add negativity corrections for chemical species
+!! C.Lac 29/01/15 Correction for NSV_USER
+!! J.Escobar 02/10/2015 modif for JPHEXT(JPVEXT) variable
+!! C.Lac 04/12/15 Correction for LSUPSAT
+! C. Lac 04/2016: negative contribution to the budget split between advection, turbulence and microphysics for KHKO/C2R2
+! C. Barthe 01/2016: add budget for LIMA
+! C. Lac 10/2016: add budget for droplet deposition
+! S. Riette 11/2016: new budgets for ICE3/ICE4
+! P. Wautelet 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
+! P. Wautelet 15/11/2019: remove unused CBURECORD variable
+! P. Wautelet 24/02/2020: bugfix: corrected condition for budget NCDEPITH
+! P. Wautelet 26/02/2020: bugfix: rename CEVA->REVA for budget for raindrop evaporation in C2R2 (necessary after commit 4ed805fc)
+! P. Wautelet 26/02/2020: bugfix: add missing condition on OCOLD for NSEDIRH budget in LIMA case
+! P. Wautelet 02-03/2020: use the new data structures and subroutines for budgets
+! B. Vie 02/03/2020: LIMA negativity checks after turbulence, advection and microphysics budgets
+! P .Wautelet 09/03/2020: add missing budgets for electricity
+! P. Wautelet 25/03/2020: add missing ove_relax_grd
+! P. Wautelet 23/04/2020: add nid in tbudgetdata datatype
+! P. Wautelet + Benoit Vié 11/06/2020: improve removal of negative scalar variables + adapt the corresponding budgets
+! P. Wautelet 30/06/2020: use NADVSV when possible
+! P. Wautelet 30/06/2020: add NNETURSV, NNEADVSV and NNECONSV variables
+! P. Wautelet 06/07/2020: bugfix: add condition on HTURB for NETUR sources for SV budgets
+! P. Wautelet 08/12/2020: add nbusubwrite and nbutotwrite
+! P. Wautelet 11/01/2021: ignore xbuwri for cartesian boxes (write at every xbulen interval)
+! P. Wautelet 01/02/2021: bugfix: add missing CEDS source terms for SV budgets
+! P. Wautelet 02/02/2021: budgets: add missing source terms for SV budgets in LIMA
+! P. Wautelet 03/02/2021: budgets: add new source if LIMA splitting: CORR2
+! P. Wautelet 10/02/2021: budgets: add missing sources for NSV_C2R2BEG+3 budget
+! P. Wautelet 11/02/2021: budgets: add missing term SCAV for NSV_LIMA_SCAVMASS budget
+! 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
+! 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
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+use modd_2d_frc, only: l2d_adv_frc, l2d_rel_frc
+use modd_blowsnow, only: lblowsnow
+use modd_blowsnow_n, only: lsnowsubl
+use modd_budget
+use modd_ch_aerosol, only: lorilam
+use modd_conf, only: l1d, lcartesian, lforcing, lthinshell, nmodel
+use modd_dim_n, only: nimax_ll, njmax_ll, nkmax
+use modd_dragbldg_n, only: ldragbldg
+use modd_dust, only: ldust
+use modd_dyn, only: lcorio, xseglen
+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_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, &
+#ifdef MNH_FOREFIRE
+ nsv_ffbeg, nsv_ffend, &
+#endif
+ nsv_lgbeg, nsv_lgend, &
+ nsv_lima_beg, nsv_lima_end, nsv_lima_ccn_acti, nsv_lima_ccn_free, nsv_lima_hom_haze, &
+ nsv_lima_ifn_free, nsv_lima_ifn_nucl, nsv_lima_imm_nucl, &
+ nsv_lima_nc, nsv_lima_nr, nsv_lima_ni, nsv_lima_ns, nsv_lima_ng, nsv_lima_nh, &
+ nsv_lima_scavmass, nsv_lima_spro, &
+ nsv_lnoxbeg, nsv_lnoxend, nsv_ppbeg, nsv_ppend, &
+ nsv_sltbeg, nsv_sltend, nsv_sltdepbeg, nsv_sltdepend, nsv_snwbeg, nsv_snwend, &
+ nsv_user, tsvlist
+use modd_parameters, only: jphext
+use modd_param_c2r2, only: ldepoc_c2r2 => ldepoc, lrain_c2r2 => lrain, lsedc_c2r2 => lsedc, lsupsat_c2r2 => lsupsat
+use modd_param_ice, only: ladj_after, ladj_before, ldeposc_ice => ldeposc, lred, lsedic_ice => lsedic, lwarm_ice => lwarm
+use modd_param_n, only: cactccn, celec
+use modd_param_lima, only: laero_mass_lima => laero_mass, lacti_lima => lacti, ldepoc_lima => ldepoc, &
+ lhhoni_lima => lhhoni, lmeyers_lima => lmeyers, lnucl_lima => lnucl, &
+ lptsplit, &
+ lscav_lima => lscav, lsedc_lima => lsedc, lsedi_lima => lsedi, &
+ lspro_lima => lspro, lcibu, lrdsf, &
+ 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_turb_n, only: lsubg_cond
+use modd_viscosity, only: lvisc, lvisc_r, lvisc_sv, lvisc_th, lvisc_uvw
+
+USE MODE_ll
+
+IMPLICIT NONE
+!
+!* 0.1 declarations of argument
+!
+!
+INTEGER, INTENT(IN) :: KLUOUT ! Logical unit number for prints
+REAL, INTENT(IN) :: PTSTEP ! time step
+INTEGER, INTENT(IN) :: KSV ! number of scalar variables
+INTEGER, INTENT(IN) :: KRR ! number of moist variables
+LOGICAL, INTENT(IN) :: ONUMDIFU ! switch to activate the numerical
+ ! diffusion for momentum
+LOGICAL, INTENT(IN) :: ONUMDIFTH ! for meteorological scalar variables
+LOGICAL, INTENT(IN) :: ONUMDIFSV ! for tracer scalar variables
+LOGICAL, INTENT(IN) :: OHORELAX_UVWTH ! switch for the
+ ! horizontal relaxation for U,V,W,TH
+LOGICAL, INTENT(IN) :: OHORELAX_RV ! switch for the
+ ! horizontal relaxation for Rv
+LOGICAL, INTENT(IN) :: OHORELAX_RC ! switch for the
+ ! horizontal relaxation for Rc
+LOGICAL, INTENT(IN) :: OHORELAX_RR ! switch for the
+ ! horizontal relaxation for Rr
+LOGICAL, INTENT(IN) :: OHORELAX_RI ! switch for the
+ ! horizontal relaxation for Ri
+LOGICAL, INTENT(IN) :: OHORELAX_RS ! switch for the
+ ! horizontal relaxation for Rs
+LOGICAL, INTENT(IN) :: OHORELAX_RG ! switch for the
+ ! horizontal relaxation for Rg
+LOGICAL, INTENT(IN) :: OHORELAX_RH ! switch for the
+ ! horizontal relaxation for Rh
+LOGICAL, INTENT(IN) :: OHORELAX_TKE ! switch for the
+ ! horizontal relaxation for tke
+LOGICAL,DIMENSION(:),INTENT(IN):: OHORELAX_SV ! switch for the
+ ! horizontal relaxation for scalar variables
+LOGICAL, INTENT(IN) :: OVE_RELAX ! switch to activate the vertical
+ ! relaxation
+logical, intent(in) :: ove_relax_grd ! switch to activate the vertical
+ ! relaxation to the lowest verticals
+LOGICAL, INTENT(IN) :: OCHTRANS ! switch to activate convective
+ !transport for SV
+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) :: 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
+CHARACTER (LEN=*), INTENT(IN) :: HSCONV ! type of the shallow convection scheme
+CHARACTER (LEN=*), INTENT(IN) :: HTURB ! type of the turbulence scheme
+CHARACTER (LEN=*), INTENT(IN) :: HTURBDIM! dimensionnality of the turbulence
+ ! scheme
+CHARACTER (LEN=*), INTENT(IN) :: HCLOUD ! type of microphysical scheme
+!
+!* 0.2 declarations of local variables
+!
+real, parameter :: ITOL = 1e-6
+
+INTEGER :: JI, JJ ! loop indices
+INTEGER :: IIMAX_ll, IJMAX_ll ! size of the physical global domain
+INTEGER :: IIU, IJU ! size along x and y directions
+ ! of the extended subdomain
+INTEGER :: IBUDIM1 ! first dimension of the budget arrays
+ ! = NBUIMAX in CART case
+ ! = NBUKMAX in MASK case
+INTEGER :: IBUDIM2 ! second dimension of the budget arrays
+ ! = NBUJMAX in CART case
+ ! = nbusubwrite in MASK case
+INTEGER :: IBUDIM3 ! third dimension of the budget arrays
+ ! = NBUKMAX in CART case
+ ! = NBUMASK in MASK case
+INTEGER :: JSV ! loop indice for the SVs
+INTEGER :: IINFO_ll ! return status of the interface routine
+integer :: ibudget
+logical :: gtmp
+type(tbusourcedata) :: tzsource ! Used to prepare metadate of source terms
+
+call Print_msg( NVERB_DEBUG, 'BUD', 'Ini_budget', 'called' )
+!
+!* 1. COMPUTE BUDGET VARIABLES
+! ------------------------
+!
+NBUSTEP = NINT (XBULEN / PTSTEP)
+NBUTSHIFT=0
+!
+! common dimension for all CBUTYPE values
+!
+IF (LBU_KCP) THEN
+ NBUKMAX = 1
+ELSE
+ NBUKMAX = NBUKH - NBUKL +1
+END IF
+!
+if ( cbutype == 'CART' .or. cbutype == 'MASK' ) then
+ !Check if xbulen is a multiple of xtstep (within tolerance)
+ if ( Abs( Nint( xbulen / xtstep ) * xtstep - xbulen ) > ( ITOL * xtstep ) ) &
+ call Print_msg( NVERB_WARNING, 'BUD', 'Ini_budget', 'xbulen is not a multiple of xtstep' )
+
+ if ( cbutype == 'CART' ) then
+ !Check if xseglen is a multiple of xbulen (within tolerance)
+ if ( Abs( Nint( xseglen / xbulen ) * xbulen - xseglen ) > ( ITOL * xseglen ) ) &
+ call Print_msg( NVERB_WARNING, 'BUD', 'Ini_budget', 'xseglen is not a multiple of xbulen' )
+
+ !Write cartesian budgets every xbulen time period (do not take xbuwri into account)
+ xbuwri = xbulen
+
+ nbusubwrite = 1 !Number of budget time average periods for each write
+ nbutotwrite = nbusubwrite * Nint( xseglen / xbulen ) !Total number of budget time average periods
+ else if ( cbutype == 'MASK' ) then
+ !Check if xbuwri is a multiple of xtstep (within tolerance)
+ if ( Abs( Nint( xbuwri / xtstep ) * xtstep - xbuwri ) > ( ITOL * xtstep ) ) &
+ call Print_msg( NVERB_WARNING, 'BUD', 'Ini_budget', 'xbuwri is not a multiple of xtstep' )
+
+ !Check if xbuwri is a multiple of xbulen (within tolerance)
+ if ( Abs( Nint( xbuwri / xbulen ) * xbulen - xbuwri ) > ( ITOL * xbulen ) ) &
+ call Print_msg( NVERB_WARNING, 'BUD', 'Ini_budget', 'xbuwri is not a multiple of xbulen' )
+
+ !Check if xseglen is a multiple of xbuwri (within tolerance)
+ if ( Abs( Nint( xseglen / xbuwri ) * xbuwri - xseglen ) > ( ITOL * xseglen ) ) &
+ call Print_msg( NVERB_WARNING, 'BUD', 'Ini_budget', 'xseglen is not a multiple of xbuwri' )
+
+ nbusubwrite = Nint ( xbuwri / xbulen ) !Number of budget time average periods for each write
+ nbutotwrite = nbusubwrite * Nint( xseglen / xbuwri ) !Total number of budget time average periods
+ end if
+end if
+
+IF (CBUTYPE=='CART') THEN ! cartesian case only
+!
+ IF ( NBUIL < 1 ) CALL Print_msg( NVERB_ERROR, 'BUD', 'Ini_budget', 'NBUIL too small (<1)' )
+ IF ( NBUIL > NIMAX_ll ) CALL Print_msg( NVERB_ERROR, 'BUD', 'Ini_budget', 'NBUIL too large (>NIMAX)' )
+ IF ( NBUIH < 1 ) CALL Print_msg( NVERB_ERROR, 'BUD', 'Ini_budget', 'NBUIH too small (<1)' )
+ IF ( NBUIH > NIMAX_ll ) CALL Print_msg( NVERB_ERROR, 'BUD', 'Ini_budget', 'NBUIH too large (>NIMAX)' )
+ IF ( NBUIH < NBUIL ) CALL Print_msg( NVERB_ERROR, 'BUD', 'Ini_budget', 'NBUIH < NBUIL' )
+ IF (LBU_ICP) THEN
+ NBUIMAX_ll = 1
+ ELSE
+ NBUIMAX_ll = NBUIH - NBUIL +1
+ END IF
+
+ IF ( NBUJL < 1 ) CALL Print_msg( NVERB_ERROR, 'BUD', 'Ini_budget', 'NBUJL too small (<1)' )
+ IF ( NBUJL > NJMAX_ll ) CALL Print_msg( NVERB_ERROR, 'BUD', 'Ini_budget', 'NBUJL too large (>NJMAX)' )
+ IF ( NBUJH < 1 ) CALL Print_msg( NVERB_ERROR, 'BUD', 'Ini_budget', 'NBUJH too small (<1)' )
+ IF ( NBUJH > NJMAX_ll ) CALL Print_msg( NVERB_ERROR, 'BUD', 'Ini_budget', 'NBUJH too large (>NJMAX)' )
+ IF ( NBUJH < NBUJL ) CALL Print_msg( NVERB_ERROR, 'BUD', 'Ini_budget', 'NBUJH < NBUJL' )
+ IF (LBU_JCP) THEN
+ NBUJMAX_ll = 1
+ ELSE
+ NBUJMAX_ll = NBUJH - NBUJL +1
+ END IF
+
+ IF ( NBUKL < 1 ) CALL Print_msg( NVERB_ERROR, 'BUD', 'Ini_budget', 'NBUKL too small (<1)' )
+ IF ( NBUKL > NKMAX ) CALL Print_msg( NVERB_ERROR, 'BUD', 'Ini_budget', 'NBUKL too large (>NKMAX)' )
+ IF ( NBUKH < 1 ) CALL Print_msg( NVERB_ERROR, 'BUD', 'Ini_budget', 'NBUKH too small (<1)' )
+ IF ( NBUKH > NKMAX ) CALL Print_msg( NVERB_ERROR, 'BUD', 'Ini_budget', 'NBUKH too large (>NKMAX)' )
+ IF ( NBUKH < NBUKL ) CALL Print_msg( NVERB_ERROR, 'BUD', 'Ini_budget', 'NBUKH < NBUKL' )
+
+ CALL GET_INTERSECTION_ll(NBUIL+JPHEXT,NBUJL+JPHEXT,NBUIH+JPHEXT,NBUJH+JPHEXT, &
+ NBUSIL,NBUSJL,NBUSIH,NBUSJH,"PHYS",IINFO_ll)
+ IF ( IINFO_ll /= 1 ) THEN !
+ IF (LBU_ICP) THEN
+ NBUIMAX = 1
+ ELSE
+ NBUIMAX = NBUSIH - NBUSIL +1
+ END IF
+ IF (LBU_JCP) THEN
+ NBUJMAX = 1
+ ELSE
+ NBUJMAX = NBUSJH - NBUSJL +1
+ END IF
+ ELSE ! the intersection is void
+ CBUTYPE='SKIP' ! no budget on this processor
+ NBUIMAX = 0 ! in order to allocate void arrays
+ NBUJMAX = 0
+ ENDIF
+! three first dimensions of budget arrays in cart and skip cases
+ IBUDIM1=NBUIMAX
+ IBUDIM2=NBUJMAX
+ IBUDIM3=NBUKMAX
+! these variables are not be used
+ NBUMASK=-1
+!
+ELSEIF (CBUTYPE=='MASK') THEN ! mask case only
+!
+ LBU_ENABLE=.TRUE.
+ ! result on the FM_FILE
+ NBUTIME = 1
+
+ CALL GET_DIM_EXT_ll ('B', IIU,IJU)
+ ALLOCATE( LBU_MASK( IIU ,IJU, NBUMASK) )
+ LBU_MASK(:,:,:)=.FALSE.
+ ALLOCATE( NBUSURF( IIU, IJU, NBUMASK, nbusubwrite) )
+ NBUSURF(:,:,:,:) = 0
+!
+! three first dimensions of budget arrays in mask case
+! the order of the dimensions are the order expected in WRITE_DIACHRO routine:
+! x,y,z,time,mask,processus and in this case x and y are missing
+! first dimension of the arrays : dimension along K
+! second dimension of the arrays : number of the budget time period
+! third dimension of the arrays : number of the budget masks zones
+ IBUDIM1=NBUKMAX
+ IBUDIM2=nbusubwrite
+ IBUDIM3=NBUMASK
+! these variables are not used in this case
+ NBUIMAX=-1
+ NBUJMAX=-1
+! the beginning and the end along x and y direction : global extended domain
+ ! get dimensions of the physical global domain
+ CALL GET_GLOBALDIMS_ll (IIMAX_ll,IJMAX_ll)
+ NBUIL=1
+ NBUIH=IIMAX_ll + 2 * JPHEXT
+ NBUJL=1
+ NBUJH=IJMAX_ll + 2 * JPHEXT
+!
+ELSE ! default case
+!
+ LBU_ENABLE=.FALSE.
+ NBUIMAX = -1
+ NBUJMAX = -1
+ LBU_RU = .FALSE.
+ LBU_RV = .FALSE.
+ LBU_RW = .FALSE.
+ LBU_RTH= .FALSE.
+ LBU_RTKE= .FALSE.
+ LBU_RRV= .FALSE.
+ LBU_RRC= .FALSE.
+ LBU_RRR= .FALSE.
+ LBU_RRI= .FALSE.
+ LBU_RRS= .FALSE.
+ LBU_RRG= .FALSE.
+ LBU_RRH= .FALSE.
+ LBU_RSV= .FALSE.
+!
+! three first dimensions of budget arrays in default case
+ IBUDIM1=0
+ IBUDIM2=0
+ IBUDIM3=0
+!
+END IF
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 2. ALLOCATE MEMORY FOR BUDGET ARRAYS AND INITIALIZE
+! ------------------------------------------------
+!
+LBU_BEG =.TRUE.
+!
+!-------------------------------------------------------------------------------
+!
+!* 3. INITALIZE VARIABLES
+! -------------------
+!
+!Create intermediate variable to store rhodj for scalar variables
+if ( lbu_rth .or. lbu_rtke .or. lbu_rrv .or. lbu_rrc .or. lbu_rrr .or. &
+ lbu_rri .or. lbu_rrs .or. lbu_rrg .or. lbu_rrh .or. lbu_rsv ) then
+ allocate( tburhodj )
+
+ tburhodj%cmnhname = 'RhodJS'
+ tburhodj%cstdname = ''
+ tburhodj%clongname = 'RhodJS'
+ tburhodj%cunits = 'kg'
+ tburhodj%ccomment = 'RhodJ for Scalars variables'
+ tburhodj%ngrid = 1
+ tburhodj%ntype = TYPEREAL
+ tburhodj%ndims = 3
+
+ allocate( tburhodj%xdata(ibudim1, ibudim2, ibudim3) )
+ tburhodj%xdata(:, :, :) = 0.
+end if
+
+
+tzsource%ntype = TYPEREAL
+tzsource%ndims = 3
+
+! Budget of RU
+tbudgets(NBUDGET_U)%lenabled = lbu_ru
+
+if ( lbu_ru ) then
+ allocate( tbudgets(NBUDGET_U)%trhodj )
+
+ tbudgets(NBUDGET_U)%trhodj%cmnhname = 'RhodJX'
+ tbudgets(NBUDGET_U)%trhodj%cstdname = ''
+ tbudgets(NBUDGET_U)%trhodj%clongname = 'RhodJX'
+ tbudgets(NBUDGET_U)%trhodj%cunits = 'kg'
+ tbudgets(NBUDGET_U)%trhodj%ccomment = 'RhodJ for momentum along X axis'
+ tbudgets(NBUDGET_U)%trhodj%ngrid = 2
+ tbudgets(NBUDGET_U)%trhodj%ntype = TYPEREAL
+ tbudgets(NBUDGET_U)%trhodj%ndims = 3
+
+ allocate( tbudgets(NBUDGET_U)%trhodj%xdata(ibudim1, ibudim2, ibudim3) )
+ tbudgets(NBUDGET_U)%trhodj%xdata(:, :, :) = 0.
+
+ !Allocate all basic source terms (used or not)
+ !The size should be large enough (bigger than necessary is OK)
+ tbudgets(NBUDGET_U)%nsourcesmax = NSOURCESMAX
+ allocate( tbudgets(NBUDGET_U)%tsources(NSOURCESMAX) )
+
+ allocate( tbudgets(NBUDGET_U)%xtmpstore(ibudim1, ibudim2, ibudim3) )
+
+ tbudgets(NBUDGET_U)%tsources(:)%ngroup = 0
+
+ tzsource%ccomment = 'Budget of momentum along X axis'
+ tzsource%ngrid = 2
+
+ tzsource%cunits = 'm s-1'
+
+ tzsource%cmnhname = 'INIF'
+ tzsource%clongname = 'initial state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_U), tzsource, odonotinit = .true., ooverwrite = .true. )
+
+ tzsource%cmnhname = 'ENDF'
+ tzsource%clongname = 'final state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_U), tzsource, odonotinit = .true., ooverwrite = .true. )
+
+ tzsource%cmnhname = 'AVEF'
+ tzsource%clongname = 'averaged state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_U), tzsource, odonotinit = .true., ooverwrite = .false. )
+
+ tzsource%cunits = 'm s-2'
+
+ tzsource%cmnhname = 'ASSE'
+ tzsource%clongname = 'time filter (Asselin)'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_U), tzsource )
+
+ tzsource%cmnhname = 'NEST'
+ tzsource%clongname = 'nesting'
+ tzsource%lavailable = nmodel > 1
+ call Budget_source_add( tbudgets(NBUDGET_U), tzsource )
+
+ tzsource%cmnhname = 'FRC'
+ tzsource%clongname = 'forcing'
+ tzsource%lavailable = lforcing
+ call Budget_source_add( tbudgets(NBUDGET_U), tzsource )
+
+ tzsource%cmnhname = 'NUD'
+ tzsource%clongname = 'nudging'
+ tzsource%lavailable = onudging
+ call Budget_source_add( tbudgets(NBUDGET_U), tzsource )
+
+ tzsource%cmnhname = 'CURV'
+ tzsource%clongname = 'curvature'
+ tzsource%lavailable = .not.l1d .and. .not.lcartesian
+ call Budget_source_add( tbudgets(NBUDGET_U), tzsource )
+
+ tzsource%cmnhname = 'COR'
+ tzsource%clongname = 'Coriolis'
+ tzsource%lavailable = lcorio
+ call Budget_source_add( tbudgets(NBUDGET_U), tzsource )
+
+ tzsource%cmnhname = 'DIF'
+ tzsource%clongname = 'numerical diffusion'
+ tzsource%lavailable = onumdifu
+ call Budget_source_add( tbudgets(NBUDGET_U), tzsource )
+
+ tzsource%cmnhname = 'REL'
+ tzsource%clongname = 'relaxation'
+ tzsource%lavailable = ohorelax_uvwth .or. ove_relax .or. ove_relax_grd
+ call Budget_source_add( tbudgets(NBUDGET_U), tzsource )
+
+ tzsource%cmnhname = 'DRAG'
+ tzsource%clongname = 'drag force due to trees'
+ tzsource%lavailable = odragtree
+ call Budget_source_add( tbudgets(NBUDGET_U), tzsource )
+
+ tzsource%cmnhname = 'DRAGEOL'
+ tzsource%clongname = 'drag force due to wind turbine'
+ tzsource%lavailable = OAERO_EOL
+ call Budget_source_add( tbudgets(NBUDGET_U), tzsource )
+
+ tzsource%cmnhname = 'DRAGB'
+ tzsource%clongname = 'drag force due to buildings'
+ tzsource%lavailable = ldragbldg
+ call Budget_source_add( tbudgets(NBUDGET_U), tzsource )
+
+ tzsource%cmnhname = 'VTURB'
+ tzsource%clongname = 'vertical turbulent diffusion'
+ tzsource%lavailable = hturb == 'TKEL'
+ call Budget_source_add( tbudgets(NBUDGET_U), tzsource )
+
+ tzsource%cmnhname = 'HTURB'
+ tzsource%clongname = 'horizontal turbulent diffusion'
+ tzsource%lavailable = hturb == 'TKEL' .and. HTURBDIM == '3DIM'
+ call Budget_source_add( tbudgets(NBUDGET_U), tzsource )
+
+ tzsource%cmnhname = 'MAFL'
+ tzsource%clongname = 'mass flux'
+ tzsource%lavailable = hsconv == 'EDKF'
+ call Budget_source_add( tbudgets(NBUDGET_U), tzsource )
+
+ tzsource%cmnhname = 'VISC'
+ tzsource%clongname = 'viscosity'
+ tzsource%lavailable = lvisc .and. lvisc_uvw
+ call Budget_source_add( tbudgets(NBUDGET_U), tzsource )
+
+ tzsource%cmnhname = 'ADV'
+ tzsource%clongname = 'advection'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_U), tzsource )
+
+ tzsource%cmnhname = 'PRES'
+ tzsource%clongname = 'pressure'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_U), tzsource )
+
+
+ call Sourcelist_sort_compact( tbudgets(NBUDGET_U) )
+
+ call Sourcelist_scan( tbudgets(NBUDGET_U), cbulist_ru )
+end if
+
+! Budget of RV
+tbudgets(NBUDGET_V)%lenabled = lbu_rv
+
+if ( lbu_rv ) then
+ allocate( tbudgets(NBUDGET_V)%trhodj )
+
+ tbudgets(NBUDGET_V)%trhodj%cmnhname = 'RhodJY'
+ tbudgets(NBUDGET_V)%trhodj%cstdname = ''
+ tbudgets(NBUDGET_V)%trhodj%clongname = 'RhodJY'
+ tbudgets(NBUDGET_V)%trhodj%cunits = 'kg'
+ tbudgets(NBUDGET_V)%trhodj%ccomment = 'RhodJ for momentum along Y axis'
+ tbudgets(NBUDGET_V)%trhodj%ngrid = 3
+ tbudgets(NBUDGET_V)%trhodj%ntype = TYPEREAL
+ tbudgets(NBUDGET_V)%trhodj%ndims = 3
+
+ allocate( tbudgets(NBUDGET_V)%trhodj%xdata(ibudim1, ibudim2, ibudim3) )
+ tbudgets(NBUDGET_V)%trhodj%xdata(:, :, :) = 0.
+
+ !Allocate all basic source terms (used or not)
+ !The size should be large enough (bigger than necessary is OK)
+ tbudgets(NBUDGET_V)%nsourcesmax = NSOURCESMAX
+ allocate( tbudgets(NBUDGET_V)%tsources(NSOURCESMAX) )
+
+ allocate( tbudgets(NBUDGET_V)%xtmpstore(ibudim1, ibudim2, ibudim3) )
+
+ tbudgets(NBUDGET_V)%tsources(:)%ngroup = 0
+
+ tzsource%ccomment = 'Budget of momentum along Y axis'
+ tzsource%ngrid = 3
+
+ tzsource%cunits = 'm s-1'
+
+ tzsource%cmnhname = 'INIF'
+ tzsource%clongname = 'initial state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_V), tzsource, odonotinit = .true., ooverwrite = .true. )
+
+ tzsource%cmnhname = 'ENDF'
+ tzsource%clongname = 'final state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_V), tzsource, odonotinit = .true., ooverwrite = .true. )
+
+ tzsource%cmnhname = 'AVEF'
+ tzsource%clongname = 'averaged state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_V), tzsource, odonotinit = .true., ooverwrite = .false. )
+
+ tzsource%cunits = 'm s-2'
+
+ tzsource%cmnhname = 'ASSE'
+ tzsource%clongname = 'time filter (Asselin)'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_V), tzsource )
+
+ tzsource%cmnhname = 'NEST'
+ tzsource%clongname = 'nesting'
+ tzsource%lavailable = nmodel > 1
+ call Budget_source_add( tbudgets(NBUDGET_V), tzsource )
+
+ tzsource%cmnhname = 'FRC'
+ tzsource%clongname = 'forcing'
+ tzsource%lavailable = lforcing
+ call Budget_source_add( tbudgets(NBUDGET_V), tzsource )
+
+ tzsource%cmnhname = 'NUD'
+ tzsource%clongname = 'nudging'
+ tzsource%lavailable = onudging
+ call Budget_source_add( tbudgets(NBUDGET_V), tzsource )
+
+ tzsource%cmnhname = 'CURV'
+ tzsource%clongname = 'curvature'
+ tzsource%lavailable = .not.l1d .and. .not.lcartesian
+ call Budget_source_add( tbudgets(NBUDGET_V), tzsource )
+
+ tzsource%cmnhname = 'COR'
+ tzsource%clongname = 'Coriolis'
+ tzsource%lavailable = lcorio
+ call Budget_source_add( tbudgets(NBUDGET_V), tzsource )
+
+ tzsource%cmnhname = 'DIF'
+ tzsource%clongname = 'numerical diffusion'
+ tzsource%lavailable = onumdifu
+ call Budget_source_add( tbudgets(NBUDGET_V), tzsource )
+
+ tzsource%cmnhname = 'REL'
+ tzsource%clongname = 'relaxation'
+ tzsource%lavailable = ohorelax_uvwth .or. ove_relax .or. ove_relax_grd
+ call Budget_source_add( tbudgets(NBUDGET_V), tzsource )
+
+ tzsource%cmnhname = 'DRAG'
+ tzsource%clongname = 'drag force due to trees'
+ tzsource%lavailable = odragtree
+ call Budget_source_add( tbudgets(NBUDGET_V), tzsource )
+
+ tzsource%cmnhname = 'DRAGEOL'
+ tzsource%clongname = 'drag force due to wind turbine'
+ tzsource%lavailable = OAERO_EOL
+ call Budget_source_add( tbudgets(NBUDGET_V), tzsource )
+
+ tzsource%cmnhname = 'DRAGB'
+ tzsource%clongname = 'drag force due to buildings'
+ tzsource%lavailable = ldragbldg
+ call Budget_source_add( tbudgets(NBUDGET_V), tzsource )
+
+ tzsource%cmnhname = 'VTURB'
+ tzsource%clongname = 'vertical turbulent diffusion'
+ tzsource%lavailable = hturb == 'TKEL'
+ call Budget_source_add( tbudgets(NBUDGET_V), tzsource )
+
+ tzsource%cmnhname = 'HTURB'
+ tzsource%clongname = 'horizontal turbulent diffusion'
+ tzsource%lavailable = hturb == 'TKEL' .and. HTURBDIM == '3DIM'
+ call Budget_source_add( tbudgets(NBUDGET_V), tzsource )
+
+ tzsource%cmnhname = 'MAFL'
+ tzsource%clongname = 'mass flux'
+ tzsource%lavailable = hsconv == 'EDKF'
+ call Budget_source_add( tbudgets(NBUDGET_V), tzsource )
+
+ tzsource%cmnhname = 'VISC'
+ tzsource%clongname = 'viscosity'
+ tzsource%lavailable = lvisc .and. lvisc_uvw
+ call Budget_source_add( tbudgets(NBUDGET_V), tzsource )
+
+ tzsource%cmnhname = 'ADV'
+ tzsource%clongname = 'advection'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_V), tzsource )
+
+ tzsource%cmnhname = 'PRES'
+ tzsource%clongname = 'pressure'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_V), tzsource )
+
+
+ call Sourcelist_sort_compact( tbudgets(NBUDGET_V) )
+
+ call Sourcelist_scan( tbudgets(NBUDGET_V), cbulist_rv )
+end if
+
+! Budget of RW
+tbudgets(NBUDGET_W)%lenabled = lbu_rw
+
+if ( lbu_rw ) then
+ allocate( tbudgets(NBUDGET_W)%trhodj )
+
+ tbudgets(NBUDGET_W)%trhodj%cmnhname = 'RhodJZ'
+ tbudgets(NBUDGET_W)%trhodj%cstdname = ''
+ tbudgets(NBUDGET_W)%trhodj%clongname = 'RhodJZ'
+ tbudgets(NBUDGET_W)%trhodj%cunits = 'kg'
+ tbudgets(NBUDGET_W)%trhodj%ccomment = 'RhodJ for momentum along Z axis'
+ tbudgets(NBUDGET_W)%trhodj%ngrid = 4
+ tbudgets(NBUDGET_W)%trhodj%ntype = TYPEREAL
+ tbudgets(NBUDGET_W)%trhodj%ndims = 3
+
+ allocate( tbudgets(NBUDGET_W)%trhodj%xdata(ibudim1, ibudim2, ibudim3) )
+ tbudgets(NBUDGET_W)%trhodj%xdata(:, :, :) = 0.
+
+ !Allocate all basic source terms (used or not)
+ !The size should be large enough (bigger than necessary is OK)
+ tbudgets(NBUDGET_W)%nsourcesmax = NSOURCESMAX
+ allocate( tbudgets(NBUDGET_W)%tsources(NSOURCESMAX) )
+
+ allocate( tbudgets(NBUDGET_W)%xtmpstore(ibudim1, ibudim2, ibudim3) )
+
+ tbudgets(NBUDGET_W)%tsources(:)%ngroup = 0
+
+ tzsource%ccomment = 'Budget of momentum along Z axis'
+ tzsource%ngrid = 4
+
+ tzsource%cunits = 'm s-1'
+
+ tzsource%cmnhname = 'INIF'
+ tzsource%clongname = 'initial state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_W), tzsource, odonotinit = .true., ooverwrite = .true. )
+
+ tzsource%cmnhname = 'ENDF'
+ tzsource%clongname = 'final state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_W), tzsource, odonotinit = .true., ooverwrite = .true. )
+
+ tzsource%cmnhname = 'AVEF'
+ tzsource%clongname = 'averaged state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_W), tzsource, odonotinit = .true., ooverwrite = .false. )
+
+ tzsource%cunits = 'm s-2'
+
+ tzsource%cmnhname = 'ASSE'
+ tzsource%clongname = 'time filter (Asselin)'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_W), tzsource )
+
+ tzsource%cmnhname = 'NEST'
+ tzsource%clongname = 'nesting'
+ tzsource%lavailable = nmodel > 1
+ call Budget_source_add( tbudgets(NBUDGET_W), tzsource )
+
+ tzsource%cmnhname = 'FRC'
+ tzsource%clongname = 'forcing'
+ tzsource%lavailable = lforcing
+ call Budget_source_add( tbudgets(NBUDGET_W), tzsource )
+
+ tzsource%cmnhname = 'NUD'
+ tzsource%clongname = 'nudging'
+ tzsource%lavailable = onudging
+ call Budget_source_add( tbudgets(NBUDGET_W), tzsource )
+
+ tzsource%cmnhname = 'CURV'
+ tzsource%clongname = 'curvature'
+ tzsource%lavailable = .not.l1d .and. .not.lcartesian .and. .not.lthinshell
+ call Budget_source_add( tbudgets(NBUDGET_W), tzsource )
+
+ tzsource%cmnhname = 'COR'
+ tzsource%clongname = 'Coriolis'
+ tzsource%lavailable = lcorio .and. .not.l1d .and. .not.lthinshell
+ call Budget_source_add( tbudgets(NBUDGET_W), tzsource )
+
+ tzsource%cmnhname = 'DIF'
+ tzsource%clongname = 'numerical diffusion'
+ tzsource%lavailable = onumdifu
+ call Budget_source_add( tbudgets(NBUDGET_W), tzsource )
+
+ tzsource%cmnhname = 'REL'
+ tzsource%clongname = 'relaxation'
+ tzsource%lavailable = ohorelax_uvwth .or. ove_relax .or. ove_relax_grd
+ call Budget_source_add( tbudgets(NBUDGET_W), tzsource )
+
+ tzsource%cmnhname = 'VTURB'
+ tzsource%clongname = 'vertical turbulent diffusion'
+ tzsource%lavailable = hturb == 'TKEL'
+ call Budget_source_add( tbudgets(NBUDGET_W), tzsource )
+
+ tzsource%cmnhname = 'HTURB'
+ tzsource%clongname = 'horizontal turbulent diffusion'
+ tzsource%lavailable = hturb == 'TKEL' .and. HTURBDIM == '3DIM'
+ call Budget_source_add( tbudgets(NBUDGET_W), tzsource )
+
+ tzsource%cmnhname = 'VISC'
+ tzsource%clongname = 'viscosity'
+ tzsource%lavailable = lvisc .and. lvisc_uvw
+ call Budget_source_add( tbudgets(NBUDGET_W), tzsource )
+
+ tzsource%cmnhname = 'GRAV'
+ tzsource%clongname = 'gravity'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_W), tzsource )
+
+ tzsource%cmnhname = 'ADV'
+ tzsource%clongname = 'advection'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_W), tzsource )
+
+ tzsource%cmnhname = 'PRES'
+ tzsource%clongname = 'pressure'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_W), tzsource )
+
+ tzsource%cmnhname = 'DRAGEOL'
+ tzsource%clongname = 'drag force due to wind turbine'
+ tzsource%lavailable = OAERO_EOL
+ call Budget_source_add( tbudgets(NBUDGET_W), tzsource )
+
+ call Sourcelist_sort_compact( tbudgets(NBUDGET_W) )
+
+ call Sourcelist_scan( tbudgets(NBUDGET_W), cbulist_rw )
+end if
+
+! Budget of RTH
+tbudgets(NBUDGET_TH)%lenabled = lbu_rth
+
+if ( lbu_rth ) then
+ tbudgets(NBUDGET_TH)%trhodj => tburhodj
+
+ !Allocate all basic source terms (used or not)
+ !The size should be large enough (bigger than necessary is OK)
+ tbudgets(NBUDGET_TH)%nsourcesmax = NSOURCESMAX
+ allocate( tbudgets(NBUDGET_TH)%tsources(NSOURCESMAX) )
+
+ allocate( tbudgets(NBUDGET_TH)%xtmpstore(ibudim1, ibudim2, ibudim3) )
+
+ tbudgets(NBUDGET_TH)%tsources(:)%ngroup = 0
+
+ tzsource%ccomment = 'Budget of potential temperature'
+ tzsource%ngrid = 1
+
+ tzsource%cunits = 'K'
+
+ tzsource%cmnhname = 'INIF'
+ tzsource%clongname = 'initial state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource, odonotinit = .true., ooverwrite = .true. )
+
+ tzsource%cmnhname = 'ENDF'
+ tzsource%clongname = 'final state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource, odonotinit = .true., ooverwrite = .true. )
+
+ tzsource%cmnhname = 'AVEF'
+ tzsource%clongname = 'averaged state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource, odonotinit = .true., ooverwrite = .false. )
+
+ tzsource%cunits = 'K s-1'
+
+ tzsource%cmnhname = 'ASSE'
+ tzsource%clongname = 'time filter (Asselin)'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'NEST'
+ tzsource%clongname = 'nesting'
+ tzsource%lavailable = nmodel > 1
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'FRC'
+ tzsource%clongname = 'forcing'
+ tzsource%lavailable = lforcing
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = '2DADV'
+ tzsource%clongname = 'advective forcing'
+ tzsource%lavailable = l2d_adv_frc
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = '2DREL'
+ tzsource%clongname = 'relaxation forcing'
+ tzsource%lavailable = l2d_rel_frc
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'NUD'
+ tzsource%clongname = 'nudging'
+ tzsource%lavailable = onudging
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'PREF'
+ tzsource%clongname = 'reference pressure'
+ tzsource%lavailable = krr > 0 .and. .not.l1d
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'DIF'
+ tzsource%clongname = 'numerical diffusion'
+ tzsource%lavailable = onumdifth
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'REL'
+ tzsource%clongname = 'relaxation'
+ tzsource%lavailable = ohorelax_uvwth .or. ove_relax .or. ove_relax_grd
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'RAD'
+ tzsource%clongname = 'radiation'
+ tzsource%lavailable = hrad /= 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'DCONV'
+ tzsource%clongname = 'KAFR convection'
+ tzsource%lavailable = hdconv == 'KAFR' .OR. hsconv == 'KAFR'
+
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'BLAZE'
+ tzsource%clongname = 'blaze fire model contribution'
+ tzsource%lavailable = lblaze
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'VTURB'
+ tzsource%clongname = 'vertical turbulent diffusion'
+ tzsource%lavailable = hturb == 'TKEL'
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'HTURB'
+ tzsource%clongname = 'horizontal turbulent diffusion'
+ tzsource%lavailable = hturb == 'TKEL' .and. HTURBDIM == '3DIM'
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'DISSH'
+ tzsource%clongname = 'dissipation'
+ tzsource%lavailable = hturb == 'TKEL'
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'NETUR'
+ tzsource%clongname = 'negativity correction induced by turbulence'
+ tzsource%lavailable = hturb == 'TKEL' .and. ( hcloud == 'KESS' .or. hcloud == 'ICE3' .or. hcloud == 'ICE4' &
+ .or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA' )
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'MAFL'
+ tzsource%clongname = 'mass flux'
+ tzsource%lavailable = hsconv == 'EDKF'
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'SNSUB'
+ tzsource%clongname = 'blowing snow sublimation'
+ tzsource%lavailable = lblowsnow .and. lsnowsubl
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'VISC'
+ tzsource%clongname = 'viscosity'
+ tzsource%lavailable = lvisc .and. lvisc_th
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'OCEAN'
+ tzsource%clongname = 'radiative tendency due to SW penetrating ocean'
+ tzsource%lavailable = locean .and. (.not. lcouples)
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'ADV'
+ tzsource%clongname = 'total advection'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'NEADV'
+ tzsource%clongname = 'negativity correction induced by advection'
+ tzsource%lavailable = hcloud == 'KESS' .or. hcloud == 'ICE3' .or. hcloud == 'ICE4' &
+ .or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA'
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'NEGA'
+ tzsource%clongname = 'negativity correction'
+ tzsource%lavailable = hcloud == 'KESS' .or. hcloud == 'ICE3' .or. hcloud == 'ICE4' &
+ .or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA'
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'SEDI'
+ tzsource%clongname = 'heat transport by hydrometeors sedimentation'
+ tzsource%lavailable = hcloud == 'LIMA' .and. lptsplit
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'HENU'
+ tzsource%clongname = 'heterogeneous nucleation'
+ gtmp = cactccn == 'ABRK' .and. (lorilam .or. ldust .or. lsalt )
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. nmom_c.ge.1 .and. lacti_lima .and. nmod_ccn >= 1 &
+ .and. ( .not.lptsplit .or. .not.lsubg_cond ) ) &
+ .or. ( hcloud == 'C2R2' .and. ( gtmp .or. .not.lsupsat_c2r2 ) ) &
+ .or. ( hcloud == 'KHKO' .and. ( gtmp .or. .not.lsupsat_c2r2 ) )
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'REVA'
+ tzsource%clongname = 'rain evaporation'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( ( .not. lptsplit .and. nmom_r.ge.1 ) .or. lptsplit ) ) &
+ .or. ( hcloud(1:3) == 'ICE' .and. lwarm_ice ) &
+ .or. ( hcloud == 'C2R2' .and. lrain_c2r2 ) &
+ .or. ( hcloud == 'KHKO' .and. lrain_c2r2 ) &
+ .or. hcloud == 'KESS'
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'HIN'
+ tzsource%clongname = 'heterogeneous ice nucleation'
+ tzsource%lavailable = hcloud(1:3) == 'ICE' .or. (hcloud == 'LIMA' .and. nmom_i == 1)
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'HIND'
+ tzsource%clongname = 'heterogeneous nucleation by deposition'
+ tzsource%lavailable = hcloud == 'LIMA' .and. nmom_i.ge.1 .and. lnucl_lima
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'HINC'
+ tzsource%clongname = 'heterogeneous nucleation by contact'
+ tzsource%lavailable = hcloud == 'LIMA' .and. nmom_i.ge.1 .and. lnucl_lima
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'HON'
+ tzsource%clongname = 'homogeneous nucleation'
+ tzsource%lavailable = hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'HONH'
+ tzsource%clongname = 'haze homogeneous nucleation'
+ tzsource%lavailable = hcloud == 'LIMA' .and. nmom_i.ge.1 .and. lnucl_lima .and. lhhoni_lima .and. nmod_ccn >= 1
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'HONC'
+ tzsource%clongname = 'droplet homogeneous freezing'
+ tzsource%lavailable = hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. lnucl_lima ) )
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'HONR'
+ tzsource%clongname = 'raindrop homogeneous freezing'
+ tzsource%lavailable = hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_i.ge.1 .and. lnucl_lima .and. nmom_r.ge.1 ) )
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'SFR'
+ tzsource%clongname = 'spontaneous freezing'
+ tzsource%lavailable = hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'DEPS'
+ tzsource%clongname = 'deposition on snow'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_i.ge.1 .and. nmom_s.ge.1 ) ) ) .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'DEPG'
+ tzsource%clongname = 'deposition on graupel'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 ) ) ) &
+ .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'DEPH'
+ tzsource%clongname = 'deposition on hail'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. nmom_h.ge.1 ) ) &
+ .or. hcloud == 'ICE4'
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'IMLT'
+ tzsource%clongname = 'melting of ice'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 ) ) ) .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'BERFI'
+ tzsource%clongname = 'Bergeron-Findeisen'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 ) ) ) .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'RIM'
+ tzsource%clongname = 'riming of cloud water'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 ) ) ) &
+ .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'ACC'
+ tzsource%clongname = 'accretion of rain on aggregates'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit &
+ .or. ( nmom_s.ge.1 .and. nmom_r.ge.1 ) ) ) &
+ .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'CFRZ'
+ tzsource%clongname = 'conversion freezing of rain'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 ) ) ) &
+ .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'WETG'
+ tzsource%clongname = 'wet growth of graupel'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 ) ) ) &
+ .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'DRYG'
+ tzsource%clongname = 'dry growth of graupel'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 ) ) ) &
+ .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'GMLT'
+ tzsource%clongname = 'graupel melting'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 ) ) ) &
+ .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'WETH'
+ tzsource%clongname = 'wet growth of hail'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. .not.lptsplit .and. nmom_h.ge.1 .and. nmom_i.ge.1 &
+ .and. nmom_c.ge.1 .and. nmom_s.ge.1 ) &
+ .or. ( hcloud == 'LIMA' .and. lptsplit ) &
+ .or. hcloud == 'ICE4'
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'DRYH'
+ tzsource%clongname = 'dry growth of hail'
+ tzsource%lavailable = hcloud == 'ICE4' .and. lred .and. celec == 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'HMLT'
+ tzsource%clongname = 'melting of hail'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. .not.lptsplit .and. nmom_h.ge.1 .and. nmom_i.ge.1 &
+ .and. nmom_c.ge.1 .and. nmom_s.ge.1 ) &
+ .or. ( hcloud == 'LIMA' .and. lptsplit ) &
+ .or. hcloud == 'ICE4'
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'CORR'
+ tzsource%clongname = 'correction'
+ tzsource%lavailable = hcloud(1:3) == 'ICE' .and. lred .and. celec == 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'CEDS'
+ tzsource%clongname = 'adjustment to saturation'
+ tzsource%lavailable = hcloud == 'LIMA'
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'ADJU'
+ tzsource%clongname = 'adjustment to saturation'
+ tzsource%lavailable = hcloud(1:3) == 'ICE' .and. lred .and. ladj_before .and. celec == 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'DEPI'
+ tzsource%clongname = 'deposition on ice'
+ tzsource%lavailable = ( hcloud(1:3) == 'ICE' .and. ( .not. lred .or. ( lred .and. ladj_after ) .or. celec /= 'NONE') ) &
+ .or. ( hcloud == 'LIMA' .and. lptsplit )
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'COND'
+ tzsource%clongname = 'vapor condensation or cloud water evaporation'
+ tzsource%lavailable = hcloud == 'C2R2' .or. hcloud == 'KHKO' .or. hcloud == 'KESS' .or. hcloud == 'REVE'
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ 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'
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+
+ call Sourcelist_sort_compact( tbudgets(NBUDGET_TH) )
+
+ call Sourcelist_scan( tbudgets(NBUDGET_TH), cbulist_rth )
+end if
+
+! Budget of RTKE
+tbudgets(NBUDGET_TKE)%lenabled = lbu_rtke
+
+if ( lbu_rtke ) then
+ tbudgets(NBUDGET_TKE)%trhodj => tburhodj
+
+ !Allocate all basic source terms (used or not)
+ !The size should be large enough (bigger than necessary is OK)
+ tbudgets(NBUDGET_TKE)%nsourcesmax = NSOURCESMAX
+ allocate( tbudgets(NBUDGET_TKE)%tsources(NSOURCESMAX) )
+
+ allocate( tbudgets(NBUDGET_TKE)%xtmpstore(ibudim1, ibudim2, ibudim3) )
+
+ tbudgets(NBUDGET_TKE)%tsources(:)%ngroup = 0
+
+ tzsource%ccomment = 'Budget of turbulent kinetic energy'
+ tzsource%ngrid = 1
+
+ tzsource%cunits = 'm2 s-1'
+
+ tzsource%cmnhname = 'INIF'
+ tzsource%clongname = 'initial state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_TKE), tzsource, odonotinit = .true., ooverwrite = .true. )
+
+ tzsource%cmnhname = 'ENDF'
+ tzsource%clongname = 'final state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_TKE), tzsource, odonotinit = .true., ooverwrite = .true. )
+
+ tzsource%cmnhname = 'AVEF'
+ tzsource%clongname = 'averaged state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_TKE), tzsource, odonotinit = .true., ooverwrite = .false. )
+
+ tzsource%cunits = 'm2 s-3'
+
+ tzsource%cmnhname = 'ASSE'
+ tzsource%clongname = 'time filter (Asselin)'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_TKE), tzsource )
+
+ tzsource%cmnhname = 'FRC'
+ tzsource%clongname = 'forcing'
+ tzsource%lavailable = lforcing
+ call Budget_source_add( tbudgets(NBUDGET_TKE), tzsource )
+
+ tzsource%cmnhname = 'DIF'
+ tzsource%clongname = 'numerical diffusion'
+ tzsource%lavailable = onumdifth
+ call Budget_source_add( tbudgets(NBUDGET_TKE), tzsource )
+
+ tzsource%cmnhname = 'REL'
+ tzsource%clongname = 'relaxation'
+ tzsource%lavailable = ohorelax_tke
+ call Budget_source_add( tbudgets(NBUDGET_TKE), tzsource )
+
+ tzsource%cmnhname = 'DRAG'
+ tzsource%clongname = 'drag force'
+ tzsource%lavailable = odragtree
+ call Budget_source_add( tbudgets(NBUDGET_TKE), tzsource )
+
+ tzsource%cmnhname = 'DRAGB'
+ tzsource%clongname = 'drag force due to buildings'
+ tzsource%lavailable = ldragbldg
+ call Budget_source_add( tbudgets(NBUDGET_TKE), tzsource )
+
+ tzsource%cmnhname = 'DP'
+ tzsource%clongname = 'dynamic production'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_TKE), tzsource )
+
+ tzsource%cmnhname = 'TP'
+ tzsource%clongname = 'thermal production'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_TKE), tzsource )
+
+ tzsource%cmnhname = 'DISS'
+ tzsource%clongname = 'dissipation of TKE'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_TKE), tzsource )
+
+ tzsource%cmnhname = 'TR'
+ tzsource%clongname = 'turbulent transport'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_TKE), tzsource )
+
+ tzsource%cmnhname = 'ADV'
+ tzsource%clongname = 'total advection'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_TKE), tzsource )
+
+
+ call Sourcelist_sort_compact( tbudgets(NBUDGET_TKE) )
+
+ call Sourcelist_scan( tbudgets(NBUDGET_TKE), cbulist_rtke )
+end if
+
+! Budget of RRV
+tbudgets(NBUDGET_RV)%lenabled = lbu_rrv .and. krr >= 1
+
+if ( tbudgets(NBUDGET_RV)%lenabled ) then
+ tbudgets(NBUDGET_RV)%trhodj => tburhodj
+
+ !Allocate all basic source terms (used or not)
+ !The size should be large enough (bigger than necessary is OK)
+ tbudgets(NBUDGET_RV)%nsourcesmax = NSOURCESMAX
+ allocate( tbudgets(NBUDGET_RV)%tsources(NSOURCESMAX) )
+
+ allocate( tbudgets(NBUDGET_RV)%xtmpstore(ibudim1, ibudim2, ibudim3) )
+
+ tbudgets(NBUDGET_RV)%tsources(:)%ngroup = 0
+
+ tzsource%ccomment = 'Budget of water vapor mixing ratio'
+ tzsource%ngrid = 1
+
+ tzsource%cunits = 'kg kg-1'
+
+ tzsource%cmnhname = 'INIF'
+ tzsource%clongname = 'initial state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource, odonotinit = .true., ooverwrite = .true. )
+
+ tzsource%cmnhname = 'ENDF'
+ tzsource%clongname = 'final state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource, odonotinit = .true., ooverwrite = .true. )
+
+ tzsource%cmnhname = 'AVEF'
+ tzsource%clongname = 'averaged state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource, odonotinit = .true., ooverwrite = .false. )
+
+ tzsource%cunits = 's-1'
+
+ tzsource%cmnhname = 'ASSE'
+ tzsource%clongname = 'time filter (Asselin)'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = 'NEST'
+ tzsource%clongname = 'nesting'
+ tzsource%lavailable = nmodel > 1
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = 'FRC'
+ tzsource%clongname = 'forcing'
+ tzsource%lavailable = lforcing
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = '2DADV'
+ tzsource%clongname = 'advective forcing'
+ tzsource%lavailable = l2d_adv_frc
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = '2DREL'
+ tzsource%clongname = 'relaxation forcing'
+ tzsource%lavailable = l2d_rel_frc
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = 'NUD'
+ tzsource%clongname = 'nudging'
+ tzsource%lavailable = onudging
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = 'DIF'
+ tzsource%clongname = 'numerical diffusion'
+ tzsource%lavailable = onumdifth
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = 'REL'
+ tzsource%clongname = 'relaxation'
+ tzsource%lavailable = ohorelax_rv
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = 'DCONV'
+ tzsource%clongname = 'KAFR convection'
+ tzsource%lavailable = hdconv == 'KAFR' .OR. hsconv == 'KAFR'
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = 'BLAZE'
+ tzsource%clongname = 'blaze fire model contribution'
+ tzsource%lavailable = lblaze
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = 'VTURB'
+ tzsource%clongname = 'vertical turbulent diffusion'
+ tzsource%lavailable = hturb == 'TKEL'
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = 'HTURB'
+ tzsource%clongname = 'horizontal turbulent diffusion'
+ tzsource%lavailable = hturb == 'TKEL' .and. HTURBDIM == '3DIM'
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = 'NETUR'
+ tzsource%clongname = 'negativity correction induced by turbulence'
+ tzsource%lavailable = hturb == 'TKEL' .and. ( hcloud == 'KESS' .or. hcloud == 'ICE3' .or. hcloud == 'ICE4' &
+ .or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA' )
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = 'MAFL'
+ tzsource%clongname = 'mass flux'
+ tzsource%lavailable = hsconv == 'EDKF'
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = 'SNSUB'
+ tzsource%clongname = 'blowing snow sublimation'
+ tzsource%lavailable = lblowsnow .and. lsnowsubl
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = 'VISC'
+ tzsource%clongname = 'viscosity'
+ tzsource%lavailable = lvisc .and. lvisc_r
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = 'ADV'
+ tzsource%clongname = 'total advection'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = 'NEADV'
+ tzsource%clongname = 'negativity correction induced by advection'
+ tzsource%lavailable = hcloud == 'KESS' .or. hcloud == 'ICE3' .or. hcloud == 'ICE4' &
+ .or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA'
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = 'NEGA'
+ tzsource%clongname = 'negativity correction'
+ tzsource%lavailable = hcloud == 'KESS' .or. hcloud == 'ICE3' .or. hcloud == 'ICE4' &
+ .or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA'
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = 'HENU'
+ tzsource%clongname = 'heterogeneous nucleation'
+ gtmp = cactccn == 'ABRK' .and. (lorilam .or. ldust .or. lsalt )
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. nmom_c.ge.1 .and. lacti_lima .and. nmod_ccn >= 1 &
+ .and. ( .not.lptsplit .or. .not.lsubg_cond ) ) &
+ .or. ( hcloud == 'C2R2' .and. ( gtmp .or. .not.lsupsat_c2r2 ) ) &
+ .or. ( hcloud == 'KHKO' .and. ( gtmp .or. .not.lsupsat_c2r2 ) )
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = 'REVA'
+ tzsource%clongname = 'rain evaporation'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( ( .not. lptsplit .and. nmom_c.ge.1 .and. nmom_r.ge.1 ) &
+ .or. lptsplit ) ) &
+ .or. ( hcloud(1:3) == 'ICE' .and. lwarm_ice ) &
+ .or. ( hcloud == 'C2R2' .and. lrain_c2r2 ) &
+ .or. ( hcloud == 'KHKO' .and. lrain_c2r2 ) &
+ .or. hcloud == 'KESS'
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = 'HIN'
+ tzsource%clongname = 'heterogeneous ice nucleation'
+ tzsource%lavailable = hcloud(1:3) == 'ICE' .or. ( hcloud == 'LIMA' .and. nmom_i == 1 )
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = 'HIND'
+ tzsource%clongname = 'heterogeneous nucleation by deposition'
+ tzsource%lavailable = hcloud == 'LIMA' .and. nmom_i.ge.1 .and. lnucl_lima
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = 'HONH'
+ tzsource%clongname = 'haze homogeneous nucleation'
+ tzsource%lavailable = hcloud == 'LIMA' .and. nmom_i.ge.1 .and. lnucl_lima .and. lhhoni_lima .and. nmod_ccn >= 1
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = 'DEPS'
+ tzsource%clongname = 'deposition on snow'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_i.ge.1 .and. nmom_s.ge.1 ) ) ) .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = 'DEPG'
+ tzsource%clongname = 'deposition on graupel'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 ) ) ) &
+ .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = 'DEPH'
+ tzsource%clongname = 'deposition on HAIL'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. nmom_h.ge.1 ) &
+ .or. hcloud == 'ICE4' )
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = 'CEDS'
+ tzsource%clongname = 'adjustment to saturation'
+ tzsource%lavailable = hcloud == 'LIMA'
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = 'ADJU'
+ tzsource%clongname = 'adjustment to saturation'
+ tzsource%lavailable = hcloud(1:3) == 'ICE' .and. lred .and. ladj_before .and. celec == 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = 'COND'
+ tzsource%clongname = 'vapor condensation or cloud water evaporation'
+ tzsource%lavailable = hcloud == 'C2R2' .or. hcloud == 'KHKO' .or. hcloud == 'KESS' .or. hcloud == 'REVE'
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = 'CORR'
+ tzsource%clongname = 'correction'
+ tzsource%lavailable = hcloud(1:3) == 'ICE' .and. lred .and. celec == 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = 'DEPI'
+ tzsource%clongname = 'deposition on ice'
+ tzsource%lavailable = ( hcloud(1:3) == 'ICE' .and. ( .not. lred .or. ( lred .and. ladj_after ) .or. celec /= 'NONE') ) &
+ .or. ( hcloud == 'LIMA' .and. lptsplit )
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = 'CORR2'
+ tzsource%clongname = 'supplementary correction inside LIMA splitting'
+ tzsource%lavailable = hcloud == 'LIMA' .and. lptsplit
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ 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'
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+
+ call Sourcelist_sort_compact( tbudgets(NBUDGET_RV) )
+
+ call Sourcelist_scan( tbudgets(NBUDGET_RV), cbulist_rrv )
+end if
+
+! Budget of RRC
+tbudgets(NBUDGET_RC)%lenabled = lbu_rrc .and. krr >= 2
+
+if ( tbudgets(NBUDGET_RC)%lenabled ) then
+ if ( hcloud(1:3) == 'ICE' .and. lred .and. lsedic_ice .and. ldeposc_ice ) &
+ call Print_msg( NVERB_WARNING, 'BUD', 'Ini_budget', 'lred=T + lsedic=T + ldeposc=T:'// &
+ 'DEPO and SEDI source terms are mixed and stored in SEDI' )
+
+ tbudgets(NBUDGET_RC)%trhodj => tburhodj
+
+ !Allocate all basic source terms (used or not)
+ !The size should be large enough (bigger than necessary is OK)
+ tbudgets(NBUDGET_RC)%nsourcesmax = NSOURCESMAX
+ allocate( tbudgets(NBUDGET_RC)%tsources(NSOURCESMAX) )
+
+ allocate( tbudgets(NBUDGET_RC)%xtmpstore(ibudim1, ibudim2, ibudim3) )
+
+ tbudgets(NBUDGET_RC)%tsources(:)%ngroup = 0
+
+ tzsource%ccomment = 'Budget of cloud water mixing ratio'
+ tzsource%ngrid = 1
+
+ tzsource%cunits = 'kg kg-1'
+
+ tzsource%cmnhname = 'INIF'
+ tzsource%clongname = 'initial state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource, odonotinit = .true., ooverwrite = .true. )
+
+ tzsource%cmnhname = 'ENDF'
+ tzsource%clongname = 'final state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource, odonotinit = .true., ooverwrite = .true. )
+
+ tzsource%cmnhname = 'AVEF'
+ tzsource%clongname = 'averaged state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource, odonotinit = .true., ooverwrite = .false. )
+
+ tzsource%cunits = 's-1'
+
+ tzsource%cmnhname = 'ASSE'
+ tzsource%clongname = 'time filter (Asselin)'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'NEST'
+ tzsource%clongname = 'nesting'
+ tzsource%lavailable = nmodel > 1
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'FRC'
+ tzsource%clongname = 'forcing'
+ tzsource%lavailable = lforcing
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'DIF'
+ tzsource%clongname = 'numerical diffusion'
+ tzsource%lavailable = onumdifth
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'REL'
+ tzsource%clongname = 'relaxation'
+ tzsource%lavailable = ohorelax_rc
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'DCONV'
+ tzsource%clongname = 'KAFR convection'
+ tzsource%lavailable = hdconv == 'KAFR' .OR. hsconv == 'KAFR'
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'DEPOTR'
+ tzsource%clongname = 'tree droplet deposition'
+ tzsource%lavailable = odragtree .and. odepotree
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'VTURB'
+ tzsource%clongname = 'vertical turbulent diffusion'
+ tzsource%lavailable = hturb == 'TKEL'
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'HTURB'
+ tzsource%clongname = 'horizontal turbulent diffusion'
+ tzsource%lavailable = hturb == 'TKEL' .and. HTURBDIM == '3DIM'
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'NETUR'
+ tzsource%clongname = 'negativity correction induced by turbulence'
+ tzsource%lavailable = hturb == 'TKEL' .and. ( hcloud == 'KESS' .or. hcloud == 'ICE3' .or. hcloud == 'ICE4' &
+ .or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA' )
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'VISC'
+ tzsource%clongname = 'viscosity'
+ tzsource%lavailable = lvisc .and. lvisc_r
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'ADV'
+ tzsource%clongname = 'total advection'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'NEADV'
+ tzsource%clongname = 'negativity correction induced by advection'
+ tzsource%lavailable = hcloud == 'KESS' .or. hcloud == 'ICE3' .or. hcloud == 'ICE4' &
+ .or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA'
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'NEGA'
+ tzsource%clongname = 'negativity correction'
+ tzsource%lavailable = hcloud == 'KESS' .or. hcloud == 'ICE3' .or. hcloud == 'ICE4' &
+ .or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA'
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'CORR'
+ 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'
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'SEDI'
+ tzsource%clongname = 'sedimentation of cloud'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. nmom_c.ge.1 .and. lsedc_lima ) &
+ .or. ( hcloud(1:3) == 'ICE' .and. lsedic_ice ) &
+ .or. ( hcloud == 'C2R2' .and. lsedc_c2r2 ) &
+ .or. ( hcloud == 'KHKO' .and. lsedc_c2r2 )
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'DEPO'
+ tzsource%clongname = 'surface droplet deposition'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. nmom_c.ge.1 .and. ldepoc_lima ) &
+ .or. ( hcloud == 'C2R2' .and. ldepoc_c2r2 ) &
+ .or. ( hcloud == 'KHKO' .and. ldepoc_c2r2 ) &
+ .or. ( hcloud(1:3) == 'ICE' .and. ldeposc_ice .and. celec == 'NONE' )
+ call Budget_source_add( tbudgets(NBUDGET_RC), 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(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'HENU'
+ tzsource%clongname = 'CCN activation'
+ gtmp = cactccn == 'ABRK' .and. (lorilam .or. ldust .or. lsalt )
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. nmom_c.ge.1 .and. lacti_lima .and. nmod_ccn >= 1 &
+ .and. ( .not.lptsplit .or. .not.lsubg_cond ) ) &
+ .or. ( hcloud == 'C2R2' .and. ( gtmp .or. .not.lsupsat_c2r2 ) ) &
+ .or. ( hcloud == 'KHKO' .and. ( gtmp .or. .not.lsupsat_c2r2 ) )
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'HINC'
+ tzsource%clongname = 'heterogeneous nucleation by contact'
+ tzsource%lavailable = hcloud == 'LIMA' .and. nmom_i.ge.1 .and. lnucl_lima
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'ADJU'
+ tzsource%clongname = 'adjustment to saturation'
+ tzsource%lavailable = hcloud(1:3) == 'ICE' .and. lred .and. ladj_before .and. celec == 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'HON'
+ tzsource%clongname = 'homogeneous nucleation'
+ tzsource%lavailable = hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'AUTO'
+ tzsource%clongname = 'autoconversion into rain'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_c.ge.1 .and. nmom_r.ge.1 ) ) ) &
+ .or. hcloud == 'KESS' &
+ .or. ( hcloud(1:3) == 'ICE' .and. lwarm_ice ) &
+ .or. ( hcloud == 'C2R2' .and. lrain_c2r2 ) &
+ .or. ( hcloud == 'KHKO' .and. lrain_c2r2 )
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'ACCR'
+ tzsource%clongname = 'accretion of cloud droplets'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_c.ge.1 .and. nmom_r.ge.1 ) ) ) &
+ .or. hcloud == 'KESS' &
+ .or. ( hcloud(1:3) == 'ICE' .and. lwarm_ice ) &
+ .or. ( hcloud == 'C2R2' .and. lrain_c2r2 ) &
+ .or. ( hcloud == 'KHKO' .and. lrain_c2r2 )
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'REVA'
+ tzsource%clongname = 'rain evaporation'
+ tzsource%lavailable = hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_c.ge.1 .and. nmom_r.ge.1 ) )
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'HONC'
+ tzsource%clongname = 'droplet homogeneous freezing'
+ tzsource%lavailable = hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. lnucl_lima ) )
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'IMLT'
+ tzsource%clongname = 'melting of ice'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 ) ) ) .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'BERFI'
+ tzsource%clongname = 'Bergeron-Findeisen'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. (nmom_i.ge.1 .and. nmom_c.ge.1) ) ) .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'RIM'
+ tzsource%clongname = 'riming of cloud water'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 ) ) ) &
+ .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RC), 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 .and. celec == 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'WETG'
+ tzsource%clongname = 'wet growth of graupel'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. (nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1) ) ) &
+ .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'DRYG'
+ tzsource%clongname = 'dry growth of graupel'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. (nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1) ) ) &
+ .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'CVRC'
+ tzsource%clongname = 'rain to cloud change after other microphysical processes'
+ tzsource%lavailable = hcloud == 'LIMA' .and. lptsplit
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'WETH'
+ tzsource%clongname = 'wet growth of hail'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. .not.lptsplit .and. nmom_h.ge.1 .and. nmom_i.ge.1 &
+ .and. nmom_c.ge.1 .and. nmom_s.ge.1 ) &
+ .or. ( hcloud == 'LIMA' .and. lptsplit ) &
+ .or. hcloud == 'ICE4'
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'DRYH'
+ tzsource%clongname = 'dry growth of hail'
+ tzsource%lavailable = hcloud == 'ICE4' .and. lred .and. celec == 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'CEDS'
+ tzsource%clongname = 'adjustment to saturation'
+ tzsource%lavailable = hcloud == 'LIMA'
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'DEPI'
+ tzsource%clongname = 'condensation/deposition on ice'
+ tzsource%lavailable = hcloud(1:3) == 'ICE' .and. ( .not. lred .or. ( lred .and. ladj_after ) .or. celec /= 'NONE' )
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'COND'
+ tzsource%clongname = 'vapor condensation or cloud water evaporation'
+ tzsource%lavailable = hcloud == 'C2R2' .or. hcloud == 'KHKO' .or. hcloud == 'KESS' .or. hcloud == 'REVE'
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'CORR2'
+ tzsource%clongname = 'supplementary correction inside LIMA splitting'
+ tzsource%lavailable = hcloud == 'LIMA' .and. lptsplit
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ 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'
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+
+ call Sourcelist_sort_compact( tbudgets(NBUDGET_RC) )
+
+ call Sourcelist_scan( tbudgets(NBUDGET_RC), cbulist_rrc )
+end if
+
+! Budget of RRR
+tbudgets(NBUDGET_RR)%lenabled = lbu_rrr .and. krr >= 3
+
+if ( tbudgets(NBUDGET_RR)%lenabled ) then
+ tbudgets(NBUDGET_RR)%trhodj => tburhodj
+
+ !Allocate all basic source terms (used or not)
+ !The size should be large enough (bigger than necessary is OK)
+ tbudgets(NBUDGET_RR)%nsourcesmax = NSOURCESMAX
+ allocate( tbudgets(NBUDGET_RR)%tsources(NSOURCESMAX) )
+
+ allocate( tbudgets(NBUDGET_RR)%xtmpstore(ibudim1, ibudim2, ibudim3) )
+
+ tbudgets(NBUDGET_RR)%tsources(:)%ngroup = 0
+
+ tzsource%ccomment = 'Budget of rain water mixing ratio'
+ tzsource%ngrid = 1
+
+ tzsource%cunits = 'kg kg-1'
+
+ tzsource%cmnhname = 'INIF'
+ tzsource%clongname = 'initial state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource, odonotinit = .true., ooverwrite = .true. )
+
+ tzsource%cmnhname = 'ENDF'
+ tzsource%clongname = 'final state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource, odonotinit = .true., ooverwrite = .true. )
+
+ tzsource%cmnhname = 'AVEF'
+ tzsource%clongname = 'averaged state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource, odonotinit = .true., ooverwrite = .false. )
+
+ tzsource%cunits = 's-1'
+
+ tzsource%cmnhname = 'ASSE'
+ tzsource%clongname = 'time filter (Asselin)'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
+
+ tzsource%cmnhname = 'NEST'
+ tzsource%clongname = 'nesting'
+ tzsource%lavailable = nmodel > 1
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
+
+ tzsource%cmnhname = 'FRC'
+ tzsource%clongname = 'forcing'
+ tzsource%lavailable = lforcing
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
+
+ tzsource%cmnhname = 'DIF'
+ tzsource%clongname = 'numerical diffusion'
+ tzsource%lavailable = onumdifth
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
+
+ tzsource%cmnhname = 'REL'
+ tzsource%clongname = 'relaxation'
+ tzsource%lavailable = ohorelax_rr
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
+
+ tzsource%cmnhname = 'NETUR'
+ tzsource%clongname = 'negativity correction induced by turbulence'
+ tzsource%lavailable = hturb == 'TKEL' .and. ( hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA' )
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
+
+ tzsource%cmnhname = 'VISC'
+ tzsource%clongname = 'viscosity'
+ tzsource%lavailable = lvisc .and. lvisc_r
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
+
+ tzsource%cmnhname = 'ADV'
+ tzsource%clongname = 'total advection'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
+
+ tzsource%cmnhname = 'NEADV'
+ tzsource%clongname = 'negativity correction induced by advection'
+ tzsource%lavailable = hcloud == 'KESS' .or. hcloud == 'ICE3' .or. hcloud == 'ICE4' &
+ .or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA'
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
+
+ tzsource%cmnhname = 'NEGA'
+ tzsource%clongname = 'negativity correction'
+ tzsource%lavailable = hcloud == 'KESS' .or. hcloud == 'ICE3' .or. hcloud == 'ICE4' &
+ .or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA'
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
+
+ tzsource%cmnhname = 'CORR'
+ 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'
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
+
+ tzsource%cmnhname = 'SEDI'
+ tzsource%clongname = 'sedimentation of rain drops'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. nmom_c.ge.1 .and. nmom_r.ge.1 ) &
+ .or. hcloud == 'KESS' &
+ .or. hcloud(1:3) == 'ICE' &
+ .or. hcloud == 'C2R2' &
+ .or. hcloud == 'KHKO'
+ call Budget_source_add( tbudgets(NBUDGET_RR), 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(NBUDGET_RR), tzsource )
+
+ tzsource%cmnhname = 'AUTO'
+ tzsource%clongname = 'autoconversion into rain'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_c.ge.1 .and. nmom_r.ge.1 ) ) ) &
+ .or. hcloud == 'KESS' &
+ .or. ( hcloud(1:3) == 'ICE' .and. lwarm_ice ) &
+ .or. ( hcloud == 'C2R2' .and. lrain_c2r2 ) &
+ .or. ( hcloud == 'KHKO' .and. lrain_c2r2 )
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
+
+ tzsource%cmnhname = 'ACCR'
+ tzsource%clongname = 'accretion of cloud droplets'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_c.ge.1 .and. nmom_r.ge.1 ) ) ) &
+ .or. hcloud == 'KESS' &
+ .or. ( hcloud(1:3) == 'ICE' .and. lwarm_ice ) &
+ .or. ( hcloud == 'C2R2' .and. lrain_c2r2 ) &
+ .or. ( hcloud == 'KHKO' .and. lrain_c2r2 )
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
+
+ tzsource%cmnhname = 'REVA'
+ tzsource%clongname = 'rain evaporation'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_c.ge.1 .and. nmom_r.ge.1 ) ) ) &
+ .or. hcloud == 'KESS' &
+ .or. ( hcloud(1:3) == 'ICE' .and. lwarm_ice ) &
+ .or. ( hcloud == 'C2R2' .and. lrain_c2r2 ) &
+ .or. ( hcloud == 'KHKO' .and. lrain_c2r2 )
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
+
+ tzsource%cmnhname = 'HONR'
+ tzsource%clongname = 'rain homogeneous freezing'
+ tzsource%lavailable = hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_i.ge.1 .and. lnucl_lima .and. nmom_r.ge.1 ) )
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
+
+
+ tzsource%cmnhname = 'ACC'
+ tzsource%clongname = 'accretion of rain on aggregates'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 &
+ .and. nmom_s.ge.1 .and. nmom_r.ge.1) ) ) &
+ .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
+
+ 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'
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
+
+ tzsource%cmnhname = 'CFRZ'
+ tzsource%clongname = 'conversion freezing of rain'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. (nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1) ) ) &
+ .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
+
+ tzsource%cmnhname = 'WETG'
+ tzsource%clongname = 'wet growth of graupel'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. (nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1) ) ) &
+ .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
+
+ tzsource%cmnhname = 'DRYG'
+ tzsource%clongname = 'dry growth of graupel'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. (nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1) ) ) &
+ .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
+
+ tzsource%cmnhname = 'GMLT'
+ tzsource%clongname = 'graupel melting'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. (nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1) ) ) &
+ .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
+
+ tzsource%cmnhname = 'CVRC'
+ tzsource%clongname = 'rain to cloud change after other microphysical processes'
+ tzsource%lavailable = hcloud == 'LIMA' .and. lptsplit
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
+
+ tzsource%cmnhname = 'WETH'
+ tzsource%clongname = 'wet growth of hail'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. .not.lptsplit .and. nmom_h.ge.1 .and. nmom_i.ge.1 &
+ .and. nmom_c.ge.1 .and. nmom_s.ge.1 ) &
+ .or. ( hcloud == 'LIMA' .and. lptsplit ) &
+ .or. hcloud == 'ICE4'
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
+
+ tzsource%cmnhname = 'DRYH'
+ tzsource%clongname = 'dry growth of hail'
+ tzsource%lavailable = hcloud == 'ICE4' .and. lred .and. celec == 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
+
+ tzsource%cmnhname = 'HMLT'
+ tzsource%clongname = 'melting of hail'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. .not.lptsplit .and. nmom_h.ge.1 .and. nmom_i.ge.1 &
+ .and. nmom_c.ge.1 .and. nmom_s.ge.1 ) &
+ .or. ( hcloud == 'LIMA' .and. lptsplit ) &
+ .or. hcloud == 'ICE4'
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
+
+ tzsource%cmnhname = 'SFR'
+ tzsource%clongname = 'spontaneous freezing'
+ tzsource%lavailable = hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
+
+!PW: a documenter
+ tzsource%cmnhname = 'CORR2'
+ tzsource%clongname = 'supplementary correction inside LIMA splitting'
+ tzsource%lavailable = hcloud == 'LIMA' .and. lptsplit
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
+
+ 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'
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
+
+
+ call Sourcelist_sort_compact( tbudgets(NBUDGET_RR) )
+
+ call Sourcelist_scan( tbudgets(NBUDGET_RR), cbulist_rrr )
+end if
+
+! Budget of RRI
+tbudgets(NBUDGET_RI)%lenabled = lbu_rri .and. krr >= 4
+
+if ( tbudgets(NBUDGET_RI)%lenabled ) then
+ tbudgets(NBUDGET_RI)%trhodj => tburhodj
+
+ !Allocate all basic source terms (used or not)
+ !The size should be large enough (bigger than necessary is OK)
+ tbudgets(NBUDGET_RI)%nsourcesmax = NSOURCESMAX
+ allocate( tbudgets(NBUDGET_RI)%tsources(NSOURCESMAX) )
+
+ allocate( tbudgets(NBUDGET_RI)%xtmpstore(ibudim1, ibudim2, ibudim3) )
+
+ tbudgets(NBUDGET_RI)%tsources(:)%ngroup = 0
+
+ tzsource%ccomment = 'Budget of cloud ice mixing ratio'
+ tzsource%ngrid = 1
+
+ tzsource%cunits = 'kg kg-1'
+
+ tzsource%cmnhname = 'INIF'
+ tzsource%clongname = 'initial state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource, odonotinit = .true., ooverwrite = .true. )
+
+ tzsource%cmnhname = 'ENDF'
+ tzsource%clongname = 'final state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource, odonotinit = .true., ooverwrite = .true. )
+
+ tzsource%cmnhname = 'AVEF'
+ tzsource%clongname = 'averaged state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource, odonotinit = .true., ooverwrite = .false. )
+
+ tzsource%cunits = 's-1'
+
+ tzsource%cmnhname = 'ASSE'
+ tzsource%clongname = 'time filter (Asselin)'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'NEST'
+ tzsource%clongname = 'nesting'
+ tzsource%lavailable = nmodel > 1
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'FRC'
+ tzsource%clongname = 'forcing'
+ tzsource%lavailable = lforcing
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'DIF'
+ tzsource%clongname = 'numerical diffusion'
+ tzsource%lavailable = onumdifth
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'REL'
+ tzsource%clongname = 'relaxation'
+ tzsource%lavailable = ohorelax_ri
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'DCONV'
+ tzsource%clongname = 'KAFR convection'
+ tzsource%lavailable = hdconv == 'KAFR' .OR. hsconv == 'KAFR'
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'VTURB'
+ tzsource%clongname = 'vertical turbulent diffusion'
+ tzsource%lavailable = hturb == 'TKEL'
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'HTURB'
+ tzsource%clongname = 'horizontal turbulent diffusion'
+ tzsource%lavailable = hturb == 'TKEL' .and. HTURBDIM == '3DIM'
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'NETUR'
+ tzsource%clongname = 'negativity correction induced by turbulence'
+ tzsource%lavailable = hturb == 'TKEL' .and. ( hcloud == 'ICE3' .or. hcloud == 'ICE4' .or. hcloud == 'LIMA' )
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'VISC'
+ tzsource%clongname = 'viscosity'
+ tzsource%lavailable = lvisc .and. lvisc_r
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'ADV'
+ tzsource%clongname = 'total advection'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'NEADV'
+ tzsource%clongname = 'negativity correction induced by advection'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'NEGA'
+ tzsource%clongname = 'negativity correction'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'CORR'
+ 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'
+ 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'
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'SEDI'
+ tzsource%clongname = 'sedimentation of rain drops'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. nmom_i.ge.1 .and. lsedi_lima ) &
+ .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'HIN'
+ tzsource%clongname = 'heterogeneous ice nucleation'
+ tzsource%lavailable = hcloud(1:3) == 'ICE' .or. ( hcloud == 'LIMA' .and. nmom_i == 1)
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'HIND'
+ tzsource%clongname = 'heterogeneous nucleation by deposition'
+ tzsource%lavailable = hcloud == 'LIMA' .and. nmom_i.ge.1 .and. lnucl_lima
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'HINC'
+ tzsource%clongname = 'heterogeneous nucleation by contact'
+ tzsource%lavailable = hcloud == 'LIMA' .and. nmom_i.ge.1 .and. lnucl_lima
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'HON'
+ tzsource%clongname = 'homogeneous nucleation'
+ tzsource%lavailable = hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'HONH'
+ tzsource%clongname = 'haze homogeneous nucleation'
+ tzsource%lavailable = hcloud == 'LIMA' .and. nmom_i.ge.1 .and. lnucl_lima .and. lhhoni_lima .and. nmod_ccn >= 1
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'HONC'
+ tzsource%clongname = 'droplet homogeneous freezing'
+ tzsource%lavailable = hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. lnucl_lima ) )
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'CNVI'
+ tzsource%clongname = 'conversion of snow to cloud ice'
+ tzsource%lavailable = hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_i.ge.1 .and. nmom_s.ge.1 ) )
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'CNVS'
+ tzsource%clongname = 'conversion of pristine ice to snow'
+ tzsource%lavailable = hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_i.ge.1 .and. nmom_s.ge.1 ) )
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'AGGS'
+ tzsource%clongname = 'aggregation of snow'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_i.ge.1 .and. nmom_s.ge.1 ) ) ) .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'AUTS'
+ tzsource%clongname = 'autoconversion of ice'
+ tzsource%lavailable = hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'IMLT'
+ tzsource%clongname = 'melting of ice'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 ) ) ) .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'BERFI'
+ tzsource%clongname = 'Bergeron-Findeisen'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 ) ) ) .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'HMS'
+ tzsource%clongname = 'Hallett-Mossop ice multiplication process due to snow riming'
+ tzsource%lavailable = hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 ) )
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'CIBU'
+ tzsource%clongname = 'ice multiplication process due to ice collisional breakup'
+ tzsource%lavailable = hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 .and. lcibu ) )
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'CFRZ'
+ tzsource%clongname = 'conversion freezing of rain'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 ) ) ) &
+ .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'RDSF'
+ tzsource%clongname = 'ice multiplication process following rain contact freezing'
+ tzsource%lavailable = hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 .and. lrdsf ) )
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'WETG'
+ tzsource%clongname = 'wet growth of graupel'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 ) ) ) &
+ .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'DRYG'
+ tzsource%clongname = 'dry growth of graupel'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 ) ) ) &
+ .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'HMG'
+ tzsource%clongname = 'Hallett-Mossop ice multiplication process due to graupel riming'
+ tzsource%lavailable = hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 ) )
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'WETH'
+ tzsource%clongname = 'wet growth of hail'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. .not.lptsplit .and. nmom_h.ge.1 .and. nmom_i.ge.1 &
+ .and. nmom_c.ge.1 .and. nmom_s.ge.1 ) &
+ .or. ( hcloud == 'LIMA' .and. lptsplit ) &
+ .or. hcloud == 'ICE4'
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'DRYH'
+ tzsource%clongname = 'dry growth of hail'
+ tzsource%lavailable = hcloud == 'ICE4' .and. lred .and. celec == 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'CEDS'
+ tzsource%clongname = 'adjustment to saturation'
+ tzsource%lavailable = hcloud == 'LIMA'
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'DEPI'
+ tzsource%clongname = 'condensation/deposition on ice'
+ tzsource%lavailable = ( hcloud(1:3) == 'ICE' .and. ( .not. lred .or. ( lred .and. ladj_after ) .or. celec /= 'NONE') ) &
+ .or. ( hcloud == 'LIMA' .and. lptsplit )
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'CORR2'
+ tzsource%clongname = 'supplementary correction inside LIMA splitting'
+ tzsource%lavailable = hcloud == 'LIMA' .and. lptsplit
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'NECON'
+ tzsource%clongname = 'negativity correction induced by condensation'
+ tzsource%lavailable = celec == 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+
+ call Sourcelist_sort_compact( tbudgets(NBUDGET_RI) )
+
+ call Sourcelist_scan( tbudgets(NBUDGET_RI), cbulist_rri )
+end if
+
+! Budget of RRS
+tbudgets(NBUDGET_RS)%lenabled = lbu_rrs .and. krr >= 5
+
+if ( tbudgets(NBUDGET_RS)%lenabled ) then
+ tbudgets(NBUDGET_RS)%trhodj => tburhodj
+
+ !Allocate all basic source terms (used or not)
+ !The size should be large enough (bigger than necessary is OK)
+ tbudgets(NBUDGET_RS)%nsourcesmax = NSOURCESMAX
+ allocate( tbudgets(NBUDGET_RS)%tsources(NSOURCESMAX) )
+
+ allocate( tbudgets(NBUDGET_RS)%xtmpstore(ibudim1, ibudim2, ibudim3) )
+
+ tbudgets(NBUDGET_RS)%tsources(:)%ngroup = 0
+
+ tzsource%ccomment = 'Budget of snow/aggregate mixing ratio'
+ tzsource%ngrid = 1
+
+ tzsource%cunits = 'kg kg-1'
+
+ tzsource%cmnhname = 'INIF'
+ tzsource%clongname = 'initial state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RS), tzsource, odonotinit = .true., ooverwrite = .true. )
+
+ tzsource%cmnhname = 'ENDF'
+ tzsource%clongname = 'final state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RS), tzsource, odonotinit = .true., ooverwrite = .true. )
+
+ tzsource%cmnhname = 'AVEF'
+ tzsource%clongname = 'averaged state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RS), tzsource, odonotinit = .true., ooverwrite = .false. )
+
+ tzsource%cunits = 's-1'
+
+ tzsource%cmnhname = 'ASSE'
+ tzsource%clongname = 'time filter (Asselin)'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RS), tzsource )
+
+ tzsource%cmnhname = 'NEST'
+ tzsource%clongname = 'nesting'
+ tzsource%lavailable = nmodel > 1
+ call Budget_source_add( tbudgets(NBUDGET_RS), tzsource )
+
+ tzsource%cmnhname = 'FRC'
+ tzsource%clongname = 'forcing'
+ tzsource%lavailable = lforcing
+ call Budget_source_add( tbudgets(NBUDGET_RS), tzsource )
+
+ tzsource%cmnhname = 'DIF'
+ tzsource%clongname = 'numerical diffusion'
+ tzsource%lavailable = onumdifth
+ call Budget_source_add( tbudgets(NBUDGET_RS), tzsource )
+
+ tzsource%cmnhname = 'REL'
+ tzsource%clongname = 'relaxation'
+ tzsource%lavailable = ohorelax_rs
+ call Budget_source_add( tbudgets(NBUDGET_RS), tzsource )
+
+! tzsource%cmnhname = 'NETUR'
+! tzsource%clongname = 'negativity correction induced by turbulence'
+! tzsource%lavailable = hturb == 'TKEL' .and. ( hcloud == 'ICE3' .or. hcloud == 'ICE4' &
+! .or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA' )
+! call Budget_source_add( tbudgets(NBUDGET_RS), tzsource nneturrs )
+
+ tzsource%cmnhname = 'VISC'
+ tzsource%clongname = 'viscosity'
+ tzsource%lavailable = lvisc .and. lvisc_r
+ call Budget_source_add( tbudgets(NBUDGET_RS), tzsource )
+
+ tzsource%cmnhname = 'ADV'
+ tzsource%clongname = 'total advection'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RS), tzsource )
+
+ tzsource%cmnhname = 'NEADV'
+ tzsource%clongname = 'negativity correction induced by advection'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RS), tzsource )
+
+ tzsource%cmnhname = 'NEGA'
+ tzsource%clongname = 'negativity correction'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RS), tzsource )
+
+ tzsource%cmnhname = 'CORR'
+ 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'
+ call Budget_source_add( tbudgets(NBUDGET_RS), tzsource )
+
+ tzsource%cmnhname = 'SEDI'
+ tzsource%clongname = 'sedimentation'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. nmom_i.ge.1 .and. nmom_s.ge.1 ) &
+ .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RS), tzsource )
+
+ tzsource%cmnhname = 'CNVI'
+ tzsource%clongname = 'conversion of snow to cloud ice'
+ tzsource%lavailable = hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_i.ge.1 .and. nmom_s.ge.1 ) )
+ call Budget_source_add( tbudgets(NBUDGET_RS), tzsource )
+
+ tzsource%cmnhname = 'DEPS'
+ tzsource%clongname = 'deposition on snow'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_i.ge.1 .and. nmom_s.ge.1 ) ) ) .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RS), tzsource )
+
+ tzsource%cmnhname = 'CNVS'
+ tzsource%clongname = 'conversion of pristine ice to snow'
+ tzsource%lavailable = hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_i.ge.1 .and. nmom_s.ge.1 ) )
+ call Budget_source_add( tbudgets(NBUDGET_RS), tzsource )
+
+ tzsource%cmnhname = 'AGGS'
+ tzsource%clongname = 'aggregation of snow'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_i.ge.1 .and. nmom_s.ge.1 ) ) ) .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RS), tzsource )
+
+ tzsource%cmnhname = 'AUTS'
+ tzsource%clongname = 'autoconversion of ice'
+ tzsource%lavailable = hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RS), tzsource )
+
+ tzsource%cmnhname = 'RIM'
+ tzsource%clongname = 'riming of cloud water'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 ) ) ) &
+ .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RS), tzsource )
+
+ tzsource%cmnhname = 'HMS'
+ tzsource%clongname = 'Hallett-Mossop ice multiplication process due to snow riming'
+ tzsource%lavailable = hcloud == 'LIMA' .and. ( lptsplit .or. (nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 ) )
+ call Budget_source_add( tbudgets(NBUDGET_RS), tzsource )
+
+ tzsource%cmnhname = 'CIBU'
+ tzsource%clongname = 'ice multiplication process due to ice collisional breakup'
+ tzsource%lavailable = hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 .and. lcibu ) )
+ call Budget_source_add( tbudgets(NBUDGET_RS), tzsource )
+
+ tzsource%cmnhname = 'ACC'
+ tzsource%clongname = 'accretion of rain on snow'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 &
+ .and. nmom_s.ge.1 .and. nmom_r.ge.1) ) ) &
+ .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RS), tzsource )
+
+ tzsource%cmnhname = 'CMEL'
+ tzsource%clongname = 'conversion melting'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 ) ) ) &
+ .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RS), tzsource )
+
+ tzsource%cmnhname = 'WETG'
+ tzsource%clongname = 'wet growth of graupel'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 ) ) ) &
+ .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RS), tzsource )
+
+ tzsource%cmnhname = 'DRYG'
+ tzsource%clongname = 'dry growth of graupel'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 ) ) ) &
+ .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RS), tzsource )
+
+ tzsource%cmnhname = 'WETH'
+ tzsource%clongname = 'wet growth of hail'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. .not.lptsplit .and. nmom_h.ge.1 .and. nmom_i.ge.1 &
+ .and. nmom_c.ge.1 .and. nmom_s.ge.1 ) &
+ .or. ( hcloud == 'LIMA' .and. lptsplit ) &
+ .or. hcloud == 'ICE4'
+ call Budget_source_add( tbudgets(NBUDGET_RS), tzsource )
+
+ tzsource%cmnhname = 'DRYH'
+ tzsource%clongname = 'dry growth of hail'
+ tzsource%lavailable = hcloud == 'ICE4' .and. lred .and. celec == 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_RS), tzsource )
+
+ tzsource%cmnhname = 'NECON'
+ tzsource%clongname = 'negativity correction induced by condensation'
+ tzsource%lavailable = celec == 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_RS), tzsource )
+
+
+ call Sourcelist_sort_compact( tbudgets(NBUDGET_RS) )
+
+ call Sourcelist_scan( tbudgets(NBUDGET_RS), cbulist_rrs )
+end if
+
+! Budget of RRG
+tbudgets(NBUDGET_RG)%lenabled = lbu_rrg .and. krr >= 6
+
+if ( tbudgets(NBUDGET_RG)%lenabled ) then
+ tbudgets(NBUDGET_RG)%trhodj => tburhodj
+
+ !Allocate all basic source terms (used or not)
+ !The size should be large enough (bigger than necessary is OK)
+ tbudgets(NBUDGET_RG)%nsourcesmax = NSOURCESMAX
+ allocate( tbudgets(NBUDGET_RG)%tsources(NSOURCESMAX) )
+
+ allocate( tbudgets(NBUDGET_RG)%xtmpstore(ibudim1, ibudim2, ibudim3) )
+
+ tbudgets(NBUDGET_RG)%tsources(:)%ngroup = 0
+
+ tzsource%ccomment = 'Budget of graupel mixing ratio'
+ tzsource%ngrid = 1
+
+ tzsource%cunits = 'kg kg-1'
+
+ tzsource%cmnhname = 'INIF'
+ tzsource%clongname = 'initial state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource, odonotinit = .true., ooverwrite = .true. )
+
+ tzsource%cmnhname = 'ENDF'
+ tzsource%clongname = 'final state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource, odonotinit = .true., ooverwrite = .true. )
+
+ tzsource%cmnhname = 'AVEF'
+ tzsource%clongname = 'averaged state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource, odonotinit = .true., ooverwrite = .false. )
+
+ tzsource%cunits = 's-1'
+
+ tzsource%cmnhname = 'ASSE'
+ tzsource%clongname = 'time filter (Asselin)'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
+
+ tzsource%cmnhname = 'NEST'
+ tzsource%clongname = 'nesting'
+ tzsource%lavailable = nmodel > 1
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
+
+ tzsource%cmnhname = 'FRC'
+ tzsource%clongname = 'forcing'
+ tzsource%lavailable = lforcing
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
+
+ tzsource%cmnhname = 'DIF'
+ tzsource%clongname = 'numerical diffusion'
+ tzsource%lavailable = onumdifth
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
+
+ tzsource%cmnhname = 'REL'
+ tzsource%clongname = 'relaxation'
+ tzsource%lavailable = ohorelax_rg
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
+
+! tzsource%cmnhname = 'NETUR'
+! tzsource%clongname = 'negativity correction induced by turbulence'
+! tzsource%lavailable = hturb == 'TKEL' .and. ( hcloud == 'ICE3' .or. hcloud == 'ICE4' &
+! .or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA' )
+! call Budget_source_add( tbudgets(NBUDGET_RG), tzsource nneturrg )
+
+ tzsource%cmnhname = 'VISC'
+ tzsource%clongname = 'viscosity'
+ tzsource%lavailable = lvisc .and. lvisc_r
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
+
+ tzsource%cmnhname = 'ADV'
+ tzsource%clongname = 'total advection'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
+
+ tzsource%cmnhname = 'NEADV'
+ tzsource%clongname = 'negativity correction induced by advection'
+ tzsource%lavailable = hcloud == 'ICE3' .or. hcloud == 'ICE4' .or. hcloud == 'LIMA'
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
+
+ tzsource%cmnhname = 'NEGA'
+ tzsource%clongname = 'negativity correction'
+ tzsource%lavailable = hcloud == 'ICE3' .or. hcloud == 'ICE4' .or. hcloud == 'LIMA'
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
+
+ tzsource%cmnhname = 'CORR'
+ tzsource%clongname = 'correction'
+ tzsource%lavailable = hcloud(1:3) == 'ICE' .and. lred .and. celec == 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
+
+ tzsource%cmnhname = 'SEDI'
+ tzsource%clongname = 'sedimentation'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. nmom_i.ge.1 .and. nmom_s.ge.1 ) &
+ .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
+
+ tzsource%cmnhname = 'HONR'
+ tzsource%clongname = 'rain homogeneous freezing'
+ tzsource%lavailable = hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_i.ge.1 .and. lnucl_lima .and. nmom_r.ge.1 ) )
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
+
+ tzsource%cmnhname = 'SFR'
+ tzsource%clongname = 'spontaneous freezing'
+ tzsource%lavailable = hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
+
+ tzsource%cmnhname = 'DEPG'
+ tzsource%clongname = 'deposition on graupel'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 ) ) ) &
+ .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
+
+ tzsource%cmnhname = 'RIM'
+ tzsource%clongname = 'riming of cloud water'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 ) ) ) &
+ .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
+
+ tzsource%cmnhname = 'ACC'
+ tzsource%clongname = 'accretion of rain on graupel'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 &
+ .and. nmom_s.ge.1 .and. nmom_r.ge.1) ) ) &
+ .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
+
+ tzsource%cmnhname = 'CMEL'
+ tzsource%clongname = 'conversion melting of snow'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. (nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1) ) ) &
+ .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
+
+ tzsource%cmnhname = 'CFRZ'
+ tzsource%clongname = 'conversion freezing of rain'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. (nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1) ) ) &
+ .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
+
+ tzsource%cmnhname = 'RDSF'
+ tzsource%clongname = 'ice multiplication process following rain contact freezing'
+ tzsource%lavailable = hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 .and. lrdsf ) )
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
+
+ tzsource%cmnhname = 'WETG'
+ tzsource%clongname = 'wet growth of graupel'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. (nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1) ) ) &
+ .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
+
+ tzsource%cmnhname = 'GHCV'
+ tzsource%clongname = 'graupel to hail conversion'
+ tzsource%lavailable = hcloud == 'ICE4' .and. lred .and. celec == 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
+
+ tzsource%cmnhname = 'DRYG'
+ tzsource%clongname = 'dry growth of graupel'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. (nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1) ) ) &
+ .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
+
+ tzsource%cmnhname = 'HMG'
+ tzsource%clongname = 'Hallett-Mossop ice multiplication process due to graupel riming'
+ tzsource%lavailable = hcloud == 'LIMA' .and. ( lptsplit .or. (nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 ) )
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
+
+ tzsource%cmnhname = 'GMLT'
+ tzsource%clongname = 'graupel melting'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. (nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1) ) ) &
+ .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
+
+ tzsource%cmnhname = 'WETH'
+ tzsource%clongname = 'wet growth of hail'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. .not.lptsplit .and. nmom_h.ge.1 .and. nmom_i.ge.1 &
+ .and. nmom_c.ge.1 .and. nmom_s.ge.1 ) &
+ .or. ( hcloud == 'LIMA' .and. lptsplit ) &
+ .or. hcloud == 'ICE4'
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
+
+ tzsource%cmnhname = 'COHG'
+ tzsource%clongname = 'conversion of hail to graupel'
+ tzsource%lavailable = hcloud == 'LIMA' .and. (lptsplit .or. (nmom_h.ge.1 .and. nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1) )
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
+
+ tzsource%cmnhname = 'HGCV'
+ tzsource%clongname = 'hail to graupel conversion'
+ tzsource%lavailable = hcloud == 'ICE4' .and. lred .and. celec == 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
+
+ tzsource%cmnhname = 'DRYH'
+ tzsource%clongname = 'dry growth of hail'
+ tzsource%lavailable = hcloud == 'ICE4' .and. lred .and. celec == 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
+
+ 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'
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
+
+
+ call Sourcelist_sort_compact( tbudgets(NBUDGET_RG) )
+
+ call Sourcelist_scan( tbudgets(NBUDGET_RG), cbulist_rrg )
+end if
+
+! Budget of RRH
+tbudgets(NBUDGET_RH)%lenabled = lbu_rrh .and. krr >= 7
+
+if ( tbudgets(NBUDGET_RH)%lenabled ) then
+ tbudgets(NBUDGET_RH)%trhodj => tburhodj
+
+ !Allocate all basic source terms (used or not)
+ !The size should be large enough (bigger than necessary is OK)
+ tbudgets(NBUDGET_RH)%nsourcesmax = NSOURCESMAX
+ allocate( tbudgets(NBUDGET_RH)%tsources(NSOURCESMAX) )
+
+ allocate( tbudgets(NBUDGET_RH)%xtmpstore(ibudim1, ibudim2, ibudim3) )
+
+ tbudgets(NBUDGET_RH)%tsources(:)%ngroup = 0
+
+ tzsource%ccomment = 'Budget of hail mixing ratio'
+ tzsource%ngrid = 1
+
+ tzsource%cunits = 'kg kg-1'
+
+ tzsource%cmnhname = 'INIF'
+ tzsource%clongname = 'initial state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RH), tzsource, odonotinit = .true., ooverwrite = .true. )
+
+ tzsource%cmnhname = 'ENDF'
+ tzsource%clongname = 'final state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RH), tzsource, odonotinit = .true., ooverwrite = .true. )
+
+ tzsource%cmnhname = 'AVEF'
+ tzsource%clongname = 'averaged state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RH), tzsource, odonotinit = .true., ooverwrite = .false. )
+
+ tzsource%cunits = 's-1'
+
+ tzsource%cmnhname = 'ASSE'
+ tzsource%clongname = 'time filter (Asselin)'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RH), tzsource )
+
+ tzsource%cmnhname = 'NEST'
+ tzsource%clongname = 'nesting'
+ tzsource%lavailable = nmodel > 1
+ call Budget_source_add( tbudgets(NBUDGET_RH), tzsource )
+
+ tzsource%cmnhname = 'FRC'
+ tzsource%clongname = 'forcing'
+ tzsource%lavailable = lforcing
+ call Budget_source_add( tbudgets(NBUDGET_RH), tzsource )
+
+ tzsource%cmnhname = 'DIF'
+ tzsource%clongname = 'numerical diffusion'
+ tzsource%lavailable = onumdifth
+ call Budget_source_add( tbudgets(NBUDGET_RH), tzsource )
+
+ tzsource%cmnhname = 'REL'
+ tzsource%clongname = 'relaxation'
+ tzsource%lavailable = ohorelax_rh
+ call Budget_source_add( tbudgets(NBUDGET_RH), tzsource )
+
+! tzsource%cmnhname = 'NETUR'
+! tzsource%clongname = 'negativity correction induced by turbulence'
+! tzsource%lavailable = hturb == 'TKEL' .and. ( hcloud == 'ICE3' .or. hcloud == 'ICE4' &
+! .or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA' )
+! call Budget_source_add( tbudgets(NBUDGET_RH), tzsource nneturrh )
+
+ tzsource%cmnhname = 'VISC'
+ tzsource%clongname = 'viscosity'
+ tzsource%lavailable = lvisc .and. lvisc_r
+ call Budget_source_add( tbudgets(NBUDGET_RH), tzsource )
+
+ tzsource%cmnhname = 'ADV'
+ tzsource%clongname = 'total advection'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RH), tzsource )
+
+ tzsource%cmnhname = 'NEADV'
+ tzsource%clongname = 'negativity correction induced by advection'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RH), tzsource )
+
+ tzsource%cmnhname = 'NEGA'
+ tzsource%clongname = 'negativity correction'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RH), tzsource )
+
+ tzsource%cmnhname = 'SEDI'
+ tzsource%clongname = 'sedimentation'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. nmom_i.ge.1 .and. nmom_h.ge.1 ) &
+ .or. hcloud == 'ICE4'
+ call Budget_source_add( tbudgets(NBUDGET_RH), tzsource )
+
+ tzsource%cmnhname = 'DEPH'
+ tzsource%clongname = 'deposition on hail'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. nmom_h.ge.1 )
+ call Budget_source_add( tbudgets(NBUDGET_RH), tzsource )
+
+
+ tzsource%cmnhname = 'GHCV'
+ tzsource%clongname = 'graupel to hail conversion'
+ tzsource%lavailable = hcloud == 'ICE4' .and. lred .and. celec == 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_RH), tzsource )
+
+ tzsource%cmnhname = 'WETG'
+ tzsource%clongname = 'wet growth of graupel'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. nmom_h.ge.1 &
+ .and. ( lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 ) ) ) &
+ .or. ( hcloud == 'ICE4' .and. ( .not. lred .or. celec /= 'NONE' ) )
+ call Budget_source_add( tbudgets(NBUDGET_RH), tzsource )
+
+ tzsource%cmnhname = 'WETH'
+ tzsource%clongname = 'wet growth of hail'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. .not.lptsplit .and. nmom_h.ge.1 .and. nmom_i.ge.1 &
+ .and. nmom_c.ge.1 .and. nmom_s.ge.1 ) &
+ .or. ( hcloud == 'LIMA' .and. lptsplit ) &
+ .or. hcloud == 'ICE4'
+ call Budget_source_add( tbudgets(NBUDGET_RH), tzsource )
+
+ tzsource%cmnhname = 'COHG'
+ tzsource%clongname = 'conversion from hail to graupel'
+ tzsource%lavailable = hcloud == 'LIMA' .and. ( lptsplit .or. (nmom_h.ge.1 .and. nmom_i.ge.1 &
+ .and. nmom_c.ge.1 .and. nmom_s.ge.1) )
+ call Budget_source_add( tbudgets(NBUDGET_RH), tzsource )
+
+ tzsource%cmnhname = 'HGCV'
+ tzsource%clongname = 'hail to graupel conversion'
+ tzsource%lavailable = hcloud == 'ICE4' .and. lred .and. celec == 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_RH), tzsource )
+
+ tzsource%cmnhname = 'DRYH'
+ tzsource%clongname = 'dry growth of hail'
+ tzsource%lavailable = hcloud == 'ICE4' .and. lred .and. celec == 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_RH), tzsource )
+
+ tzsource%cmnhname = 'HMLT'
+ tzsource%clongname = 'melting of hail'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. .not. lptsplit .and. nmom_h.ge.1 .and. nmom_i.ge.1 &
+ .and. nmom_c.ge.1 .and. nmom_s.ge.1 ) &
+ .or. ( hcloud == 'LIMA' .and. lptsplit ) &
+ .or. hcloud == 'ICE4'
+ call Budget_source_add( tbudgets(NBUDGET_RH), tzsource )
+
+ tzsource%cmnhname = 'CORR'
+ tzsource%clongname = 'correction'
+ tzsource%lavailable = hcloud == 'ICE4' .and. lred .and. celec == 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_RH), tzsource )
+
+ tzsource%cmnhname = 'NECON'
+ tzsource%clongname = 'negativity correction induced by condensation'
+ tzsource%lavailable = celec == 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_RH), tzsource )
+
+
+ call Sourcelist_sort_compact( tbudgets(NBUDGET_RH) )
+
+ call Sourcelist_scan( tbudgets(NBUDGET_RH), cbulist_rrh )
+end if
+
+! Budgets of RSV (scalar variables)
+
+if ( ksv > 999 ) call Print_msg( NVERB_FATAL, 'BUD', 'Ini_budget', 'number of scalar variables > 999' )
+
+SV_BUDGETS: do jsv = 1, ksv
+ ibudget = NBUDGET_SV1 - 1 + jsv
+
+ tbudgets(ibudget)%lenabled = lbu_rsv
+
+ if ( lbu_rsv ) then
+ tbudgets(ibudget)%trhodj => tburhodj
+
+ !Allocate all basic source terms (used or not)
+ !The size should be large enough (bigger than necessary is OK)
+ tbudgets(ibudget)%nsourcesmax = NSOURCESMAX
+ allocate( tbudgets(ibudget)%tsources(NSOURCESMAX) )
+
+ allocate( tbudgets(ibudget)%xtmpstore(ibudim1, ibudim2, ibudim3) )
+
+ tbudgets(ibudget)%tsources(:)%ngroup = 0
+
+ tzsource%ccomment = 'Budget of scalar variable ' // tsvlist(jsv)%cmnhname
+ tzsource%ngrid = 1
+
+ tzsource%cunits = '1'
+
+ tzsource%cmnhname = 'INIF'
+ tzsource%clongname = 'initial state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource, odonotinit = .true., ooverwrite = .true. )
+
+ tzsource%cmnhname = 'ENDF'
+ tzsource%clongname = 'final state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource, odonotinit = .true., ooverwrite = .true. )
+
+ tzsource%cmnhname = 'AVEF'
+ tzsource%clongname = 'averaged state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource, odonotinit = .true., ooverwrite = .false. )
+
+ tzsource%cunits = 's-1'
+
+ tzsource%cmnhname = 'ASSE'
+ tzsource%clongname = 'time filter (Asselin)'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'NEST'
+ tzsource%clongname = 'nesting'
+ tzsource%lavailable = nmodel > 1
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'FRC'
+ tzsource%clongname = 'forcing'
+ tzsource%lavailable = lforcing
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'DIF'
+ tzsource%clongname = 'numerical diffusion'
+ tzsource%lavailable = onumdifsv
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'REL'
+ tzsource%clongname = 'relaxation'
+ tzsource%lavailable = ohorelax_sv( jsv ) .or. ( celec /= 'NONE' .and. lrelax2fw_ion &
+ .and. (jsv == nsv_elecbeg .or. jsv == nsv_elecend ) )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'DCONV'
+ tzsource%clongname = 'KAFR convection'
+ tzsource%lavailable = ( hdconv == 'KAFR' .or. hsconv == 'KAFR' ) .and. ochtrans
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'VTURB'
+ tzsource%clongname = 'vertical turbulent diffusion'
+ tzsource%lavailable = hturb == 'TKEL'
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'HTURB'
+ tzsource%clongname = 'horizontal turbulent diffusion'
+ tzsource%lavailable = hturb == 'TKEL' .and. HTURBDIM == '3DIM'
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'MAFL'
+ tzsource%clongname = 'mass flux'
+ tzsource%lavailable = hsconv == 'EDKF'
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'VISC'
+ tzsource%clongname = 'viscosity'
+ tzsource%lavailable = lvisc .and. lvisc_sv
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'ADV'
+ tzsource%clongname = 'total advection'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'NEGA2'
+ tzsource%clongname = 'negativity correction'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ ! Add specific source terms to different scalar variables
+ SV_VAR: if ( jsv <= nsv_user ) then
+ ! nsv_user case
+ ! Nothing to do
+
+ else if ( jsv >= nsv_c2r2beg .and. jsv <= nsv_c2r2end ) then SV_VAR
+ ! C2R2 or KHKO Case
+
+ ! Source terms in common for all C2R2/KHKO budgets
+ 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 )
+
+ ! Source terms specific to each budget
+ SV_C2R2: select case( jsv - nsv_c2r2beg + 1 )
+ case ( 1 ) SV_C2R2
+ ! Concentration of activated nuclei
+ tzsource%cmnhname = 'HENU'
+ tzsource%clongname = 'CCN activation'
+ gtmp = cactccn == 'ABRK' .and. (lorilam .or. ldust .or. lsalt )
+ tzsource%lavailable = gtmp .or. ( .not.gtmp .and. .not.lsupsat_c2r2 )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CEVA'
+ tzsource%clongname = 'evaporation'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+
+ case ( 2 ) SV_C2R2
+ ! Concentration of cloud droplets
+ tzsource%cmnhname = 'DEPOTR'
+ tzsource%clongname = 'tree droplet deposition'
+ tzsource%lavailable = odragtree .and. odepotree
+ call Budget_source_add( tbudgets(ibudget), tzsource)
+
+ tzsource%cmnhname = 'HENU'
+ tzsource%clongname = 'CCN activation'
+ gtmp = cactccn == 'ABRK' .and. (lorilam .or. ldust .or. lsalt )
+ tzsource%lavailable = gtmp .or. ( .not.gtmp .and. .not.lsupsat_c2r2 )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'SELF'
+ tzsource%clongname = 'self-collection of cloud droplets'
+ tzsource%lavailable = lrain_c2r2
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'ACCR'
+ tzsource%clongname = 'accretion of cloud droplets'
+ tzsource%lavailable = lrain_c2r2
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'SEDI'
+ tzsource%clongname = 'sedimentation'
+ tzsource%lavailable = lsedc_c2r2
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'DEPO'
+ tzsource%clongname = 'surface droplet deposition'
+ tzsource%lavailable = ldepoc_c2r2
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CEVA'
+ tzsource%clongname = 'evaporation'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+
+ case ( 3 ) SV_C2R2
+ ! Concentration of raindrops
+ tzsource%cmnhname = 'AUTO'
+ tzsource%clongname = 'autoconversion into rain'
+ tzsource%lavailable = lrain_c2r2
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'SCBU'
+ tzsource%clongname = 'self collection - coalescence/break-up'
+ tzsource%lavailable = hcloud /= 'KHKO'
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'REVA'
+ tzsource%clongname = 'rain evaporation'
+ tzsource%lavailable = lrain_c2r2
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'BRKU'
+ tzsource%clongname = 'spontaneous break-up'
+ tzsource%lavailable = lrain_c2r2
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'SEDI'
+ tzsource%clongname = 'sedimentation'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+
+ case ( 4 ) SV_C2R2
+ ! Supersaturation
+ tzsource%cmnhname = 'CEVA'
+ tzsource%clongname = 'evaporation'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ end select SV_C2R2
+
+
+ else if ( jsv >= nsv_lima_beg .and. jsv <= nsv_lima_end ) then SV_VAR
+ ! LIMA case
+
+ ! Source terms in common for all LIMA budgets (except supersaturation)
+ if ( jsv /= nsv_lima_spro ) then
+ 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 )
+ end if
+
+
+ ! Source terms specific to each budget
+ SV_LIMA: if ( jsv == nsv_lima_nc ) then
+ ! Cloud droplets concentration
+ tzsource%cmnhname = 'DEPOTR'
+ tzsource%clongname = 'tree droplet deposition'
+ tzsource%lavailable = odragtree .and. odepotree
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+! tzsource%cmnhname = 'CORR'
+! tzsource%clongname = 'correction'
+! tzsource%lavailable = lptsplit .and. nmom_c.ge.1 .and. nmom_r.ge.1
+! call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'SEDI'
+ tzsource%clongname = 'sedimentation'
+ tzsource%lavailable = nmom_c.ge.1 .and. lsedc_lima
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'DEPO'
+ tzsource%clongname = 'surface droplet deposition'
+ tzsource%lavailable = nmom_c.ge.1 .and. ldepoc_lima
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'R2C1'
+ tzsource%clongname = 'rain to cloud change after sedimentation'
+ tzsource%lavailable = lptsplit .and. nmom_c.ge.1 .and. nmom_r.ge.1
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'HENU'
+ tzsource%clongname = 'CCN activation'
+ tzsource%lavailable = nmom_c.ge.1 .and. lacti_lima .and. nmod_ccn >= 1 .and. ( .not.lptsplit .or. .not.lsubg_cond )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'HINC'
+ tzsource%clongname = 'heterogeneous nucleation by contact'
+ tzsource%lavailable = nmom_i.ge.1 .and. lnucl_lima
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'SELF'
+ tzsource%clongname = 'self-collection of cloud droplets'
+ tzsource%lavailable = lptsplit .or. (nmom_c.ge.1 .and. nmom_r.ge.1)
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'AUTO'
+ tzsource%clongname = 'autoconversion into rain'
+ tzsource%lavailable = lptsplit .or. ( nmom_c.ge.1 .and. nmom_r.ge.1 )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'ACCR'
+ tzsource%clongname = 'accretion of cloud droplets'
+ tzsource%lavailable = lptsplit .or. ( nmom_c.ge.1 .and. nmom_r.ge.1 )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'REVA'
+ tzsource%clongname = 'rain evaporation'
+ tzsource%lavailable = lptsplit .or. ( nmom_c.ge.1 .and. nmom_r.ge.1 )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'HONC'
+ tzsource%clongname = 'droplet homogeneous freezing'
+ tzsource%lavailable = lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. lnucl_lima )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'IMLT'
+ tzsource%clongname = 'melting of ice'
+ tzsource%lavailable = lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'RIM'
+ tzsource%clongname = 'riming of cloud water'
+ tzsource%lavailable = lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'WETG'
+ tzsource%clongname = 'wet growth of graupel'
+ tzsource%lavailable = lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'DRYG'
+ tzsource%clongname = 'dry growth of graupel'
+ tzsource%lavailable = lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CVRC'
+ tzsource%clongname = 'rain to cloud change after other microphysical processes'
+ tzsource%lavailable = lptsplit
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'WETH'
+ tzsource%clongname = 'wet growth of hail'
+ tzsource%lavailable = lptsplit .or. nmom_h.ge.1
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CORR2'
+ tzsource%clongname = 'supplementary correction inside LIMA splitting'
+ tzsource%lavailable = lptsplit
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CEDS'
+ tzsource%clongname = 'adjustment to saturation'
+ tzsource%lavailable = nmom_c.ge.1
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+
+ else if ( jsv == nsv_lima_nr ) then SV_LIMA
+ ! Rain drops concentration
+! tzsource%cmnhname = 'CORR'
+! tzsource%clongname = 'correction'
+! tzsource%lavailable = lptsplit .and. nmom_c.ge.1 .and. nmom_r.ge.1
+! call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'SEDI'
+ tzsource%clongname = 'sedimentation'
+ tzsource%lavailable = nmom_c.ge.1 .and. nmom_r.ge.1
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'R2C1'
+ tzsource%clongname = 'rain to cloud change after sedimentation'
+ tzsource%lavailable = lptsplit .and. nmom_c.ge.1 .and. nmom_r.ge.1
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'AUTO'
+ tzsource%clongname = 'autoconversion into rain'
+ tzsource%lavailable = lptsplit .or. (nmom_c.ge.1 .and. nmom_r.ge.1)
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'SCBU'
+ tzsource%clongname = 'self collection - coalescence/break-up'
+ tzsource%lavailable = lptsplit .or. (nmom_c.ge.1 .and. nmom_r.ge.1)
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'REVA'
+ tzsource%clongname = 'rain evaporation'
+ tzsource%lavailable = lptsplit .or. (nmom_c.ge.1 .and. nmom_r.ge.1)
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'BRKU'
+ tzsource%clongname = 'spontaneous break-up'
+ tzsource%lavailable = lptsplit .or. (nmom_c.ge.1 .and. nmom_r.ge.1)
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'HONR'
+ tzsource%clongname = 'rain homogeneous freezing'
+ tzsource%lavailable = lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_r.ge.1 .and. lnucl_lima )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'ACC'
+ tzsource%clongname = 'accretion of rain on aggregates'
+ tzsource%lavailable = lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 .and. nmom_r.ge.1 )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CFRZ'
+ tzsource%clongname = 'conversion freezing of rain'
+ tzsource%lavailable = lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'WETG'
+ tzsource%clongname = 'wet growth of graupel'
+ tzsource%lavailable = lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'DRYG'
+ tzsource%clongname = 'dry growth of graupel'
+ tzsource%lavailable = lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'GMLT'
+ tzsource%clongname = 'graupel melting'
+ tzsource%lavailable = lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CVRC'
+ tzsource%clongname = 'rain to cloud change after other microphysical processes'
+ tzsource%lavailable = lptsplit
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'WETH'
+ tzsource%clongname = 'wet growth of hail'
+ tzsource%lavailable = lptsplit .or. nmom_h.ge.1
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'HMLT'
+ tzsource%clongname = 'melting of hail'
+ tzsource%lavailable = lptsplit .or. nmom_h.ge.1
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CORR2'
+ tzsource%clongname = 'supplementary correction inside LIMA splitting'
+ tzsource%lavailable = lptsplit
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+
+ else if ( jsv >= nsv_lima_ccn_free .and. jsv <= nsv_lima_ccn_free + nmod_ccn - 1 ) then SV_LIMA
+ ! Free CCN concentration
+ tzsource%cmnhname = 'HENU'
+ tzsource%clongname = 'CCN activation'
+ tzsource%lavailable = nmom_c.ge.1 .and. lacti_lima .and. nmod_ccn >= 1 .and. ( .not.lptsplit .or. .not.lsubg_cond )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'HONH'
+ tzsource%clongname = 'haze homogeneous nucleation'
+ tzsource%lavailable = nmom_i.ge.1 .and. lnucl_lima .and. lhhoni_lima .and. nmod_ccn >= 1
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CEDS'
+ tzsource%clongname = 'adjustment to saturation'
+ tzsource%lavailable = nmom_c.ge.1
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'SCAV'
+ tzsource%clongname = 'scavenging'
+ tzsource%lavailable = lscav_lima
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+
+ else if ( jsv >= nsv_lima_ccn_acti .and. jsv <= nsv_lima_ccn_acti + nmod_ccn - 1 ) then SV_LIMA
+ ! Activated CCN concentration
+ tzsource%cmnhname = 'HENU'
+ tzsource%clongname = 'CCN activation'
+ tzsource%lavailable = nmom_c.ge.1 .and. lacti_lima .and. nmod_ccn >= 1 .and. ( .not.lptsplit .or. .not.lsubg_cond )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'HINC'
+ tzsource%clongname = 'heterogeneous nucleation by contact'
+ tzsource%lavailable = nmom_i.ge.1 .and. lnucl_lima .and. .not. lmeyers_lima
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CEDS'
+ tzsource%clongname = 'adjustment to saturation'
+ tzsource%lavailable = nmom_c.ge.1
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+
+ else if ( jsv == nsv_lima_scavmass ) then SV_LIMA
+ ! Scavenged mass variable
+ tzsource%cmnhname = 'SCAV'
+ tzsource%clongname = 'scavenging'
+ tzsource%lavailable = lscav_lima .and. laero_mass_lima
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CEDS'
+ tzsource%clongname = 'adjustment to saturation'
+ tzsource%lavailable = lscav_lima .and. laero_mass_lima .and. .not.lspro_lima
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+
+ else if ( jsv == nsv_lima_ni ) then SV_LIMA
+ ! Pristine ice crystals concentration
+! tzsource%cmnhname = 'CORR'
+! tzsource%clongname = 'correction'
+! tzsource%lavailable = lptsplit .and. nmom_i.ge.1 .and. nmom_s.ge.1
+! call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'SEDI'
+ tzsource%clongname = 'sedimentation'
+ tzsource%lavailable = nmom_i.ge.1 .and. lsedi_lima
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'HIND'
+ tzsource%clongname = 'heterogeneous nucleation by deposition'
+ tzsource%lavailable = nmom_i.ge.1 .and. lnucl_lima
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'HINC'
+ tzsource%clongname = 'heterogeneous nucleation by contact'
+ tzsource%lavailable = nmom_i.ge.1 .and. lnucl_lima
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'HONH'
+ tzsource%clongname = 'haze homogeneous nucleation'
+ tzsource%lavailable = nmom_i.ge.1 .and. lnucl_lima .and. lhhoni_lima .and. nmod_ccn >= 1
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'HONC'
+ tzsource%clongname = 'droplet homogeneous freezing'
+ tzsource%lavailable = lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. lnucl_lima )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CNVI'
+ tzsource%clongname = 'conversion of snow to cloud ice'
+ tzsource%lavailable = lptsplit .or. ( nmom_i.ge.1 .and. nmom_s.ge.1 )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CNVS'
+ tzsource%clongname = 'conversion of pristine ice to snow'
+ tzsource%lavailable = lptsplit .or. ( nmom_i.ge.1 .and. nmom_s.ge.1 )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'AGGS'
+ tzsource%clongname = 'aggregation of snow'
+ tzsource%lavailable = lptsplit .or. ( nmom_i.ge.1 .and. nmom_s.ge.1 )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'IMLT'
+ tzsource%clongname = 'melting of ice'
+ tzsource%lavailable = lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'HMS'
+ tzsource%clongname = 'Hallett-Mossop ice multiplication process due to snow riming'
+ tzsource%lavailable = lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CIBU'
+ tzsource%clongname = 'ice multiplication process due to ice collisional breakup'
+ tzsource%lavailable = lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 .and. lcibu )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CFRZ'
+ tzsource%clongname = 'conversion freezing of rain'
+ tzsource%lavailable = lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'RDSF'
+ tzsource%clongname = 'ice multiplication process following rain contact freezing'
+ tzsource%lavailable = lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 .and. lrdsf )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'WETG'
+ tzsource%clongname = 'wet growth of graupel'
+ tzsource%lavailable = lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'DRYG'
+ tzsource%clongname = 'dry growth of graupel'
+ tzsource%lavailable = lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'HMG'
+ tzsource%clongname = 'Hallett-Mossop ice multiplication process due to graupel riming'
+ tzsource%lavailable = lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'WETH'
+ tzsource%clongname = 'wet growth of hail'
+ tzsource%lavailable = lptsplit .or. nmom_h.ge.1
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CEDS'
+ tzsource%clongname = 'adjustment to saturation'
+ tzsource%lavailable = nmom_i.ge.1 .and. .not.lptsplit .and. .not.lspro_lima
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CORR2'
+ tzsource%clongname = 'supplementary correction inside LIMA splitting'
+ tzsource%lavailable = lptsplit
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ else if ( jsv == nsv_lima_ns ) then SV_LIMA
+
+ tzsource%cmnhname = 'SEDI'
+ tzsource%clongname = 'sedimentation'
+ tzsource%lavailable = lptsplit .or. ( nmom_s.ge.2 )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CNVI'
+ tzsource%clongname = 'conversion of snow to cloud ice'
+ tzsource%lavailable = lptsplit .or. ( nmom_i.ge.1 .and. nmom_s.ge.1 )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CNVS'
+ tzsource%clongname = 'conversion of pristine ice to snow'
+ tzsource%lavailable = lptsplit .or. ( nmom_i.ge.1 .and. nmom_s.ge.1 )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'BRKU'
+ tzsource%clongname = 'break up of snow'
+ tzsource%lavailable = lptsplit .or. ( nmom_i.ge.1 .and. nmom_s.ge.1 )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'RIM'
+ tzsource%clongname = 'heavy riming of cloud droplet on snow'
+ tzsource%lavailable = lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'ACC'
+ tzsource%clongname = 'accretion of rain on snow'
+ tzsource%lavailable = lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CMEL'
+ tzsource%clongname = 'conversion melting of snow'
+ tzsource%lavailable = lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'WETG'
+ tzsource%clongname = 'wet growth of graupel'
+ tzsource%lavailable = lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'DRYG'
+ tzsource%clongname = 'dry growth of graupel'
+ tzsource%lavailable = lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'WETH'
+ tzsource%clongname = 'wet growth of hail'
+ tzsource%lavailable = lptsplit .or. nmom_h.ge.1
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'SSC'
+ tzsource%clongname = 'snow self collection'
+ tzsource%lavailable = lptsplit .or. ( nmom_i.ge.1 .and. nmom_s.ge.1 )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CEDS'
+ tzsource%clongname = 'adjustment to saturation'
+ tzsource%lavailable = nmom_i.ge.1 .and. .not.lptsplit .and. .not.lspro_lima
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ else if ( jsv == nsv_lima_ng ) then SV_LIMA
+
+ tzsource%cmnhname = 'SEDI'
+ tzsource%clongname = 'sedimentation'
+ tzsource%lavailable = nmom_i.ge.1 .or. ( nmom_s.ge.1 )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'RIM'
+ tzsource%clongname = 'heavy riming of cloud droplet on snow'
+ tzsource%lavailable = lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'ACC'
+ tzsource%clongname = 'accretion of rain on snow'
+ tzsource%lavailable = lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CMEL'
+ tzsource%clongname = 'conversion melting of snow'
+ tzsource%lavailable = lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CFRZ'
+ tzsource%clongname = 'conversion freezing of raindrop'
+ tzsource%lavailable = lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'WETG'
+ tzsource%clongname = 'wet growth of graupel'
+ tzsource%lavailable = lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'GMLT'
+ tzsource%clongname = 'graupel melting'
+ tzsource%lavailable = lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'WETH'
+ tzsource%clongname = 'wet growth of hail'
+ tzsource%lavailable = lptsplit .or. nmom_h.ge.1
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'COHG'
+ tzsource%clongname = 'conversion hail graupel'
+ tzsource%lavailable = lptsplit .or. nmom_h.ge.1
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CEDS'
+ tzsource%clongname = 'adjustment to saturation'
+ tzsource%lavailable = nmom_i.ge.1 .and. .not.lptsplit .and. .not.lspro_lima
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ else if ( jsv == nsv_lima_nh .and. nmom_h.ge.1) then SV_LIMA
+
+ tzsource%cmnhname = 'SEDI'
+ tzsource%clongname = 'sedimentation'
+ tzsource%lavailable = nmom_i.ge.1 .or. ( nmom_i.ge.1 .and. nmom_s.ge.1 .and. nmom_h.ge.1 )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'WETG'
+ tzsource%clongname = 'wet growth of graupel'
+ tzsource%lavailable = lptsplit .or. nmom_h.ge.1
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'COHG'
+ tzsource%clongname = 'conversion hail graupel'
+ tzsource%lavailable = lptsplit .or. nmom_h.ge.1
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'HMLT'
+ tzsource%clongname = 'hail melting'
+ tzsource%lavailable = lptsplit .or. nmom_h.ge.1
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ else if ( jsv >= nsv_lima_ifn_free .and. jsv <= nsv_lima_ifn_free + nmod_ifn - 1 ) then SV_LIMA
+ ! Free IFN concentration
+ tzsource%cmnhname = 'HIND'
+ tzsource%clongname = 'heterogeneous nucleation by deposition'
+ tzsource%lavailable = nmom_i.ge.1 .and. lnucl_lima .and. .not. lmeyers_lima
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CEDS'
+ tzsource%clongname = 'adjustment to saturation'
+ tzsource%lavailable = nmom_i.ge.1 .and. .not.lptsplit .and. .not.lspro_lima
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'SCAV'
+ tzsource%clongname = 'scavenging'
+ tzsource%lavailable = lscav_lima
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+
+ else if ( jsv >= nsv_lima_ifn_nucl .and. jsv <= nsv_lima_ifn_nucl + nmod_ifn - 1 ) then SV_LIMA
+ ! Nucleated IFN concentration
+ tzsource%cmnhname = 'HIND'
+ tzsource%clongname = 'heterogeneous nucleation by deposition'
+ tzsource%lavailable = nmom_i.ge.1 .and. lnucl_lima &
+ .and. ( ( lmeyers_lima .and. jsv == nsv_lima_ifn_nucl ) .or. .not. lmeyers_lima )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'HINC'
+ tzsource%clongname = 'heterogeneous nucleation by contact'
+ tzsource%lavailable = nmom_i.ge.1 .and. lnucl_lima .and. lmeyers_lima .and. jsv == nsv_lima_ifn_nucl
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'IMLT'
+ tzsource%clongname = 'melting of ice'
+ tzsource%lavailable = lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CEDS'
+ tzsource%clongname = 'adjustment to saturation'
+ tzsource%lavailable = nmom_i.ge.1 .and. .not.lptsplit .and. .not.lspro_lima
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+
+ else if ( jsv >= nsv_lima_imm_nucl .and. jsv <= nsv_lima_imm_nucl + nmod_imm - 1 ) then SV_LIMA
+ ! Nucleated IMM concentration
+ tzsource%cmnhname = 'HINC'
+ tzsource%clongname = 'heterogeneous nucleation by contact'
+ tzsource%lavailable = nmom_i.ge.1 .and. lnucl_lima .and. .not. lmeyers_lima
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CEDS'
+ tzsource%clongname = 'adjustment to saturation'
+ tzsource%lavailable = nmom_i.ge.1 .and. .not.lptsplit .and. .not.lspro_lima
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+
+ else if ( jsv == nsv_lima_hom_haze ) then SV_LIMA
+ ! Homogeneous freezing of CCN
+ tzsource%cmnhname = 'HONH'
+ tzsource%clongname = 'haze homogeneous nucleation'
+ tzsource%lavailable = nmom_i.ge.1 .and. lnucl_lima .and. &
+ ( ( lhhoni_lima .and. nmod_ccn >= 1 ) .or. ( .not.lptsplit .and. nmom_c.ge.1 ) )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+
+ else if ( jsv == nsv_lima_spro ) then SV_LIMA
+ ! Supersaturation
+ tzsource%cmnhname = 'CEDS'
+ tzsource%clongname = 'adjustment to saturation'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ end if SV_LIMA
+
+
+ else if ( jsv >= nsv_elecbeg .and. jsv <= nsv_elecend ) then SV_VAR
+ ! Electricity case
+ tzsource%cmnhname = 'NEGA'
+ tzsource%clongname = 'negativity correction'
+ 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
+ tzsource%cmnhname = 'DRIFT'
+ tzsource%clongname = 'ion drift motion'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CORAY'
+ tzsource%clongname = 'cosmic ray source'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'DEPS'
+ tzsource%clongname = 'deposition on snow'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'DEPG'
+ tzsource%clongname = 'deposition on graupel'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'REVA'
+ tzsource%clongname = 'rain evaporation'
+ tzsource%lavailable = lwarm_ice
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'DEPI'
+ tzsource%clongname = 'condensation/deposition on ice'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'NEUT'
+ tzsource%clongname = 'neutralization'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+
+ case ( 2 ) SV_ELEC
+ ! volumetric charge of cloud droplets
+ tzsource%cmnhname = 'HON'
+ tzsource%clongname = 'homogeneous nucleation'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'AUTO'
+ tzsource%clongname = 'autoconversion into rain'
+ tzsource%lavailable = lwarm_ice
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'ACCR'
+ tzsource%clongname = 'accretion of cloud droplets'
+ tzsource%lavailable = lwarm_ice
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'RIM'
+ tzsource%clongname = 'riming of cloud water'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'WETG'
+ tzsource%clongname = 'wet growth of graupel'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'DRYG'
+ tzsource%clongname = 'dry growth of graupel'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'INCG'
+ tzsource%clongname = 'inductive charge transfer between cloud droplets and graupel'
+ tzsource%lavailable = linductive
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'WETH'
+ tzsource%clongname = 'wet growth of hail'
+ tzsource%lavailable = hcloud == 'ICE4'
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'IMLT'
+ tzsource%clongname = 'melting of ice'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'BERFI'
+ tzsource%clongname = 'Bergeron-Findeisen'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'SEDI'
+ tzsource%clongname = 'sedimentation'
+ tzsource%lavailable = lsedic_ice
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'DEPI'
+ tzsource%clongname = 'condensation/deposition on ice'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'NEUT'
+ tzsource%clongname = 'neutralization'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+
+ case ( 3 ) SV_ELEC
+ ! volumetric charge of rain drops
+ tzsource%cmnhname = 'SFR'
+ tzsource%clongname = 'spontaneous freezing'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'AUTO'
+ tzsource%clongname = 'autoconversion into rain'
+ tzsource%lavailable = lwarm_ice
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'ACCR'
+ tzsource%clongname = 'accretion of cloud droplets'
+ tzsource%lavailable = lwarm_ice
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'REVA'
+ tzsource%clongname = 'rain evaporation'
+ tzsource%lavailable = lwarm_ice
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'ACC'
+ tzsource%clongname = 'accretion of rain on aggregates'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CFRZ'
+ tzsource%clongname = 'conversion freezing of rain'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'WETG'
+ tzsource%clongname = 'wet growth of graupel'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'DRYG'
+ tzsource%clongname = 'dry growth of graupel'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'GMLT'
+ tzsource%clongname = 'graupel melting'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'WETH'
+ tzsource%clongname = 'wet growth of hail'
+ tzsource%lavailable = hcloud == 'ICE4'
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'HMLT'
+ tzsource%clongname = 'melting of hail'
+ tzsource%lavailable = hcloud == 'ICE4'
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'SEDI'
+ tzsource%clongname = 'sedimentation'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'NEUT'
+ tzsource%clongname = 'neutralization'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ case ( 4 ) SV_ELEC
+ ! volumetric charge of ice crystals
+ tzsource%cmnhname = 'HON'
+ tzsource%clongname = 'homogeneous nucleation'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'AGGS'
+ tzsource%clongname = 'aggregation of snow'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'AUTS'
+ tzsource%clongname = 'autoconversion of ice'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CFRZ'
+ tzsource%clongname = 'conversion freezing of rain'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'WETG'
+ tzsource%clongname = 'wet growth of graupel'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'DRYG'
+ tzsource%clongname = 'dry growth of graupel'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'WETH'
+ tzsource%clongname = 'wet growth of hail'
+ tzsource%lavailable = hcloud == 'ICE4'
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'IMLT'
+ tzsource%clongname = 'melting of ice'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'BERFI'
+ tzsource%clongname = 'Bergeron-Findeisen'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'NIIS'
+ tzsource%clongname = 'non-inductive charge separation due to ice-snow collisions'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'SEDI'
+ tzsource%clongname = 'sedimentation'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'DEPI'
+ tzsource%clongname = 'condensation/deposition on ice'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'NEUT'
+ tzsource%clongname = 'neutralization'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+
+ case ( 5 ) SV_ELEC
+ ! volumetric charge of snow
+ tzsource%cmnhname = 'DEPS'
+ tzsource%clongname = 'deposition on snow'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'AGGS'
+ tzsource%clongname = 'aggregation of snow'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'AUTS'
+ tzsource%clongname = 'autoconversion of ice'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'RIM'
+ tzsource%clongname = 'riming of cloud water'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'ACC'
+ tzsource%clongname = 'accretion of rain on snow'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CMEL'
+ tzsource%clongname = 'conversion melting'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'WETG'
+ tzsource%clongname = 'wet growth of graupel'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'DRYG'
+ tzsource%clongname = 'dry growth of graupel'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'NIIS'
+ tzsource%clongname = 'non-inductive charge separation due to ice-snow collisions'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'WETH'
+ tzsource%clongname = 'wet growth of hail'
+ tzsource%lavailable = hcloud == 'ICE4'
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'SEDI'
+ tzsource%clongname = 'sedimentation'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'NEUT'
+ tzsource%clongname = 'neutralization'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+
+ case ( 6 ) SV_ELEC
+ ! volumetric charge of graupel
+ tzsource%cmnhname = 'SFR'
+ tzsource%clongname = 'spontaneous freezing'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'DEPG'
+ tzsource%clongname = 'deposition on graupel'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'RIM'
+ tzsource%clongname = 'riming of cloud water'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'ACC'
+ tzsource%clongname = 'accretion of rain on graupel'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CMEL'
+ tzsource%clongname = 'conversion melting'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CFRZ'
+ tzsource%clongname = 'conversion freezing of rain'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'WETG'
+ tzsource%clongname = 'wet growth of graupel'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'DRYG'
+ tzsource%clongname = 'dry growth of graupel'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'INCG'
+ tzsource%clongname = 'inductive charge transfer between cloud droplets and graupel'
+ tzsource%lavailable = linductive
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'GMLT'
+ tzsource%clongname = 'graupel melting'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'WETH'
+ tzsource%clongname = 'wet growth of hail'
+ tzsource%lavailable = hcloud == 'ICE4'
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'SEDI'
+ tzsource%clongname = 'sedimentation'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'NEUT'
+ tzsource%clongname = 'neutralization'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+
+ case ( 7: ) SV_ELEC
+ if ( ( hcloud == 'ICE4' .and. ( jsv - nsv_elecbeg + 1 ) == 7 ) ) then
+ ! volumetric charge of hail
+ tzsource%cmnhname = 'WETG'
+ tzsource%clongname = 'wet growth of graupel'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'WETH'
+ tzsource%clongname = 'wet growth of hail'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'HMLT'
+ tzsource%clongname = 'melting of hail'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'SEDI'
+ tzsource%clongname = 'sedimentation'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'NEUT'
+ tzsource%clongname = 'neutralization'
+ 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
+ ! Negative ions (NSV_ELECEND case)
+ tzsource%cmnhname = 'DRIFT'
+ tzsource%clongname = 'ion drift motion'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CORAY'
+ tzsource%clongname = 'cosmic ray source'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'DEPS'
+ tzsource%clongname = 'deposition on snow'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'DEPG'
+ tzsource%clongname = 'deposition on graupel'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'REVA'
+ tzsource%clongname = 'rain evaporation'
+ tzsource%lavailable = lwarm_ice
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'DEPI'
+ tzsource%clongname = 'condensation/deposition on ice'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'NEUT'
+ tzsource%clongname = 'neutralization'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ else
+ call Print_msg( NVERB_FATAL, 'BUD', 'Ini_budget', 'unknown electricity budget' )
+ end if
+
+ end select SV_ELEC
+
+
+ else if ( jsv >= nsv_lgbeg .and. jsv <= nsv_lgend ) then SV_VAR
+ !Lagrangian variables
+
+
+ else if ( jsv >= nsv_ppbeg .and. jsv <= nsv_ppend ) then SV_VAR
+ !Passive pollutants
+
+
+#ifdef MNH_FOREFIRE
+ else if ( jsv >= nsv_ffbeg .and. jsv <= nsv_ffend ) then SV_VAR
+ !Forefire
+
+#endif
+ else if ( jsv >= nsv_csbeg .and. jsv <= nsv_csend ) then SV_VAR
+ !Conditional sampling
+
+
+ else if ( jsv >= nsv_chembeg .and. jsv <= nsv_chemend ) then SV_VAR
+ !Chemical case
+ tzsource%cmnhname = 'CHEM'
+ tzsource%clongname = 'chemistry activity'
+ 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 )
+
+
+ else if ( jsv >= nsv_chicbeg .and. jsv <= nsv_chicend ) then SV_VAR
+ !Ice phase chemistry
+
+
+ else if ( jsv >= nsv_aerbeg .and. jsv <= nsv_aerend ) then SV_VAR
+ !Chemical aerosol case
+ tzsource%cmnhname = 'NEGA'
+ tzsource%clongname = 'negativity correction'
+ tzsource%lavailable = lorilam
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ else if ( jsv >= nsv_aerdepbeg .and. jsv <= nsv_aerdepend ) then SV_VAR
+ !Aerosol wet deposition
+
+ else if ( jsv >= nsv_dstbeg .and. jsv <= nsv_dstend ) then SV_VAR
+ !Dust
+
+ else if ( jsv >= nsv_dstdepbeg .and. jsv <= nsv_dstdepend ) then SV_VAR
+ !Dust wet deposition
+
+ else if ( jsv >= nsv_sltbeg .and. jsv <= nsv_sltend ) then SV_VAR
+ !Salt
+
+ else if ( jsv >= nsv_sltdepbeg .and. jsv <= nsv_sltdepend ) then SV_VAR
+ !Salt wet deposition
+
+ else if ( jsv >= nsv_snwbeg .and. jsv <= nsv_snwend ) then SV_VAR
+ !Snow
+ tzsource%cmnhname = 'SNSUB'
+ tzsource%clongname = 'blowing snow sublimation'
+ tzsource%lavailable = lblowsnow .and. lsnowsubl
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'SNSED'
+ tzsource%clongname = 'blowing snow sedimentation'
+ tzsource%lavailable = lblowsnow
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+
+ else if ( jsv >= nsv_lnoxbeg .and. jsv <= nsv_lnoxend ) then SV_VAR
+ !LiNOX passive tracer
+
+ else SV_VAR
+ call Print_msg( NVERB_FATAL, 'BUD', 'Ini_budget', 'unknown scalar variable' )
+ end if SV_VAR
+
+
+ call Sourcelist_sort_compact( tbudgets(ibudget) )
+
+ call Sourcelist_scan( tbudgets(ibudget), cbulist_rsv )
+ end if
+end do SV_BUDGETS
+
+call Ini_budget_groups( tbudgets, ibudim1, ibudim2, ibudim3 )
+
+if ( tbudgets(NBUDGET_U) %lenabled ) call Sourcelist_nml_compact( tbudgets(NBUDGET_U), cbulist_ru )
+if ( tbudgets(NBUDGET_V) %lenabled ) call Sourcelist_nml_compact( tbudgets(NBUDGET_V), cbulist_rv )
+if ( tbudgets(NBUDGET_W) %lenabled ) call Sourcelist_nml_compact( tbudgets(NBUDGET_W), cbulist_rw )
+if ( tbudgets(NBUDGET_TH) %lenabled ) call Sourcelist_nml_compact( tbudgets(NBUDGET_TH), cbulist_rth )
+if ( tbudgets(NBUDGET_TKE)%lenabled ) call Sourcelist_nml_compact( tbudgets(NBUDGET_TKE), cbulist_rtke )
+if ( tbudgets(NBUDGET_RV) %lenabled ) call Sourcelist_nml_compact( tbudgets(NBUDGET_RV), cbulist_rrv )
+if ( tbudgets(NBUDGET_RC) %lenabled ) call Sourcelist_nml_compact( tbudgets(NBUDGET_RC), cbulist_rrc )
+if ( tbudgets(NBUDGET_RR) %lenabled ) call Sourcelist_nml_compact( tbudgets(NBUDGET_RR), cbulist_rrr )
+if ( tbudgets(NBUDGET_RI) %lenabled ) call Sourcelist_nml_compact( tbudgets(NBUDGET_RI), cbulist_rri )
+if ( tbudgets(NBUDGET_RS) %lenabled ) call Sourcelist_nml_compact( tbudgets(NBUDGET_RS), cbulist_rrs )
+if ( tbudgets(NBUDGET_RG) %lenabled ) call Sourcelist_nml_compact( tbudgets(NBUDGET_RG), cbulist_rrg )
+if ( tbudgets(NBUDGET_RH) %lenabled ) call Sourcelist_nml_compact( tbudgets(NBUDGET_RH), cbulist_rrh )
+if ( lbu_rsv ) call Sourcelist_sv_nml_compact( cbulist_rsv )
+end subroutine Ini_budget
+
+
+subroutine Budget_source_add( tpbudget, tpsource, odonotinit, ooverwrite )
+ use modd_budget, only: tbudgetdata, tbusourcedata
+
+ type(tbudgetdata), intent(inout) :: tpbudget
+ type(tbusourcedata), intent(in) :: tpsource ! Metadata basis
+ logical, optional, intent(in) :: odonotinit
+ logical, optional, intent(in) :: ooverwrite
+
+ character(len=4) :: ynum
+ integer :: isourcenumber
+
+ call Print_msg( NVERB_DEBUG, 'BUD', 'Budget_source_add', 'called for ' // Trim( tpbudget%cname ) &
+ // ': ' // Trim( tpsource%cmnhname ) )
+
+ isourcenumber = tpbudget%nsources + 1
+ if ( isourcenumber > tpbudget%nsourcesmax ) then
+ Write( ynum, '( i4 )' ) tpbudget%nsourcesmax
+ cmnhmsg(1) = 'Insufficient max number of source terms (' // Trim(ynum) // ') for budget ' // Trim( tpbudget%cname )
+ cmnhmsg(2) = 'Please increaze value of parameter NSOURCESMAX'
+ call Print_msg( NVERB_FATAL, 'BUD', 'Budget_source_add' )
+ else
+ tpbudget%nsources = tpbudget%nsources + 1
+ end if
+
+ ! Copy metadata from provided tpsource
+ ! Modifications to source term metadata done with the other dummy arguments
+ tpbudget%tsources(isourcenumber) = tpsource
+
+ if ( present( odonotinit ) ) tpbudget%tsources(isourcenumber)%ldonotinit = odonotinit
+
+ if ( present( ooverwrite ) ) tpbudget%tsources(isourcenumber)%loverwrite = ooverwrite
+end subroutine Budget_source_add
+
+
+subroutine Ini_budget_groups( tpbudgets, kbudim1, kbudim2, kbudim3 )
+ use modd_budget, only: tbudgetdata
+ use modd_field, only: TYPEINT, TYPEREAL
+ use modd_parameters, only: NMNHNAMELGTMAX, NSTDNAMELGTMAX, NLONGNAMELGTMAX, NUNITLGTMAX, NCOMMENTLGTMAX
+
+ use mode_tools, only: Quicksort
+
+ type(tbudgetdata), dimension(:), intent(inout) :: tpbudgets
+ integer, intent(in) :: kbudim1
+ integer, intent(in) :: kbudim2
+ integer, intent(in) :: kbudim3
+
+ character(len=NMNHNAMELGTMAX) :: ymnhname
+ character(len=NSTDNAMELGTMAX) :: ystdname
+ character(len=NLONGNAMELGTMAX) :: ylongname
+ character(len=NUNITLGTMAX) :: yunits
+ character(len=NCOMMENTLGTMAX) :: ycomment
+ integer :: ji, jj, jk
+ integer :: isources ! Number of source terms in a budget
+ integer :: inbgroups ! Number of budget groups
+ integer :: ival
+ integer :: icount
+ integer :: ivalmax, ivalmin
+ integer :: igrid
+ integer :: itype
+ integer :: idims
+ integer, dimension(:), allocatable :: igroups ! Temporary array to store sorted group numbers
+ integer, dimension(:), allocatable :: ipos ! Temporary array to store initial position of group numbers
+ real :: zval
+ real :: zvalmax, zvalmin
+
+ call Print_msg( NVERB_DEBUG, 'BUD', 'Ini_budget_groups', 'called' )
+
+ BUDGETS: do ji = 1, size( tpbudgets )
+ ENABLED: if ( tpbudgets(ji)%lenabled ) then
+ isources = size( tpbudgets(ji)%tsources )
+ do jj = 1, isources
+ ! Check if ngroup is an allowed value
+ if ( tpbudgets(ji)%tsources(jj)%ngroup < 0 ) then
+ call Print_msg( NVERB_ERROR, 'BUD', 'Ini_budget', 'negative group value is not allowed' )
+ tpbudgets(ji)%tsources(jj)%ngroup = 0
+ end if
+
+ if ( tpbudgets(ji)%tsources(jj)%ngroup > 0 ) tpbudgets(ji)%tsources(jj)%lenabled = .true.
+ end do
+
+ !Count the number of groups of source terms
+ !ngroup=1 is for individual entries, >1 values are groups
+ allocate( igroups(isources ) )
+ allocate( ipos (isources ) )
+ igroups(:) = tpbudgets(ji)%tsources(:)%ngroup
+ ipos(:) = [ ( jj, jj = 1, isources ) ]
+
+ !Sort the group list number
+ call Quicksort( igroups, 1, isources, ipos )
+
+ !Count the number of different groups
+ !and renumber the entries (from 1 to inbgroups)
+ inbgroups = 0
+ ival = igroups(1)
+ if ( igroups(1) /= 0 ) then
+ inbgroups = 1
+ igroups(1) = inbgroups
+ end if
+ do jj = 2, isources
+ if ( igroups(jj) == 1 ) then
+ inbgroups = inbgroups + 1
+ igroups(jj) = inbgroups
+ else if ( igroups(jj) > 0 ) then
+ if ( igroups(jj) /= ival ) then
+ ival = igroups(jj)
+ inbgroups = inbgroups + 1
+ end if
+ igroups(jj) = inbgroups
+ end if
+ end do
+
+ !Write the igroups values to the budget structure
+ do jj = 1, isources
+ tpbudgets(ji)%tsources(ipos(jj))%ngroup = igroups(jj)
+ end do
+
+ !Allocate the group structure + populate it
+ tpbudgets(ji)%ngroups = inbgroups
+ allocate( tpbudgets(ji)%tgroups(inbgroups) )
+
+ do jj = 1, inbgroups
+ !Search the list of sources for each group
+ !not the most efficient algorithm but do the job
+ icount = 0
+ do jk = 1, isources
+ if ( tpbudgets(ji)%tsources(jk)%ngroup == jj ) then
+ icount = icount + 1
+ ipos(icount) = jk !ipos is reused as a temporary work array
+ end if
+ end do
+ tpbudgets(ji)%tgroups(jj)%nsources = icount
+
+ allocate( tpbudgets(ji)%tgroups(jj)%nsourcelist(icount) )
+ tpbudgets(ji)%tgroups(jj)%nsourcelist(:) = ipos(1 : icount)
+
+ ! Set the name of the field
+ ymnhname = tpbudgets(ji)%tsources(ipos(1))%cmnhname
+ do jk = 2, tpbudgets(ji)%tgroups(jj)%nsources
+ ymnhname = trim( ymnhname ) // '_' // trim( tpbudgets(ji)%tsources(ipos(jk))%cmnhname )
+ end do
+ tpbudgets(ji)%tgroups(jj)%cmnhname = ymnhname
+
+ ! Set the standard name (CF convention)
+ if ( tpbudgets(ji)%tgroups(jj)%nsources == 1 ) then
+ ystdname = tpbudgets(ji)%tsources(ipos(1))%cstdname
+ else
+ ! The CF standard name is probably wrong if combining several source terms => set to ''
+ ystdname = ''
+ end if
+ tpbudgets(ji)%tgroups(jj)%cstdname = ystdname
+
+ ! Set the long name (CF convention)
+ ylongname = tpbudgets(ji)%tsources(ipos(1))%clongname
+ do jk = 2, tpbudgets(ji)%tgroups(jj)%nsources
+ ylongname = trim( ylongname ) // ' + ' // tpbudgets(ji)%tsources(ipos(jk))%clongname
+ end do
+ tpbudgets(ji)%tgroups(jj)%clongname = ylongname
+
+ ! Set the units
+ yunits = tpbudgets(ji)%tsources(ipos(1))%cunits
+ do jk = 2, tpbudgets(ji)%tgroups(jj)%nsources
+ if ( trim( yunits ) /= trim( tpbudgets(ji)%tsources(ipos(jk))%cunits ) ) then
+ call Print_msg( NVERB_WARNING, 'BUD', 'Ini_budget', &
+ 'incompatible units for the different source terms of the group ' &
+ //trim( tpbudgets(ji)%tgroups(jj)%cmnhname ) )
+ yunits = 'unknown'
+ end if
+ end do
+ tpbudgets(ji)%tgroups(jj)%cunits = yunits
+
+ ! Set the comment
+ ! It is composed of the source comment followed by the clongnames of the different sources
+ ycomment = trim( tpbudgets(ji)%tsources(ipos(1))%ccomment ) // ': '// trim( tpbudgets(ji)%tsources(ipos(1))%clongname )
+ do jk = 2, tpbudgets(ji)%tgroups(jj)%nsources
+ ycomment = trim( ycomment ) // ', ' // trim( tpbudgets(ji)%tsources(ipos(jk))%clongname )
+ end do
+ ycomment = trim( ycomment ) // ' source term'
+ if ( tpbudgets(ji)%tgroups(jj)%nsources > 1 ) ycomment = trim( ycomment ) // 's'
+ tpbudgets(ji)%tgroups(jj)%ccomment = ycomment
+
+ ! Set the Arakawa grid
+ igrid = tpbudgets(ji)%tsources(ipos(1))%ngrid
+ do jk = 2, tpbudgets(ji)%tgroups(jj)%nsources
+ if ( igrid /= tpbudgets(ji)%tsources(ipos(jk))%ngrid ) then
+ call Print_msg( NVERB_WARNING, 'BUD', 'Ini_budget', &
+ 'different Arakawa grid positions for the different source terms of the group ' &
+ //trim( tpbudgets(ji)%tgroups(jj)%cmnhname ) )
+ end if
+ end do
+ tpbudgets(ji)%tgroups(jj)%ngrid = igrid
+
+ ! Set the data type
+ itype = tpbudgets(ji)%tsources(ipos(1))%ntype
+ do jk = 2, tpbudgets(ji)%tgroups(jj)%nsources
+ if ( itype /= tpbudgets(ji)%tsources(ipos(jk))%ntype ) then
+ call Print_msg( NVERB_FATAL, 'BUD', 'Ini_budget', &
+ 'incompatible data types for the different source terms of the group ' &
+ //trim( tpbudgets(ji)%tgroups(jj)%cmnhname ) )
+ end if
+ end do
+ tpbudgets(ji)%tgroups(jj)%ntype = itype
+
+ ! Set the number of dimensions
+ idims = tpbudgets(ji)%tsources(ipos(1))%ndims
+ do jk = 2, tpbudgets(ji)%tgroups(jj)%nsources
+ if ( idims /= tpbudgets(ji)%tsources(ipos(jk))%ndims ) then
+ call Print_msg( NVERB_FATAL, 'BUD', 'Ini_budget', &
+ 'incompatible number of dimensions for the different source terms of the group ' &
+ //trim( tpbudgets(ji)%tgroups(jj)%cmnhname ) )
+ end if
+ end do
+ tpbudgets(ji)%tgroups(jj)%ndims = idims
+
+ ! Set the fill values
+ if ( tpbudgets(ji)%tgroups(jj)%ntype == TYPEINT ) then
+ ival = tpbudgets(ji)%tsources(ipos(1))%nfillvalue
+ do jk = 2, tpbudgets(ji)%tgroups(jj)%nsources
+ if ( ival /= tpbudgets(ji)%tsources(ipos(jk))%nfillvalue ) then
+ call Print_msg( NVERB_WARNING, 'BUD', 'Ini_budget', &
+ 'different (integer) fill values for the different source terms of the group ' &
+ //trim( tpbudgets(ji)%tgroups(jj)%cmnhname ) )
+ end if
+ end do
+ tpbudgets(ji)%tgroups(jj)%nfillvalue = ival
+ end if
+
+ if ( tpbudgets(ji)%tgroups(jj)%ntype == TYPEREAL ) then
+ zval = tpbudgets(ji)%tsources(ipos(1))%xfillvalue
+ do jk = 2, tpbudgets(ji)%tgroups(jj)%nsources
+ if ( zval /= tpbudgets(ji)%tsources(ipos(jk))%xfillvalue ) then
+ call Print_msg( NVERB_WARNING, 'BUD', 'Ini_budget', &
+ 'different (real) fill values for the different source terms of the group ' &
+ //trim( tpbudgets(ji)%tgroups(jj)%cmnhname ) )
+ end if
+ end do
+ tpbudgets(ji)%tgroups(jj)%xfillvalue = zval
+ end if
+
+ ! Set the valid min/max values
+ ! Take the min or max of all the sources
+ ! Maybe, it would be better to take the sum? (if same sign, if not already the maximum allowed value for this type)
+ if ( tpbudgets(ji)%tgroups(jj)%ntype == TYPEINT ) then
+ ivalmin = tpbudgets(ji)%tsources(ipos(1))%nvalidmin
+ ivalmax = tpbudgets(ji)%tsources(ipos(1))%nvalidmax
+ do jk = 2, tpbudgets(ji)%tgroups(jj)%nsources
+ ivalmin = min( ivalmin, tpbudgets(ji)%tsources(ipos(jk))%nvalidmin )
+ ivalmax = max( ivalmax, tpbudgets(ji)%tsources(ipos(jk))%nvalidmax )
+ end do
+ tpbudgets(ji)%tgroups(jj)%nvalidmin = ivalmin
+ tpbudgets(ji)%tgroups(jj)%nvalidmax = ivalmax
+ end if
+
+ if ( tpbudgets(ji)%tgroups(jj)%ntype == TYPEREAL ) then
+ zvalmin = tpbudgets(ji)%tsources(ipos(1))%xvalidmin
+ zvalmax = tpbudgets(ji)%tsources(ipos(1))%xvalidmax
+ do jk = 2, tpbudgets(ji)%tgroups(jj)%nsources
+ zvalmin = min( zvalmin, tpbudgets(ji)%tsources(ipos(jk))%xvalidmin )
+ zvalmax = max( zvalmax, tpbudgets(ji)%tsources(ipos(jk))%xvalidmax )
+ end do
+ tpbudgets(ji)%tgroups(jj)%xvalidmin = zvalmin
+ tpbudgets(ji)%tgroups(jj)%xvalidmax = zvalmax
+ end if
+
+ allocate( tpbudgets(ji)%tgroups(jj)%xdata(kbudim1, kbudim2, kbudim3 ) )
+ tpbudgets(ji)%tgroups(jj)%xdata(:, :, :) = 0.
+ end do
+
+ deallocate( igroups )
+ deallocate( ipos )
+
+ !Check that a group does not contain more than 1 source term with ldonotinit=.true.
+ do jj = 1, inbgroups
+ if ( tpbudgets(ji)%tgroups(jj)%nsources > 1 ) then
+ do jk = 1, tpbudgets(ji)%tgroups(jj)%nsources
+ if ( tpbudgets(ji)%tsources(tpbudgets(ji)%tgroups(jj)%nsourcelist(jk) )%ldonotinit ) &
+ call Print_msg( NVERB_FATAL, 'BUD', 'Ini_budget', &
+ 'a group with more than 1 source term may not contain sources with ldonotinit=true' )
+ if ( tpbudgets(ji)%tsources(tpbudgets(ji)%tgroups(jj)%nsourcelist(jk) )%loverwrite ) &
+ call Print_msg( NVERB_FATAL, 'BUD', 'Ini_budget', &
+ 'a group with more than 1 source term may not contain sources with loverwrite=true' )
+ end do
+ end if
+ end do
+
+ end if ENABLED
+ end do BUDGETS
+
+end subroutine Ini_budget_groups
+
+
+subroutine Sourcelist_sort_compact( tpbudget )
+ !Sort the list of sources to put the non-available source terms at the end of the list
+ !and compact the list
+ use modd_budget, only: tbudgetdata, tbusourcedata
+
+ type(tbudgetdata), intent(inout) :: tpbudget
+
+ integer :: ji
+ integer :: isrc_avail, isrc_notavail
+ type(tbusourcedata), dimension(:), allocatable :: tzsources_avail
+ type(tbusourcedata), dimension(:), allocatable :: tzsources_notavail
+
+ isrc_avail = 0
+ isrc_notavail = 0
+
+ Allocate( tzsources_avail (tpbudget%nsources) )
+ Allocate( tzsources_notavail(tpbudget%nsources) )
+
+ !Separate source terms available or not during the execution
+ !(based on the criteria provided to Budget_source_add and stored in lavailable field)
+ do ji = 1, tpbudget%nsources
+ if ( tpbudget%tsources(ji)%lavailable ) then
+ isrc_avail = isrc_avail + 1
+ tzsources_avail(isrc_avail) = tpbudget%tsources(ji)
+ else
+ isrc_notavail = isrc_notavail + 1
+ tzsources_notavail(isrc_notavail) = tpbudget%tsources(ji)
+ end if
+ end do
+
+ !Reallocate/compact the source list
+ if ( Allocated( tpbudget%tsources ) ) Deallocate( tpbudget%tsources )
+ Allocate( tpbudget%tsources( tpbudget%nsources ) )
+
+ tpbudget%nsourcesmax = tpbudget%nsources
+ !Limit the number of sources to the available list
+ tpbudget%nsources = isrc_avail
+
+ !Fill the source list beginning with the available sources and finishing with the non-available ones
+ do ji = 1, isrc_avail
+ tpbudget%tsources(ji) = tzsources_avail(ji)
+ end do
+
+ do ji = 1, isrc_notavail
+ tpbudget%tsources(isrc_avail + ji) = tzsources_notavail(ji)
+ end do
+
+end subroutine Sourcelist_sort_compact
+
+
+subroutine Sourcelist_scan( tpbudget, hbulist )
+ use modd_budget, only: tbudgetdata
+
+ type(tbudgetdata), intent(inout) :: tpbudget
+ character(len=*), dimension(:), intent(in) :: hbulist
+
+ character(len=:), allocatable :: yline
+ character(len=:), allocatable :: ysrc
+ character(len=:), dimension(:), allocatable :: ymsg
+ integer :: idx
+ integer :: igroup
+ integer :: igroup_idx
+ integer :: ipos
+ integer :: istart
+ integer :: ji
+
+ istart = 1
+
+ ! Case 'LIST_AVAIL': list all the available source terms
+ if ( Size( hbulist ) > 0 ) then
+ if ( Trim( hbulist(1) ) == 'LIST_AVAIL' ) then
+ Allocate( character(len=65) :: ymsg(tpbudget%nsources + 1) )
+ ymsg(1) = '---------------------------------------------------------------------'
+ ymsg(2) = 'Available source terms for budget ' // Trim( tpbudget%cname )
+ Write( ymsg(3), '( A32, " ", A32 )' ) 'Name', 'Long name'
+ idx = 3
+ do ji = 1, tpbudget%nsources
+ if ( All( tpbudget%tsources(ji)%cmnhname /= [ 'INIF' , 'ENDF', 'AVEF' ] ) ) then
+ idx = idx + 1
+ Write( ymsg(idx), '( A32, " ", A32 )' ) tpbudget%tsources(ji)%cmnhname, tpbudget%tsources(ji)%clongname
+ end if
+ end do
+ ymsg(tpbudget%nsources + 1 ) = '---------------------------------------------------------------------'
+ call Print_msg_multi( NVERB_WARNING, 'BUD', 'Sourcelist_scan', ymsg )
+ !To not read the 1st line again
+ istart = 2
+ end if
+ end if
+
+ ! Case 'LIST_ALL': list all the source terms
+ if ( Size( hbulist ) > 0 ) then
+ if ( Trim( hbulist(1) ) == 'LIST_ALL' ) then
+ Allocate( character(len=65) :: ymsg(tpbudget%nsourcesmax + 1) )
+ ymsg(1) = '---------------------------------------------------------------------'
+ ymsg(2) = 'Source terms for budget ' // Trim( tpbudget%cname )
+ Write( ymsg(3), '( A32, " ", A32 )' ) 'Name', 'Long name'
+ idx = 3
+ do ji = 1, tpbudget%nsourcesmax
+ if ( All( tpbudget%tsources(ji)%cmnhname /= [ 'INIF' , 'ENDF', 'AVEF' ] ) ) then
+ idx = idx + 1
+ Write( ymsg(idx), '( A32, " ", A32 )' ) tpbudget%tsources(ji)%cmnhname, tpbudget%tsources(ji)%clongname
+ end if
+ end do
+ ymsg(tpbudget%nsourcesmax + 1 ) = '---------------------------------------------------------------------'
+ call Print_msg_multi( NVERB_WARNING, 'BUD', 'Sourcelist_scan', ymsg )
+ !To not read the 1st line again
+ istart = 2
+ end if
+ end if
+
+ ! Case 'ALL': enable all available source terms
+ if ( Size( hbulist ) > 0 ) then
+ if ( Trim( hbulist(1) ) == 'ALL' ) then
+ do ji = 1, tpbudget%nsources
+ tpbudget%tsources(ji)%ngroup = 1
+ end do
+ return
+ end if
+ end if
+
+ !Always enable INIF, ENDF and AVEF terms
+ ipos = Source_find( tpbudget, 'INIF' )
+ if ( ipos < 1 ) call Print_msg( NVERB_FATAL, 'BUD', 'Sourcelist_scan', 'source term ' // Trim( tpbudget%cname ) &
+ // ': INIF not found' )
+ tpbudget%tsources(ipos)%ngroup = 1
+
+ ipos = Source_find( tpbudget, 'ENDF' )
+ if ( ipos < 1 ) call Print_msg( NVERB_FATAL, 'BUD', 'Sourcelist_scan', 'source term ' // Trim( tpbudget%cname ) &
+ // ': ENDF not found' )
+ tpbudget%tsources(ipos)%ngroup = 1
+
+ ipos = Source_find( tpbudget, 'AVEF' )
+ if ( ipos < 1 ) call Print_msg( NVERB_FATAL, 'BUD', 'Sourcelist_scan', 'source term ' // Trim( tpbudget%cname ) &
+ // ': AVEF not found' )
+ tpbudget%tsources(ipos)%ngroup = 1
+
+ !igroup_idx start at 2 because 1 is reserved for individually stored source terms
+ igroup_idx = 2
+
+ do ji = istart, Size( hbulist )
+ if ( Len_trim( hbulist(ji) ) > 0 ) then
+ ! Scan the line and separate the different sources (separated by + signs)
+ yline = Trim(hbulist(ji))
+
+ idx = Index( yline, '+' )
+ if ( idx < 1 ) then
+ igroup = 1
+ else
+ igroup = igroup_idx
+ igroup_idx = igroup_idx + 1
+ end if
+
+ do
+ idx = Index( yline, '+' )
+ if ( idx < 1 ) then
+ ysrc = yline
+ else
+ ysrc = yline(1 : idx - 1)
+ yline = yline(idx + 1 :)
+ end if
+
+ !Check if the source is known
+ if ( Len_trim( ysrc ) > 0 ) then
+ ipos = Source_find( tpbudget, ysrc )
+
+ if ( ipos > 0 ) then
+ call Print_msg( NVERB_DEBUG, 'BUD', 'Sourcelist_scan', 'source term ' // Trim( tpbudget%cname ) &
+ // ': ' // ysrc // ' found' )
+
+ if ( .not. tpbudget%tsources(ipos)%lavailable ) then
+ call Print_msg( NVERB_WARNING, 'BUD', 'Sourcelist_scan', 'source term ' // Trim( tpbudget%cname ) &
+ // ': ' // ysrc // ' not available' )
+ tpbudget%tsources(ipos)%ngroup = 0
+ else
+ tpbudget%tsources(ipos)%ngroup = igroup
+ end if
+ else
+ call Print_msg( NVERB_ERROR, 'BUD', 'Sourcelist_scan', 'source term ' // Trim( tpbudget%cname ) &
+ // ': ' // ysrc // ' not found' )
+ end if
+ end if
+
+ if ( idx < 1 ) exit
+ end do
+ end if
+ end do
+end subroutine Sourcelist_scan
+
+
+subroutine Sourcelist_nml_compact( tpbudget, hbulist )
+ !This subroutine reduce the size of the hbulist to the minimum
+ !The list is generated from the group list
+ use modd_budget, only: NBULISTMAXLEN, tbudgetdata
+
+ type(tbudgetdata), intent(in) :: tpbudget
+ character(len=NBULISTMAXLEN), dimension(:), allocatable, intent(inout) :: hbulist
+
+ integer :: idx
+ integer :: isource
+ integer :: jg
+ integer :: js
+
+ if ( Allocated( hbulist ) ) Deallocate( hbulist )
+
+ if ( tpbudget%ngroups < 3 ) then
+ call Print_msg( NVERB_ERROR, 'BUD', 'Sourcelist_nml_compact', 'ngroups is too small' )
+ return
+ end if
+
+ Allocate( character(len=NBULISTMAXLEN) :: hbulist(tpbudget%ngroups - 3) )
+ hbulist(:) = ''
+
+ idx = 0
+ do jg = 1, tpbudget%ngroups
+ if ( tpbudget%tgroups(jg)%nsources < 1 ) then
+ call Print_msg( NVERB_ERROR, 'BUD', 'Sourcelist_nml_compact', 'no source for group' )
+ cycle
+ end if
+
+ !Do not put 'INIF', 'ENDF', 'AVEF' in hbulist because their presence is automatic if the corresponding budget is enabled
+ isource = tpbudget%tgroups(jg)%nsourcelist(1)
+ if ( Any( tpbudget%tsources(isource)%cmnhname == [ 'INIF', 'ENDF', 'AVEF' ] ) ) cycle
+
+ idx = idx + 1
+#if 0
+ !Do not do this way because the group cmnhname may be truncated (NMNHNAMELGTMAX is smaller than NBULISTMAXLEN)
+ !and the name separator is different ('_')
+ hbulist(idx) = Trim( tpbudget%tgroups(jg)%cmnhname )
+#else
+ do js = 1, tpbudget%tgroups(jg)%nsources
+ isource = tpbudget%tgroups(jg)%nsourcelist(js)
+ hbulist(idx) = Trim( hbulist(idx) ) // Trim( tpbudget%tsources(isource)%cmnhname )
+ if ( js < tpbudget%tgroups(jg)%nsources ) hbulist(idx) = Trim( hbulist(idx) ) // '+'
+ end do
+#endif
+ end do
+end subroutine Sourcelist_nml_compact
+
+
+subroutine Sourcelist_sv_nml_compact( hbulist )
+ !This subroutine reduce the size of the hbulist
+ !For SV variables the reduction is simpler than for other variables
+ !because it is too complex to do this cleanly (the enabled source terms are different for each scalar variable)
+ use modd_budget, only: NBULISTMAXLEN, tbudgetdata
+
+ character(len=*), dimension(:), allocatable, intent(inout) :: hbulist
+
+ character(len=NBULISTMAXLEN), dimension(:), allocatable :: ybulist_new
+ integer :: ilines
+ integer :: ji
+
+ ilines = 0
+ do ji = 1, Size( hbulist )
+ if ( Len_trim(hbulist(ji)) > 0 ) ilines = ilines + 1
+ end do
+
+ Allocate( ybulist_new(ilines) )
+
+ ilines = 0
+ do ji = 1, Size( hbulist )
+ if ( Len_trim(hbulist(ji)) > 0 ) then
+ ilines = ilines + 1
+ ybulist_new(ilines) = Trim( hbulist(ji) )
+ end if
+ end do
+
+ call Move_alloc( from = ybulist_new, to = hbulist )
+end subroutine Sourcelist_sv_nml_compact
+
+
+pure function Source_find( tpbudget, hsource ) result( ipos )
+ use modd_budget, only: tbudgetdata
+
+ type(tbudgetdata), intent(in) :: tpbudget
+ character(len=*), intent(in) :: hsource
+ integer :: ipos
+
+ integer :: ji
+ logical :: gfound
+
+ ipos = -1
+ gfound = .false.
+ do ji = 1, tpbudget%nsourcesmax
+ if ( Trim( hsource ) == Trim ( tpbudget%tsources(ji)%cmnhname ) ) then
+ gfound = .true.
+ ipos = ji
+ exit
+ end if
+ end do
+
+end function Source_find
+
+end module mode_ini_budget
diff --git a/src/PHYEX/ext/ini_nsv.f90 b/src/PHYEX/ext/ini_nsv.f90
new file mode 100644
index 0000000000000000000000000000000000000000..99bb84876be3034c73bf435c1e39cba0430fd9df
--- /dev/null
+++ b/src/PHYEX/ext/ini_nsv.f90
@@ -0,0 +1,1315 @@
+!MNH_LIC Copyright 2001-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 MODI_INI_NSV
+! ###################
+INTERFACE
+!
+ SUBROUTINE INI_NSV(KMI)
+ INTEGER, INTENT(IN) :: KMI ! model index
+ END SUBROUTINE INI_NSV
+!
+END INTERFACE
+!
+END MODULE MODI_INI_NSV
+!
+!
+! ###########################
+ SUBROUTINE INI_NSV(KMI)
+! ###########################
+!
+!!**** *INI_NSV* - compute NSV_* values and indices for model KMI
+!!
+!! PURPOSE
+!! -------
+!
+!
+!
+!!** METHOD
+!! ------
+!!
+!! This routine is called from any routine which stores values in
+!! the first model module (for example READ_EXSEG).
+!!
+!! EXTERNAL
+!! --------
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_NSV : contains NSV_A array variable
+!!
+!! REFERENCE
+!! ---------
+!!
+!!
+!! AUTHOR
+!! ------
+!! D. Gazen * LA *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 01/02/01
+!! Modification 29/11/02 (Pinty) add SV for C3R5 and ELEC
+!! Modification 01/2004 (Masson) add scalar names
+!! Modification 03/2006 (O.Geoffroy) add KHKO scheme
+!! Modification 04/2007 (Leriche) add SV for aqueous chemistry
+!! M. Chong 26/01/10 Add Small ions
+!! Modification 07/2010 (Leriche) add SV for ice chemistry
+!! X.Pialat & J.Escobar 11/2012 remove deprecated line NSV_A(KMI) = ISV
+!! Modification 15/02/12 (Pialat/Tulet) Add SV for ForeFire scalars
+!! 03/2013 (C.Lac) add supersaturation as
+!! the 4th C2R2 scalar variable
+!! J.escobar 04/08/2015 suit Pb with writ_lfin JSA increment , modif in ini_nsv to have good order initialization
+!! Modification 01/2016 (JP Pinty) Add LIMA and LUSECHEM condition
+!! Modification 07/2017 (V. Vionnet) Add blowing snow condition
+! 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
+! P. Wautelet 30/03/2021: move NINDICE_CCN_IMM and NIMM initializations from init_aerosol_properties to ini_nsv
+! B. Vie 06/2021: add prognostic supersaturation for LIMA
+! P. Wautelet 26/11/2021: initialize TSVLIST_A
+! 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
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_BLOWSNOW, ONLY: CSNOWNAMES, LBLOWSNOW, NBLOWSNOW3D, YPSNOW_INI
+USE MODD_CH_AEROSOL
+! USE MODD_CH_AEROSOL, ONLY: CAERONAMES, CDEAERNAMES, JPMODE, LAERINIT, LDEPOS_AER, LORILAM, &
+! LVARSIGI, LVARSIGJ, NCARB, NM6_AER, NSOA, NSP
+USE MODD_CH_M9_n, ONLY: CICNAMES, CNAMES, NEQ, NEQAQ
+USE MODD_CH_MNHC_n, ONLY: LCH_PH, LUSECHEM, LUSECHAQ, LUSECHIC, CCH_SCHEME, LCH_CONV_LINOX
+USE MODD_CONDSAMP, ONLY: LCONDSAMP, NCONDSAMP
+USE MODD_CONF, ONLY: LLG, CPROGRAM, NVERB
+USE MODD_CST, ONLY: XMNH_TINY
+USE MODD_DIAG_FLAG, ONLY: LCHEMDIAG, LCHAQDIAG
+USE MODD_DUST, ONLY: CDEDSTNAMES, CDUSTNAMES, JPDUSTORDER, LDEPOS_DST, LDSTINIT, LDSTPRES, LDUST, &
+ LRGFIX_DST, LVARSIG, NMODE_DST, YPDEDST_INI, YPDUST_INI
+USE MODD_DYN_n, ONLY: LHORELAX_SV,LHORELAX_SVC2R2,LHORELAX_SVC1R3, &
+ LHORELAX_SVFIRE, LHORELAX_SVLIMA, &
+ LHORELAX_SVELEC,LHORELAX_SVCHEM,LHORELAX_SVLG, &
+ LHORELAX_SVDST,LHORELAX_SVAER, LHORELAX_SVSLT, &
+ LHORELAX_SVPP,LHORELAX_SVCS, LHORELAX_SVCHIC, &
+ LHORELAX_SVSNW
+#ifdef MNH_FOREFIRE
+USE MODD_DYN_n, ONLY: LHORELAX_SVFF
+#endif
+USE MODD_ELEC_DESCR, ONLY: LLNOX_EXPLICIT
+USE MODD_ELEC_DESCR, ONLY: CELECNAMES
+USE MODD_FIELD, ONLY: TFIELDMETADATA, TYPEREAL
+USE MODD_FIRE_n
+#ifdef MNH_FOREFIRE
+USE MODD_FOREFIRE
+#endif
+USE MODD_ICE_C1R3_DESCR, ONLY: C1R3NAMES
+USE MODD_LG, ONLY: CLGNAMES, XLG1MIN, XLG2MIN, XLG3MIN
+USE MODD_LUNIT_n, ONLY: TLUOUT
+USE MODD_NSV
+USE MODD_PARAM_C2R2, ONLY: LSUPSAT
+USE MODD_PARAMETERS, ONLY: NCOMMENTLGTMAX, NLONGNAMELGTMAX, NUNITLGTMAX
+USE MODD_PARAM_LIMA, ONLY: NINDICE_CCN_IMM, NIMM, NMOD_CCN, LSCAV, LAERO_MASS, &
+ NMOD_IFN, NMOD_IMM, LHHONI, &
+ LSPRO, &
+ NMOM_C, NMOM_R, NMOM_I, NMOM_S, NMOM_G, NMOM_H
+USE MODD_PARAM_LIMA_COLD, ONLY: CLIMA_COLD_NAMES
+USE MODD_PARAM_LIMA_WARM, ONLY: CAERO_MASS, CLIMA_WARM_NAMES
+USE MODD_PARAM_n, ONLY: CCLOUD, CELEC
+USE MODD_PASPOL, ONLY: LPASPOL, NRELEASE
+USE MODD_PREP_REAL, ONLY: XT_LS
+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 MODI_CH_AER_INIT_SOA, ONLY: CH_AER_INIT_SOA
+USE MODI_CH_INIT_SCHEME_n, ONLY: CH_INIT_SCHEME_n
+USE MODI_UPDATE_NSV, ONLY: UPDATE_NSV
+!
+IMPLICIT NONE
+!
+!-------------------------------------------------------------------------------
+!
+!* 0.1 Declarations of arguments
+!
+INTEGER, INTENT(IN) :: KMI ! model index
+!
+!* 0.2 Declarations of local variables
+!
+CHARACTER(LEN=2) :: YNUM2
+CHARACTER(LEN=3) :: YNUM3
+CHARACTER(LEN=NCOMMENTLGTMAX) :: YCOMMENT
+CHARACTER(LEN=NUNITLGTMAX) :: YUNITS
+CHARACTER(LEN=NLONGNAMELGTMAX), DIMENSION(:), ALLOCATABLE :: YAEROLONGNAMES
+CHARACTER(LEN=NLONGNAMELGTMAX), DIMENSION(:), ALLOCATABLE :: YDUSTLONGNAMES
+CHARACTER(LEN=NLONGNAMELGTMAX), DIMENSION(:), ALLOCATABLE :: YSALTLONGNAMES
+INTEGER :: ILUOUT
+INTEGER :: ICHIDX ! Index for position in CSV_CHEM_LIST_A array
+INTEGER :: ISV ! total number of scalar variables
+INTEGER :: IMODEIDX
+INTEGER :: JAER
+INTEGER :: JI, JJ, JSV
+INTEGER :: JMODE, JMOM, JSV_NAME
+INTEGER :: INMOMENTS_DST, INMOMENTS_SLT !Number of moments for dust or salt
+!
+!-------------------------------------------------------------------------------
+!
+LINI_NSV(KMI) = .TRUE.
+
+ILUOUT = TLUOUT%NLU
+
+ICHIDX = 0
+NSV_CHEM_LIST_A(KMI) = 0
+!
+! Users scalar variables are first considered
+!
+NSV_USER_A(KMI) = NSV_USER
+ISV = NSV_USER
+!
+! scalar variables used in microphysical schemes C2R2,KHKO and C3R5
+!
+IF (CCLOUD == 'C2R2' .OR. CCLOUD == 'C3R5' .OR. CCLOUD == 'KHKO' ) THEN
+ IF ((CCLOUD == 'C2R2' .AND. LSUPSAT) .OR. (CCLOUD == 'KHKO'.AND. LSUPSAT)) THEN
+ ! 4th scalar field = supersaturation
+ NSV_C2R2_A(KMI) = 4
+ ELSE
+ NSV_C2R2_A(KMI) = 3
+ END IF
+ NSV_C2R2BEG_A(KMI) = ISV+1
+ NSV_C2R2END_A(KMI) = ISV+NSV_C2R2_A(KMI)
+ ISV = NSV_C2R2END_A(KMI)
+ IF (CCLOUD == 'C3R5') THEN ! the SVs for C2R2 and C1R3 must be contiguous
+ NSV_C1R3_A(KMI) = 2
+ NSV_C1R3BEG_A(KMI) = ISV+1
+ NSV_C1R3END_A(KMI) = ISV+NSV_C1R3_A(KMI)
+ ISV = NSV_C1R3END_A(KMI)
+ ELSE
+ NSV_C1R3_A(KMI) = 0
+ ! force First index to be superior to last index
+ ! in order to create a null section
+ NSV_C1R3BEG_A(KMI) = 1
+ NSV_C1R3END_A(KMI) = 0
+ END IF
+ELSE
+ NSV_C2R2_A(KMI) = 0
+ NSV_C1R3_A(KMI) = 0
+! force First index to be superior to last index
+! in order to create a null section
+ NSV_C2R2BEG_A(KMI) = 1
+ NSV_C2R2END_A(KMI) = 0
+ NSV_C1R3BEG_A(KMI) = 1
+ NSV_C1R3END_A(KMI) = 0
+END IF
+!
+! scalar variables used in the LIMA microphysical scheme
+!
+IF (CCLOUD == 'LIMA' ) THEN
+ ISV = ISV+1
+ NSV_LIMA_BEG_A(KMI) = ISV
+ IF (NMOM_C.GE.2) THEN
+! Nc
+ NSV_LIMA_NC_A(KMI) = ISV
+ ISV = ISV+1
+ END IF
+! Nr
+ IF (NMOM_R.GE.2) THEN
+ NSV_LIMA_NR_A(KMI) = ISV
+ ISV = ISV+1
+ END IF
+! CCN
+ IF (NMOD_CCN .GT. 0) THEN
+ NSV_LIMA_CCN_FREE_A(KMI) = ISV
+ ISV = ISV + NMOD_CCN
+ NSV_LIMA_CCN_ACTI_A(KMI) = ISV
+ ISV = ISV + NMOD_CCN
+ END IF
+! Scavenging
+ IF (LSCAV .AND. LAERO_MASS) THEN
+ NSV_LIMA_SCAVMASS_A(KMI) = ISV
+ ISV = ISV+1
+ END IF
+! Ni
+ IF (NMOM_I.GE.2) THEN
+ NSV_LIMA_NI_A(KMI) = ISV
+ ISV = ISV+1
+ END IF
+! Ns
+ IF (NMOM_S.GE.2) THEN
+ NSV_LIMA_NS_A(KMI) = ISV
+ ISV = ISV+1
+ END IF
+! Ng
+ IF (NMOM_G.GE.2) THEN
+ NSV_LIMA_NG_A(KMI) = ISV
+ ISV = ISV+1
+ END IF
+! Nh
+ IF (NMOM_H.GE.2) THEN
+ NSV_LIMA_NH_A(KMI) = ISV
+ ISV = ISV+1
+ END IF
+! IFN
+ IF (NMOD_IFN .GT. 0) THEN
+ NSV_LIMA_IFN_FREE_A(KMI) = ISV
+ ISV = ISV + NMOD_IFN
+ NSV_LIMA_IFN_NUCL_A(KMI) = ISV
+ ISV = ISV + NMOD_IFN
+ END IF
+! IMM
+ IF (NMOD_IMM .GT. 0) THEN
+ NSV_LIMA_IMM_NUCL_A(KMI) = ISV
+ ISV = ISV + MAX(1,NMOD_IMM)
+ END IF
+
+ IF ( NMOD_IFN > 0 ) THEN
+ IF ( .NOT. ALLOCATED( NIMM ) ) ALLOCATE( NIMM(NMOD_CCN) )
+ NIMM(:) = 0
+ IF ( ALLOCATED( NINDICE_CCN_IMM ) ) DEALLOCATE( NINDICE_CCN_IMM )
+ ALLOCATE( NINDICE_CCN_IMM(MAX( 1, NMOD_IMM )) )
+ IF (NMOD_IMM > 0 ) THEN
+ DO JI = 0, NMOD_IMM - 1
+ NIMM(NMOD_CCN - JI) = 1
+ NINDICE_CCN_IMM(NMOD_IMM - JI) = NMOD_CCN - JI
+ END DO
+! ELSE IF (NMOD_IMM == 0) THEN ! PNIS exists but is 0 for the call to resolved_cloud
+! NMOD_IMM = 1
+! NINDICE_CCN_IMM(1) = 0
+ END IF
+ END IF
+
+! Homogeneous freezing of CCN
+ IF (LHHONI) THEN
+ NSV_LIMA_HOM_HAZE_A(KMI) = ISV
+ ISV = ISV + 1
+ END IF
+! Supersaturation
+ IF (LSPRO) THEN
+ NSV_LIMA_SPRO_A(KMI) = ISV
+ ISV = ISV + 1
+ END IF
+!
+! End and total variables
+!
+ ISV = ISV - 1
+ NSV_LIMA_END_A(KMI) = ISV
+ NSV_LIMA_A(KMI) = NSV_LIMA_END_A(KMI) - NSV_LIMA_BEG_A(KMI) + 1
+ELSE
+ NSV_LIMA_A(KMI) = 0
+!
+! force First index to be superior to last index
+! in order to create a null section
+!
+ NSV_LIMA_BEG_A(KMI) = 1
+ NSV_LIMA_END_A(KMI) = 0
+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
+ NSV_LG_A(KMI) = 3
+ NSV_LGBEG_A(KMI) = ISV+1
+ NSV_LGEND_A(KMI) = ISV+NSV_LG_A(KMI)
+ ISV = NSV_LGEND_A(KMI)
+ELSE
+ NSV_LG_A(KMI) = 0
+! force First index to be superior to last index
+! in order to create a null section
+ NSV_LGBEG_A(KMI) = 1
+ NSV_LGEND_A(KMI) = 0
+END IF
+!
+! scalar variables used as LiNOX passive tracer
+!
+! In case without chemistry
+IF (LPASPOL) THEN
+ NSV_PP_A(KMI) = NRELEASE
+ NSV_PPBEG_A(KMI)= ISV+1
+ NSV_PPEND_A(KMI)= ISV+NSV_PP_A(KMI)
+ ISV = NSV_PPEND_A(KMI)
+ELSE
+ NSV_PP_A(KMI) = 0
+! force First index to be superior to last index
+! in order to create a null section
+ NSV_PPBEG_A(KMI)= 1
+ NSV_PPEND_A(KMI)= 0
+END IF
+!
+#ifdef MNH_FOREFIRE
+! ForeFire tracers
+IF (LFOREFIRE .AND. NFFSCALARS .GT. 0) THEN
+ NSV_FF_A(KMI) = NFFSCALARS
+ NSV_FFBEG_A(KMI) = ISV+1
+ NSV_FFEND_A(KMI) = ISV+NSV_FF_A(KMI)
+ ISV = NSV_FFEND_A(KMI)
+ELSE
+ NSV_FF_A(KMI) = 0
+! force First index to be superior to last index
+! in order to create a null section
+ NSV_FFBEG_A(KMI)= 1
+ NSV_FFEND_A(KMI)= 0
+END IF
+#endif
+! Blaze tracers
+IF (LBLAZE .AND. NNBSMOKETRACER .GT. 0) THEN
+ NSV_FIRE_A(KMI) = NNBSMOKETRACER
+ NSV_FIREBEG_A(KMI) = ISV+1
+ NSV_FIREEND_A(KMI) = ISV+NSV_FIRE_A(KMI)
+ ISV = NSV_FIREEND_A(KMI)
+ELSE
+ NSV_FIRE_A(KMI) = 0
+! force First index to be superior to last index
+! in order to create a null section
+ NSV_FIREBEG_A(KMI)= 1
+ NSV_FIREEND_A(KMI)= 0
+END IF
+!
+! Conditional sampling variables
+IF (LCONDSAMP) THEN
+ NSV_CS_A(KMI) = NCONDSAMP
+ NSV_CSBEG_A(KMI)= ISV+1
+ NSV_CSEND_A(KMI)= ISV+NSV_CS_A(KMI)
+ ISV = NSV_CSEND_A(KMI)
+ELSE
+ NSV_CS_A(KMI) = 0
+! force First index to be superior to last index
+! in order to create a null section
+ NSV_CSBEG_A(KMI)= 1
+ NSV_CSEND_A(KMI)= 0
+END IF
+!
+! scalar variables used in chemical core system
+!
+IF (LUSECHEM) THEN
+ CALL CH_INIT_SCHEME_n(KMI,LUSECHAQ,LUSECHIC,LCH_PH,ILUOUT,NVERB)
+ IF (LORILAM) CALL CH_AER_INIT_SOA(ILUOUT, NVERB)
+END IF
+
+IF (LUSECHEM .AND.(NEQ .GT. 0)) THEN
+ NSV_CHEM_A(KMI) = NEQ
+ NSV_CHEMBEG_A(KMI)= ISV+1
+ NSV_CHEMEND_A(KMI)= ISV+NSV_CHEM_A(KMI)
+ ISV = NSV_CHEMEND_A(KMI)
+ NSV_CHEM_LIST_A(KMI) = NSV_CHEM_LIST_A(KMI) + NSV_CHEM_A(KMI)
+ELSE
+ NSV_CHEM_A(KMI) = 0
+! force First index to be superior to last index
+! in order to create a null section
+ NSV_CHEMBEG_A(KMI)= 1
+ NSV_CHEMEND_A(KMI)= 0
+END IF
+!
+! aqueous chemistry (part of the "chem" variables)
+!
+IF ((LUSECHAQ .OR. LCHAQDIAG).AND.(NEQ .GT. 0)) THEN
+ NSV_CHGS_A(KMI) = NEQ-NEQAQ
+ NSV_CHGSBEG_A(KMI)= NSV_CHEMBEG_A(KMI)
+ NSV_CHGSEND_A(KMI)= NSV_CHEMBEG_A(KMI)+(NEQ-NEQAQ)-1
+ NSV_CHAC_A(KMI) = NEQAQ
+ NSV_CHACBEG_A(KMI)= NSV_CHGSEND_A(KMI)+1
+ NSV_CHACEND_A(KMI)= NSV_CHEMEND_A(KMI)
+! ice phase chemistry
+ IF (LUSECHIC) THEN
+ NSV_CHIC_A(KMI) = NEQAQ/2. -1.
+ NSV_CHICBEG_A(KMI)= ISV+1
+ NSV_CHICEND_A(KMI)= ISV+NSV_CHIC_A(KMI)
+ ISV = NSV_CHICEND_A(KMI)
+ NSV_CHEM_LIST_A(KMI) = NSV_CHEM_LIST_A(KMI) + NSV_CHIC_A(KMI)
+ ELSE
+ NSV_CHIC_A(KMI) = 0
+ NSV_CHICBEG_A(KMI)= 1
+ NSV_CHICEND_A(KMI)= 0
+ ENDIF
+ELSE
+ IF (NEQ .GT. 0) THEN
+ NSV_CHGS_A(KMI) = NEQ-NEQAQ
+ NSV_CHGSBEG_A(KMI)= NSV_CHEMBEG_A(KMI)
+ NSV_CHGSEND_A(KMI)= NSV_CHEMBEG_A(KMI)+(NEQ-NEQAQ)-1
+ NSV_CHAC_A(KMI) = 0
+ NSV_CHACBEG_A(KMI)= 1
+ NSV_CHACEND_A(KMI)= 0
+ NSV_CHIC_A(KMI) = 0
+ NSV_CHICBEG_A(KMI)= 1
+ NSV_CHICEND_A(KMI)= 0
+ ELSE
+ NSV_CHGS_A(KMI) = 0
+ NSV_CHGSBEG_A(KMI)= 1
+ NSV_CHGSEND_A(KMI)= 0
+ NSV_CHAC_A(KMI) = 0
+ NSV_CHACBEG_A(KMI)= 1
+ NSV_CHACEND_A(KMI)= 0
+ NSV_CHIC_A(KMI) = 0
+ NSV_CHICBEG_A(KMI)= 1
+ NSV_CHICEND_A(KMI)= 0
+ ENDIF
+END IF
+! aerosol variables
+IF (LORILAM.AND.(NEQ .GT. 0)) THEN
+ NM6_AER = 0
+ IF (LVARSIGI) NM6_AER = 1
+ IF (LVARSIGJ) NM6_AER = NM6_AER + 1
+ NSV_AER_A(KMI) = (NSP+NCARB+NSOA+1)*JPMODE + NM6_AER
+ NSV_AERBEG_A(KMI)= ISV+1
+ NSV_AEREND_A(KMI)= ISV+NSV_AER_A(KMI)
+ ISV = NSV_AEREND_A(KMI)
+ NSV_CHEM_LIST_A(KMI) = NSV_CHEM_LIST_A(KMI) + NSV_AER_A(KMI)
+
+ ALLOCATE( YAEROLONGNAMES(NSV_AER_A(KMI)) )
+ELSE
+ NSV_AER_A(KMI) = 0
+! force First index to be superior to last index
+! in order to create a null section
+ NSV_AERBEG_A(KMI)= 1
+ NSV_AEREND_A(KMI)= 0
+END IF
+IF (LORILAM .AND. LDEPOS_AER(KMI)) THEN
+ NSV_AERDEP_A(KMI) = JPMODE*2
+ NSV_AERDEPBEG_A(KMI)= ISV+1
+ NSV_AERDEPEND_A(KMI)= ISV+NSV_AERDEP_A(KMI)
+ ISV = NSV_AERDEPEND_A(KMI)
+ NSV_CHEM_LIST_A(KMI) = NSV_CHEM_LIST_A(KMI) + NSV_AERDEP_A(KMI)
+ELSE
+ NSV_AERDEP_A(KMI) = 0
+! force First index to be superior to last index
+! in order to create a null section
+ NSV_AERDEPBEG_A(KMI)= 1
+ NSV_AERDEPEND_A(KMI)= 0
+! force First index to be superior to last index
+! in order to create a null section
+END IF
+!
+! scalar variables used in dust model
+!
+IF (LDUST) THEN
+ IF (ALLOCATED(XT_LS).AND. .NOT.(LDSTPRES)) LDSTINIT=.TRUE.
+ IF (CPROGRAM == 'IDEAL ') LVARSIG = .TRUE.
+ IF ((CPROGRAM == 'REAL ').AND.LDSTINIT) LVARSIG = .TRUE.
+ !Determine number of moments
+ IF ( LRGFIX_DST ) THEN
+ INMOMENTS_DST = 1
+ IF ( LVARSIG ) CALL Print_msg( NVERB_WARNING, 'GEN', 'INI_NSV', 'LVARSIG forced to FALSE because LRGFIX_DST is TRUE' )
+ LVARSIG = .FALSE.
+ ELSE IF ( LVARSIG ) THEN
+ INMOMENTS_DST = 3
+ ELSE
+ INMOMENTS_DST = 2
+ END IF
+ !Number of entries = number of moments multiplied by number of modes
+ NSV_DST_A(KMI) = NMODE_DST * INMOMENTS_DST
+ NSV_DSTBEG_A(KMI)= ISV+1
+ NSV_DSTEND_A(KMI)= ISV+NSV_DST_A(KMI)
+ ISV = NSV_DSTEND_A(KMI)
+ NSV_CHEM_LIST_A(KMI) = NSV_CHEM_LIST_A(KMI) + NSV_DST_A(KMI)
+ELSE
+ NSV_DST_A(KMI) = 0
+! force First index to be superior to last index
+! in order to create a null section
+ NSV_DSTBEG_A(KMI)= 1
+ NSV_DSTEND_A(KMI)= 0
+END IF
+IF ( LDUST .AND. LDEPOS_DST(KMI) ) THEN
+ NSV_DSTDEP_A(KMI) = NMODE_DST*2
+ NSV_DSTDEPBEG_A(KMI)= ISV+1
+ NSV_DSTDEPEND_A(KMI)= ISV+NSV_DSTDEP_A(KMI)
+ ISV = NSV_DSTDEPEND_A(KMI)
+ NSV_CHEM_LIST_A(KMI) = NSV_CHEM_LIST_A(KMI) + NSV_DSTDEP_A(KMI)
+ELSE
+ NSV_DSTDEP_A(KMI) = 0
+! force First index to be superior to last index
+! in order to create a null section
+ NSV_DSTDEPBEG_A(KMI)= 1
+ NSV_DSTDEPEND_A(KMI)= 0
+! force First index to be superior to last index
+! in order to create a null section
+
+ END IF
+! scalar variables used in sea salt model
+!
+IF (LSALT) THEN
+ IF (ALLOCATED(XT_LS).AND. .NOT.(LSLTPRES)) LSLTINIT=.TRUE.
+ IF (CPROGRAM == 'IDEAL ') LVARSIG_SLT = .TRUE.
+ IF ((CPROGRAM == 'REAL ').AND. LSLTINIT ) LVARSIG_SLT = .TRUE.
+ !Determine number of moments
+ IF ( LRGFIX_SLT ) THEN
+ INMOMENTS_SLT = 1
+ IF ( LVARSIG_SLT ) CALL Print_msg( NVERB_WARNING, 'GEN', 'INI_NSV', 'LVARSIG_SLT forced to FALSE because LRGFIX_SLT is TRUE' )
+ LVARSIG_SLT = .FALSE.
+ ELSE IF ( LVARSIG_SLT ) THEN
+ INMOMENTS_SLT = 3
+ ELSE
+ INMOMENTS_SLT = 2
+ END IF
+ !Number of entries = number of moments multiplied by number of modes
+ NSV_SLT_A(KMI) = NMODE_SLT * INMOMENTS_SLT
+ NSV_SLTBEG_A(KMI)= ISV+1
+ NSV_SLTEND_A(KMI)= ISV+NSV_SLT_A(KMI)
+ ISV = NSV_SLTEND_A(KMI)
+ NSV_CHEM_LIST_A(KMI) = NSV_CHEM_LIST_A(KMI) + NSV_SLT_A(KMI)
+ELSE
+ NSV_SLT_A(KMI) = 0
+! force First index to be superior to last index
+! in order to create a null section
+ NSV_SLTBEG_A(KMI)= 1
+ NSV_SLTEND_A(KMI)= 0
+END IF
+IF ( LSALT .AND. LDEPOS_SLT(KMI) ) THEN
+ NSV_SLTDEP_A(KMI) = NMODE_SLT*2
+ NSV_SLTDEPBEG_A(KMI)= ISV+1
+ NSV_SLTDEPEND_A(KMI)= ISV+NSV_SLTDEP_A(KMI)
+ ISV = NSV_SLTDEPEND_A(KMI)
+ NSV_CHEM_LIST_A(KMI) = NSV_CHEM_LIST_A(KMI) + NSV_SLTDEP_A(KMI)
+ELSE
+ NSV_SLTDEP_A(KMI) = 0
+! force First index to be superior to last index
+! in order to create a null section
+ NSV_SLTDEPBEG_A(KMI)= 1
+ NSV_SLTDEPEND_A(KMI)= 0
+! force First index to be superior to last index
+! in order to create a null section
+END IF
+!
+! scalar variables used in blowing snow model
+!
+IF (LBLOWSNOW) THEN
+ NSV_SNW_A(KMI) = NBLOWSNOW3D
+ NSV_SNWBEG_A(KMI)= ISV+1
+ NSV_SNWEND_A(KMI)= ISV+NSV_SNW_A(KMI)
+ ISV = NSV_SNWEND_A(KMI)
+ELSE
+ NSV_SNW_A(KMI) = 0
+! force First index to be superior to last index
+! in order to create a null section
+ NSV_SNWBEG_A(KMI)= 1
+ NSV_SNWEND_A(KMI)= 0
+END IF
+!
+! scalar variables used as LiNOX passive tracer
+!
+! In case without chemistry
+IF (.NOT.(LUSECHEM.OR.LCHEMDIAG) .AND. (LCH_CONV_LINOX.OR.LLNOX_EXPLICIT)) THEN
+ NSV_LNOX_A(KMI) = 1
+ NSV_LNOXBEG_A(KMI)= ISV+1
+ NSV_LNOXEND_A(KMI)= ISV+NSV_LNOX_A(KMI)
+ ISV = NSV_LNOXEND_A(KMI)
+ NSV_CHEM_LIST_A(KMI) = NSV_CHEM_LIST_A(KMI) + NSV_LNOX_A(KMI)
+ELSE
+ NSV_LNOX_A(KMI) = 0
+! force First index to be superior to last index
+! in order to create a null section
+ NSV_LNOXBEG_A(KMI)= 1
+ NSV_LNOXEND_A(KMI)= 0
+END IF
+!
+! Final number of NSV variables
+!
+NSV_A(KMI) = ISV
+!
+!
+!* Update LHORELAX_SV,CGETSVM,CGETSVT for NON USER SV
+!
+! C2R2 or KHKO SV case
+!*BUG*JPC*MAR2006
+! IF (CCLOUD == 'C2R2' .OR. CCLOUD == 'KHKO' ) &
+IF (CCLOUD == 'C2R2' .OR. CCLOUD == 'C3R5' .OR. CCLOUD == 'KHKO' ) &
+!*BUG*JPC*MAR2006
+LHORELAX_SV(NSV_C2R2BEG_A(KMI):NSV_C2R2END_A(KMI))=LHORELAX_SVC2R2
+! C3R5 SV case
+IF (CCLOUD == 'C3R5') &
+LHORELAX_SV(NSV_C1R3BEG_A(KMI):NSV_C1R3END_A(KMI))=LHORELAX_SVC1R3
+! LIMA SV case
+IF (CCLOUD == 'LIMA') &
+LHORELAX_SV(NSV_LIMA_BEG_A(KMI):NSV_LIMA_END_A(KMI))=LHORELAX_SVLIMA
+! Electrical SV case
+IF (CELEC /= 'NONE') &
+LHORELAX_SV(NSV_ELECBEG_A(KMI):NSV_ELECEND_A(KMI))=LHORELAX_SVELEC
+! Chemical SV case
+IF (LUSECHEM .OR. LCHEMDIAG) &
+LHORELAX_SV(NSV_CHEMBEG_A(KMI):NSV_CHEMEND_A(KMI))=LHORELAX_SVCHEM
+! Ice phase Chemical SV case
+IF (LUSECHIC) &
+LHORELAX_SV(NSV_CHICBEG_A(KMI):NSV_CHICEND_A(KMI))=LHORELAX_SVCHIC
+! LINOX SV case
+IF (.NOT.(LUSECHEM .OR. LCHEMDIAG) .AND. LCH_CONV_LINOX) &
+LHORELAX_SV(NSV_LNOXBEG_A(KMI):NSV_LNOXEND_A(KMI))=LHORELAX_SVCHEM
+! Dust SV case
+IF (LDUST) &
+LHORELAX_SV(NSV_DSTBEG_A(KMI):NSV_DSTEND_A(KMI))=LHORELAX_SVDST
+! Sea Salt SV case
+IF (LSALT) &
+LHORELAX_SV(NSV_SLTBEG_A(KMI):NSV_SLTEND_A(KMI))=LHORELAX_SVSLT
+! Aerosols SV case
+IF (LORILAM) &
+LHORELAX_SV(NSV_AERBEG_A(KMI):NSV_AEREND_A(KMI))=LHORELAX_SVAER
+! Lagrangian variables
+IF (LLG) &
+LHORELAX_SV(NSV_LGBEG_A(KMI):NSV_LGEND_A(KMI))=LHORELAX_SVLG
+! Passive pollutants
+IF (LPASPOL) &
+LHORELAX_SV(NSV_PPBEG_A(KMI):NSV_PPEND_A(KMI))=LHORELAX_SVPP
+#ifdef MNH_FOREFIRE
+! Fire pollutants
+IF (LFOREFIRE) &
+LHORELAX_SV(NSV_FFBEG_A(KMI):NSV_FFEND_A(KMI))=LHORELAX_SVFF
+#endif
+! Blaze Fire pollutants
+IF (LBLAZE) &
+LHORELAX_SV(NSV_FIREBEG_A(KMI):NSV_FIREEND_A(KMI))=LHORELAX_SVFIRE
+! Conditional sampling
+IF (LCONDSAMP) &
+LHORELAX_SV(NSV_CSBEG_A(KMI):NSV_CSEND_A(KMI))=LHORELAX_SVCS
+! Blowing snow case
+IF (LBLOWSNOW) &
+LHORELAX_SV(NSV_SNWBEG_A(KMI):NSV_SNWEND_A(KMI))=LHORELAX_SVSNW
+! Update NSV* variables for model KMI
+CALL UPDATE_NSV(KMI)
+!
+! SET MINIMUN VALUE FOR DIFFERENT SV GROUPS
+!
+XSVMIN(1:NSV_USER_A(KMI))=0.
+IF (CCLOUD == 'C2R2' .OR. CCLOUD == 'C3R5' .OR. CCLOUD == 'KHKO' ) &
+XSVMIN(NSV_C2R2BEG_A(KMI):NSV_C2R2END_A(KMI))=0.
+IF (CCLOUD == 'C3R5') &
+XSVMIN(NSV_C1R3BEG_A(KMI):NSV_C1R3END_A(KMI))=0.
+IF (CCLOUD == 'LIMA') &
+XSVMIN(NSV_LIMA_BEG_A(KMI):NSV_LIMA_END_A(KMI))=0.
+IF (CELEC /= 'NONE') &
+XSVMIN(NSV_ELECBEG_A(KMI):NSV_ELECEND_A(KMI))=0.
+IF (LUSECHEM .OR. LCHEMDIAG) &
+XSVMIN(NSV_CHEMBEG_A(KMI):NSV_CHEMEND_A(KMI))=0.
+IF (LUSECHIC) &
+XSVMIN(NSV_CHICBEG_A(KMI):NSV_CHICEND_A(KMI))=0.
+IF (.NOT.(LUSECHEM .OR. LCHEMDIAG) .AND. LCH_CONV_LINOX) &
+XSVMIN(NSV_LNOXBEG_A(KMI):NSV_LNOXEND_A(KMI))=0.
+IF (LORILAM .OR. LCHEMDIAG) &
+XSVMIN(NSV_AERBEG_A(KMI):NSV_AEREND_A(KMI))=0.
+IF (LDUST) XSVMIN(NSV_DSTBEG_A(KMI):NSV_DSTEND_A(KMI))=XMNH_TINY
+IF ((LDUST).AND.(LDEPOS_DST(KMI))) &
+XSVMIN(NSV_DSTDEPBEG_A(KMI):NSV_DSTDEPEND_A(KMI))=XMNH_TINY
+IF (LSALT) XSVMIN(NSV_SLTBEG_A(KMI):NSV_SLTEND_A(KMI))=XMNH_TINY
+IF (LLG) THEN
+ XSVMIN(NSV_LGBEG_A(KMI)) =XLG1MIN
+ XSVMIN(NSV_LGBEG_A(KMI)+1)=XLG2MIN
+ XSVMIN(NSV_LGEND_A(KMI)) =XLG3MIN
+ENDIF
+IF ((LSALT).AND.(LDEPOS_SLT(KMI))) &
+XSVMIN(NSV_SLTDEPBEG_A(KMI):NSV_SLTDEPEND_A(KMI))=XMNH_TINY
+IF ((LORILAM).AND.(LDEPOS_AER(KMI))) &
+XSVMIN(NSV_AERDEPBEG_A(KMI):NSV_AERDEPEND_A(KMI))=XMNH_TINY
+IF (LPASPOL) XSVMIN(NSV_PPBEG_A(KMI):NSV_PPEND_A(KMI))=0.
+#ifdef MNH_FOREFIRE
+IF (LFOREFIRE) XSVMIN(NSV_FFBEG_A(KMI):NSV_FFEND_A(KMI))=0.
+#endif
+! Blaze smoke
+IF (LBLAZE) XSVMIN(NSV_FIREBEG_A(KMI):NSV_FIREEND_A(KMI))=0.
+!
+IF (LCONDSAMP) XSVMIN(NSV_CSBEG_A(KMI):NSV_CSEND_A(KMI))=0.
+IF (LBLOWSNOW) XSVMIN(NSV_SNWBEG_A(KMI):NSV_SNWEND_A(KMI))=XMNH_TINY
+!
+! NAME OF THE SCALAR VARIABLES IN THE DIFFERENT SV GROUPS
+!
+CSV_A(:, KMI) = ' '
+IF (LLG) THEN
+ CSV_A(NSV_LGBEG_A(KMI), KMI) = 'X0 '
+ CSV_A(NSV_LGBEG_A(KMI)+1, KMI) = 'Y0 '
+ CSV_A(NSV_LGEND_A(KMI), KMI) = 'Z0 '
+ENDIF
+
+! Initialize scalar variable names for dust
+IF ( LDUST ) THEN
+ IF ( NMODE_DST < 1 .OR. NMODE_DST > 3 ) CALL Print_msg( NVERB_FATAL, 'GEN', 'INI_NSV', 'NMODE_DST must in the 1 to 3 interval' )
+
+ ! Initialization of dust names
+ ! Was allocated for previous KMI
+ ! We assume that if LDUST=T on a model, NSV_DST_A(KMI) is the same for all
+ IF( .NOT. ALLOCATED( CDUSTNAMES ) ) THEN
+ ALLOCATE( CDUSTNAMES(NSV_DST_A(KMI)) )
+ ELSE IF ( SIZE( CDUSTNAMES ) /= NSV_DST_A(KMI) ) THEN
+ CALL Print_msg( NVERB_ERROR, 'GEN', 'INI_NSV', 'NSV_DST not the same for different model (if LDUST=T)' )
+ DEALLOCATE( CDUSTNAMES )
+ ALLOCATE( CDUSTNAMES(NSV_DST_A(KMI)) )
+ END IF
+ ALLOCATE( YDUSTLONGNAMES(NSV_DST_A(KMI)) )
+ !Loop on all dust modes
+ IF ( INMOMENTS_DST == 1 ) THEN
+ DO JMODE = 1, NMODE_DST
+ IMODEIDX = JPDUSTORDER(JMODE)
+ JSV_NAME = ( IMODEIDX - 1 ) * 3 + 2
+ CDUSTNAMES(JMODE) = YPDUST_INI(JSV_NAME)
+ !Add meaning of the ppv unit (here for moment 3)
+ YDUSTLONGNAMES(JMODE) = TRIM( YPDUST_INI(JSV_NAME) ) // ' [molec_{aer}/molec_{air}]'
+ END DO
+ ELSE
+ DO JMODE = 1,NMODE_DST
+ !Find which mode we are dealing with
+ IMODEIDX = JPDUSTORDER(JMODE)
+ DO JMOM = 1, INMOMENTS_DST
+ !Find which number this is of the list of scalars
+ JSV = ( JMODE - 1 ) * INMOMENTS_DST + JMOM
+ !Find what name this corresponds to, always 3 moments assumed in YPDUST_INI
+ JSV_NAME = ( IMODEIDX - 1) * 3 + JMOM
+ !Get the right CDUSTNAMES which should follow the list of scalars transported in XSVM/XSVT
+ CDUSTNAMES(JSV) = YPDUST_INI(JSV_NAME)
+ !Add meaning of the ppv unit
+ IF ( JMOM == 1 ) THEN !Corresponds to moment 0
+ YDUSTLONGNAMES(JSV) = TRIM( YPDUST_INI(JSV_NAME) ) // ' [nb_aerosols/molec_{air}]'
+ ELSE IF ( JMOM == 2 ) THEN !Corresponds to moment 3
+ YDUSTLONGNAMES(JSV) = TRIM( YPDUST_INI(JSV_NAME) ) // ' [molec_{aer}/molec_{air}]'
+ ELSE IF ( JMOM == 3 ) THEN !Corresponds to moment 6
+ YDUSTLONGNAMES(JSV) = TRIM( YPDUST_INI(JSV_NAME) ) // ' [um6/molec_{air}*(cm3/m3)]'
+ ELSE
+ CALL Print_msg( NVERB_WARNING, 'GEN', 'INI_NSV', 'unknown moment for DUST' )
+ YDUSTLONGNAMES(JMODE) = TRIM( YPDUST_INI(JSV_NAME) )
+ END IF
+ ENDDO ! Loop on moments
+ ENDDO ! Loop on dust modes
+ END IF
+
+ ! Initialization of deposition scheme names
+ IF ( LDEPOS_DST(KMI) ) THEN
+ IF( .NOT. ALLOCATED( CDEDSTNAMES ) ) THEN
+ ALLOCATE( CDEDSTNAMES(NMODE_DST * 2) )
+ DO JMODE = 1, NMODE_DST
+ IMODEIDX = JPDUSTORDER(JMODE)
+ CDEDSTNAMES(JMODE) = YPDEDST_INI(IMODEIDX)
+ CDEDSTNAMES(NMODE_DST + JMODE) = YPDEDST_INI(NMODE_DST + IMODEIDX)
+ ENDDO
+ END IF
+ END IF
+END IF
+
+! Initialize scalar variable names for salt
+IF ( LSALT ) THEN
+ IF ( NMODE_SLT < 1 .OR. NMODE_SLT > 8 ) CALL Print_msg( NVERB_FATAL, 'GEN', 'INI_NSV', 'NMODE_SLT must in the 1 to 8 interval' )
+
+ ! Was allocated for previous KMI
+ ! We assume that if LSALT=T on a model, NSV_SLT_A(KMI) is the same for all
+ IF( .NOT. ALLOCATED( CSALTNAMES ) ) THEN
+ ALLOCATE( CSALTNAMES(NSV_SLT_A(KMI)) )
+ ELSE IF ( SIZE( CSALTNAMES ) /= NSV_SLT_A(KMI) ) THEN
+ CALL Print_msg( NVERB_ERROR, 'GEN', 'INI_NSV', 'NSV_SLT not the same for different model (if LSALT=T)' )
+ DEALLOCATE( CSALTNAMES )
+ ALLOCATE( CSALTNAMES(NSV_SLT_A(KMI)) )
+ END IF
+ ALLOCATE( YSALTLONGNAMES(NSV_SLT_A(KMI)) )
+ !Loop on all dust modes
+ IF ( INMOMENTS_SLT == 1 ) THEN
+ DO JMODE = 1, NMODE_SLT
+ IMODEIDX = JPSALTORDER(JMODE)
+ JSV_NAME = ( IMODEIDX - 1 ) * 3 + 2
+ CSALTNAMES(JMODE) = YPSALT_INI(JSV_NAME)
+ !Add meaning of the ppv unit (here for moment 3)
+ YSALTLONGNAMES(JMODE) = TRIM( YPSALT_INI(JSV_NAME) ) // ' [molec_{aer}/molec_{air}]'
+ END DO
+ ELSE
+ DO JMODE = 1, NMODE_SLT
+ !Find which mode we are dealing with
+ IMODEIDX = JPSALTORDER(JMODE)
+ DO JMOM = 1, INMOMENTS_SLT
+ !Find which number this is of the list of scalars
+ JSV = ( JMODE - 1 ) * INMOMENTS_SLT + JMOM
+ !Find what name this corresponds to, always 3 moments assumed in YPSALT_INI
+ JSV_NAME = ( IMODEIDX - 1 ) * 3 + JMOM
+ !Get the right CSALTNAMES which should follow the list of scalars transported in XSVM/XSVT
+ CSALTNAMES(JSV) = YPSALT_INI(JSV_NAME)
+ !Add meaning of the ppv unit
+ IF ( JMOM == 1 ) THEN !Corresponds to moment 0
+ YSALTLONGNAMES(JSV) = TRIM( YPSALT_INI(JSV_NAME) ) // ' [nb_aerosols/molec_{air}]'
+ ELSE IF ( JMOM == 2 ) THEN !Corresponds to moment 3
+ YSALTLONGNAMES(JSV) = TRIM( YPSALT_INI(JSV_NAME) ) // ' [molec_{aer}/molec_{air}]'
+ ELSE IF ( JMOM == 3 ) THEN !Corresponds to moment 6
+ YSALTLONGNAMES(JSV) = TRIM( YPSALT_INI(JSV_NAME) ) // ' [um6/molec_{air}*(cm3/m3)]'
+ ELSE
+ CALL Print_msg( NVERB_WARNING, 'GEN', 'INI_NSV', 'unknown moment for SALT' )
+ YSALTLONGNAMES(JMODE) = TRIM( YPSALT_INI(JSV_NAME) )
+ END IF
+ ENDDO ! Loop on moments
+ ENDDO ! Loop on dust modes
+ END IF
+
+ ! Initialization of deposition scheme
+ IF ( LDEPOS_SLT(KMI) ) THEN
+ IF( .NOT. ALLOCATED( CDESLTNAMES ) ) THEN
+ ALLOCATE( CDESLTNAMES(NMODE_SLT * 2) )
+ DO JMODE = 1, NMODE_SLT
+ IMODEIDX = JPSALTORDER(JMODE)
+ CDESLTNAMES(JMODE) = YPDESLT_INI(IMODEIDX)
+ CDESLTNAMES(NMODE_SLT + JMODE) = YPDESLT_INI(NMODE_SLT + IMODEIDX)
+ ENDDO
+ ENDIF
+ ENDIF
+END IF
+
+! Initialize scalar variable names for snow
+IF ( LBLOWSNOW ) THEN
+ IF( .NOT. ALLOCATED( CSNOWNAMES ) ) THEN
+ ALLOCATE( CSNOWNAMES(NSV_SNW_A(KMI)) )
+ DO JMOM = 1, NSV_SNW_A(KMI)
+ CSNOWNAMES(JMOM) = YPSNOW_INI(JMOM)
+ END DO
+ END IF
+END IF
+
+!Fill metadata for model KMI
+DO JSV = 1, NSV_USER_A(KMI)
+ WRITE( YNUM3, '( I3.3 )' ) JSV
+
+ TSVLIST_A(JSV, KMI) = TFIELDMETADATA( &
+ CMNHNAME = 'SVUSER' // YNUM3, &
+ CSTDNAME = '', &
+ CLONGNAME = 'SVUSER' // YNUM3, &
+ CUNITS = 'kg kg-1', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_Z_' // 'SVUSER' // YNUM3, &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+END DO
+
+DO JSV = NSV_C2R2BEG_A(KMI), NSV_C2R2END_A(KMI)
+ WRITE( YNUM3, '( I3.3 )' ) JSV
+
+ TSVLIST_A(JSV, KMI) = TFIELDMETADATA( &
+ CMNHNAME = TRIM( C2R2NAMES(JSV-NSV_C2R2BEG_A(KMI)+1) ), &
+ CSTDNAME = '', &
+ CLONGNAME = TRIM( C2R2NAMES(JSV-NSV_C2R2BEG_A(KMI)+1) ), &
+ CUNITS = 'm-3', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_Z_' // 'SVT' // YNUM3, &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+END DO
+
+DO JSV = NSV_C1R3BEG_A(KMI), NSV_C1R3END_A(KMI)
+ WRITE( YNUM3, '( I3.3 )' ) JSV
+
+ TSVLIST_A(JSV, KMI) = TFIELDMETADATA( &
+ CMNHNAME = TRIM( C1R3NAMES(JSV-NSV_C2R2BEG_A(KMI)+1) ), &
+ CSTDNAME = '', &
+ CLONGNAME = TRIM( C1R3NAMES(JSV-NSV_C2R2BEG_A(KMI)+1) ), &
+ CUNITS = 'm-3', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_Z_' // 'SVT' // YNUM3, &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+END DO
+
+DO JSV = NSV_LIMA_BEG_A(KMI), NSV_LIMA_END_A(KMI)
+ WRITE( YNUM3, '( I3.3 )' ) JSV
+
+ TSVLIST_A(JSV, KMI) = TFIELDMETADATA( &
+ CMNHNAME = 'SV LIMA ' // YNUM3, &
+ CSTDNAME = '', &
+ CLONGNAME = '', &
+ CUNITS = 'kg-1', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_Z_' // 'SVT' // YNUM3, &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+
+ IF ( JSV == NSV_LIMA_NC_A(KMI) ) THEN
+ TSVLIST_A(JSV, KMI)%CMNHNAME = TRIM( CLIMA_WARM_NAMES(1) )
+ ELSE IF ( JSV == NSV_LIMA_NR_A(KMI) ) THEN
+ TSVLIST_A(JSV, KMI)%CMNHNAME = TRIM( CLIMA_WARM_NAMES(2) )
+ ELSE IF ( JSV >= NSV_LIMA_CCN_FREE_A(KMI) .AND. JSV < NSV_LIMA_CCN_ACTI_A(KMI) ) THEN
+ WRITE( YNUM2, '( I2.2 )' ) JSV - NSV_LIMA_CCN_FREE_A(KMI) + 1
+ TSVLIST_A(JSV, KMI)%CMNHNAME = TRIM( CLIMA_WARM_NAMES(3) ) // YNUM2
+ ELSE IF (JSV >= NSV_LIMA_CCN_ACTI_A(KMI) .AND. JSV < ( NSV_LIMA_CCN_ACTI_A(KMI) + NMOD_CCN ) ) THEN
+ WRITE( YNUM2, '( I2.2 )' ) JSV - NSV_LIMA_CCN_ACTI_A(KMI) + 1
+ TSVLIST_A(JSV, KMI)%CMNHNAME = TRIM( CLIMA_WARM_NAMES(4) ) // YNUM2
+ ELSE IF ( JSV == NSV_LIMA_SCAVMASS_A(KMI) ) THEN
+ TSVLIST_A(JSV, KMI)%CMNHNAME = TRIM( CAERO_MASS(1) )
+ TSVLIST_A(JSV, KMI)%CUNITS = 'kg kg-1'
+ ELSE IF ( JSV == NSV_LIMA_NI_A(KMI) ) THEN
+ TSVLIST_A(JSV, KMI)%CMNHNAME = TRIM( CLIMA_COLD_NAMES(1) )
+ ELSE IF ( JSV == NSV_LIMA_NS_A(KMI) ) THEN
+ TSVLIST_A(JSV, KMI)%CMNHNAME = TRIM( CLIMA_COLD_NAMES(2) )
+ ELSE IF ( JSV == NSV_LIMA_NG_A(KMI) ) THEN
+ TSVLIST_A(JSV, KMI)%CMNHNAME = TRIM( CLIMA_COLD_NAMES(3) )
+ ELSE IF ( JSV == NSV_LIMA_NH_A(KMI) ) THEN
+ TSVLIST_A(JSV, KMI)%CMNHNAME = TRIM( CLIMA_COLD_NAMES(4) )
+ ELSE IF ( JSV >= NSV_LIMA_IFN_FREE_A(KMI) .AND. JSV < NSV_LIMA_IFN_NUCL_A(KMI) ) THEN
+ WRITE( YNUM2, '( I2.2 )' ) JSV - NSV_LIMA_IFN_FREE_A(KMI) + 1
+ TSVLIST_A(JSV, KMI)%CMNHNAME = TRIM( CLIMA_COLD_NAMES(5) ) // YNUM2
+ ELSE IF ( JSV >= NSV_LIMA_IFN_NUCL_A(KMI) .AND. JSV < ( NSV_LIMA_IFN_NUCL_A(KMI) + NMOD_IFN ) ) THEN
+ WRITE( YNUM2, '( I2.2 )' ) JSV - NSV_LIMA_IFN_NUCL_A(KMI) + 1
+ TSVLIST_A(JSV, KMI)%CMNHNAME = TRIM( CLIMA_COLD_NAMES(6) ) // YNUM2
+ ELSE IF ( JSV >= NSV_LIMA_IMM_NUCL_A(KMI) .AND. JSV < ( NSV_LIMA_IMM_NUCL_A(KMI) + NMOD_IMM ) ) THEN
+ WRITE( YNUM2, '( I2.2 )' ) NINDICE_CCN_IMM(JSV-NSV_LIMA_IMM_NUCL_A(KMI)+1)
+ TSVLIST_A(JSV, KMI)%CMNHNAME = TRIM( CLIMA_COLD_NAMES(7) ) // YNUM2
+ ELSE IF ( JSV == NSV_LIMA_HOM_HAZE_A(KMI) ) THEN
+ TSVLIST_A(JSV, KMI)%CMNHNAME = TRIM( CLIMA_COLD_NAMES(8) )
+ ELSE IF ( JSV == NSV_LIMA_SPRO_A(KMI) ) THEN
+ TSVLIST_A(JSV, KMI)%CUNITS = '1'
+ TSVLIST_A(JSV, KMI)%CMNHNAME = TRIM( CLIMA_WARM_NAMES(5) )
+ ELSE
+ CALL Print_msg( NVERB_FATAL, 'GEN', 'INI_NSV', 'invalid index for LIMA' )
+ END IF
+
+ TSVLIST_A(JSV, KMI)%CLONGNAME = TRIM( TSVLIST_A(JSV, KMI)%CMNHNAME )
+END DO
+
+DO JSV = NSV_ELECBEG_A(KMI), NSV_ELECEND_A(KMI)
+ IF ( JSV > NSV_ELECBEG .AND. JSV < NSV_ELECEND ) THEN
+ YUNITS = 'C kg-1'
+ WRITE( YCOMMENT, '( A6, A3, I3.3 )' ) 'X_Y_Z_', 'SVT', JSV
+ ELSE
+ YUNITS = 'kg-1'
+ WRITE( YCOMMENT, '( A6, A3, I3.3, A8 )' ) 'X_Y_Z_', 'SVT', JSV, ' (nb ions/kg)'
+ END IF
+
+ TSVLIST_A(JSV, KMI) = TFIELDMETADATA( &
+ CMNHNAME = TRIM( CELECNAMES(JSV-NSV_ELECBEG_A(KMI)+1) ), &
+ CSTDNAME = '', &
+ CLONGNAME = TRIM( CELECNAMES(JSV-NSV_ELECBEG_A(KMI)+1) ), &
+ CUNITS = TRIM( YUNITS ), &
+ CDIR = 'XY', &
+ CCOMMENT = TRIM( YCOMMENT ), &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+END DO
+
+DO JSV = NSV_LGBEG_A(KMI), NSV_LGEND_A(KMI)
+ WRITE( YNUM3, '( I3.3 )' ) JSV
+
+ TSVLIST_A(JSV, KMI) = TFIELDMETADATA( &
+ CMNHNAME = TRIM( CLGNAMES(JSV-NSV_LGBEG_A(KMI)+1) ), &
+ CSTDNAME = '', &
+ CLONGNAME = TRIM( CLGNAMES(JSV-NSV_LGBEG_A(KMI)+1) ), &
+ CUNITS = 'm', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_Z_' // 'SVT' // YNUM3, &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+END DO
+
+DO JSV = NSV_PPBEG_A(KMI), NSV_PPEND_A(KMI)
+ WRITE( YNUM3, '( I3.3 )' ) JSV-NSV_PPBEG_A(KMI)+1
+
+ TSVLIST_A(JSV, KMI) = TFIELDMETADATA( &
+ CMNHNAME = 'SVPP' // YNUM3, &
+ CSTDNAME = '', &
+ CLONGNAME = 'SVPP' // YNUM3, &
+ CUNITS = 'kg kg-1', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_Z_' // 'SVT' // YNUM3, &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+END DO
+
+#ifdef MNH_FOREFIRE
+DO JSV = NSV_FFBEG_A(KMI), NSV_FFEND_A(KMI)
+ WRITE( YNUM3, '( I3.3 )' ) JSV-NSV_FFBEG_A(KMI)+1
+
+ TSVLIST_A(JSV, KMI) = TFIELDMETADATA( &
+ CMNHNAME = 'SVFF' // YNUM3, &
+ CSTDNAME = '', &
+ CLONGNAME = 'SVFF' // YNUM3, &
+ CUNITS = 'kg kg-1', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_Z_' // 'SVT' // YNUM3, &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+END DO
+#endif
+
+DO JSV = NSV_FIREBEG_A(KMI), NSV_FIREEND_A(KMI)
+ WRITE( YNUM3, '( I3.3 )' ) JSV-NSV_FIREBEG_A(KMI)+1
+
+ TSVLIST_A(JSV, KMI) = TFIELDMETADATA( &
+ CMNHNAME = 'SVFIRE' // YNUM3, &
+ CSTDNAME = '', &
+ CLONGNAME = 'SVFIRE' // YNUM3, &
+ CUNITS = 'kg kg-1', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_Z_' // 'SVT' // YNUM3, &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+END DO
+
+DO JSV = NSV_CSBEG_A(KMI), NSV_CSEND_A(KMI)
+ WRITE( YNUM3, '( I3.3 )' ) JSV-NSV_CSBEG_A(KMI)
+
+ TSVLIST_A(JSV, KMI) = TFIELDMETADATA( &
+ CMNHNAME = 'SVCS' // YNUM3, &
+ CSTDNAME = '', &
+ CLONGNAME = 'SVCS' // YNUM3, &
+ CUNITS = 'kg kg-1', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_Z_' // 'SVT' // YNUM3, &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+END DO
+
+DO JSV = NSV_CHEMBEG_A(KMI), NSV_CHEMEND_A(KMI)
+ ICHIDX = ICHIDX + 1
+ CSV_CHEM_LIST_A(ICHIDX, KMI) = TRIM( CNAMES(JSV-NSV_CHEMBEG_A(KMI)+1) )
+
+ WRITE( YNUM3, '( I3.3 )' ) JSV
+
+ TSVLIST_A(JSV, KMI) = TFIELDMETADATA( &
+ CMNHNAME = TRIM( CNAMES(JSV-NSV_CHEMBEG_A(KMI)+1) ), &
+ CSTDNAME = '', &
+ CLONGNAME = TRIM( CNAMES(JSV-NSV_CHEMBEG_A(KMI)+1) ), &
+ CUNITS = 'ppv', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_Z_' // 'SVT' // YNUM3, &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+END DO
+
+DO JSV = NSV_CHICBEG_A(KMI), NSV_CHICEND_A(KMI)
+ ICHIDX = ICHIDX + 1
+ CSV_CHEM_LIST_A(ICHIDX, KMI) = TRIM( CICNAMES(JSV-NSV_CHICBEG_A(KMI)+1) )
+
+ WRITE( YNUM3, '( I3.3 )' ) JSV
+
+ TSVLIST_A(JSV, KMI) = TFIELDMETADATA( &
+ CMNHNAME = TRIM( CICNAMES(JSV-NSV_CHICBEG_A(KMI)+1) ), &
+ CSTDNAME = '', &
+ CLONGNAME = TRIM( CICNAMES(JSV-NSV_CHICBEG_A(KMI)+1) ), &
+ CUNITS = 'ppv', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_Z_' // 'SVT' // YNUM3, &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+END DO
+
+DO JSV = NSV_AERBEG_A(KMI), NSV_AEREND_A(KMI)
+ ICHIDX = ICHIDX + 1
+ CSV_CHEM_LIST_A(ICHIDX, KMI) = TRIM( CAERONAMES(JSV-NSV_AERBEG_A(KMI)+1) )
+
+ WRITE( YNUM3, '( I3.3 )' ) JSV
+
+ !Determine moment to add meaning of the ppv unit
+ JAER = JSV - NSV_AERBEG_A(KMI) + 1
+ IF ( ANY( JAER == [JP_CH_M0i, JP_CH_M0j] ) ) THEN
+ !Moment 0
+ YAEROLONGNAMES = TRIM( CAERONAMES(JAER) ) // ' [nb_aerosols/molec_{air}]'
+ ELSE IF ( ANY( JAER == [ JP_CH_SO4i, JP_CH_SO4j, JP_CH_NO3i, JP_CH_NO3j, JP_CH_H2Oi, JP_CH_H2Oj, JP_CH_NH3i, JP_CH_NH3j, &
+ JP_CH_OCi, JP_CH_OCj, JP_CH_BCi, JP_CH_BCj, JP_CH_DSTi, JP_CH_DSTj ] ) &
+ .OR. ( NSOA == 10 .AND. &
+ ANY( JAER == [ JP_CH_SOA1i, JP_CH_SOA1j, JP_CH_SOA2i, JP_CH_SOA2j, JP_CH_SOA3i, JP_CH_SOA3j, JP_CH_SOA4i, &
+ JP_CH_SOA4j, JP_CH_SOA5i, JP_CH_SOA5j, JP_CH_SOA6i, JP_CH_SOA6j, JP_CH_SOA7i, JP_CH_SOA7j, &
+ JP_CH_SOA8i, JP_CH_SOA8j, JP_CH_SOA9i, JP_CH_SOA9j, JP_CH_SOA10i, JP_CH_SOA10j ] ) ) ) THEN
+ !Moment 3
+ YAEROLONGNAMES = TRIM( CAERONAMES(JAER) ) // ' [molec_{aer}/molec_{air}]'
+ ELSE IF ( ( LVARSIGI .AND. JAER == JP_CH_M6i ) .OR. ( LVARSIGJ .AND. JAER == JP_CH_M6j ) ) THEN
+ !Moment 6
+ YAEROLONGNAMES = TRIM( CAERONAMES(JAER) ) // ' [um6/molec_{air}*(cm3/m3)]'
+ ELSE
+ CALL Print_msg( NVERB_WARNING, 'GEN', 'INI_NSV', 'unknown moment for AER' )
+ YAEROLONGNAMES = TRIM( CAERONAMES(JAER) )
+ END IF
+
+ TSVLIST_A(JSV, KMI) = TFIELDMETADATA( &
+ CMNHNAME = TRIM( CAERONAMES(JSV-NSV_AERBEG_A(KMI)+1) ), &
+ CSTDNAME = '', &
+ CLONGNAME = TRIM( YAEROLONGNAMES(JSV-NSV_AERBEG_A(KMI)+1) ), &
+ CUNITS = 'ppv', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_Z_' // 'SVT' // YNUM3, &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+END DO
+
+DO JSV = NSV_AERDEPBEG_A(KMI), NSV_AERDEPEND_A(KMI)
+ ICHIDX = ICHIDX + 1
+ CSV_CHEM_LIST_A(ICHIDX, KMI) = TRIM( CDEAERNAMES(JSV-NSV_AERDEPBEG_A(KMI)+1) )
+
+ WRITE( YNUM3, '( I3.3 )' ) JSV
+
+ TSVLIST_A(JSV, KMI) = TFIELDMETADATA( &
+ CMNHNAME = TRIM( CDEAERNAMES(JSV-NSV_AERDEPBEG_A(KMI)+1) ), &
+ CSTDNAME = '', &
+ CLONGNAME = TRIM( CDEAERNAMES(JSV-NSV_AERDEPBEG_A(KMI)+1) ), &
+ CUNITS = 'ppv', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_Z_' // 'SVT' // YNUM3, &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+END DO
+
+DO JSV = NSV_DSTBEG_A(KMI), NSV_DSTEND_A(KMI)
+ ICHIDX = ICHIDX + 1
+ CSV_CHEM_LIST_A(ICHIDX, KMI) = TRIM( CDUSTNAMES(JSV-NSV_DSTBEG_A(KMI)+1) )
+
+ WRITE( YNUM3, '( I3.3 )' ) JSV
+
+ TSVLIST_A(JSV, KMI) = TFIELDMETADATA( &
+ CMNHNAME = TRIM( CDUSTNAMES(JSV-NSV_DSTBEG_A(KMI)+1) ), &
+ CSTDNAME = '', &
+ CLONGNAME = TRIM( YDUSTLONGNAMES(JSV-NSV_DSTBEG_A(KMI)+1) ), &
+ CUNITS = 'ppv', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_Z_' // 'SVT' // YNUM3, &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+END DO
+
+DO JSV = NSV_DSTDEPBEG_A(KMI), NSV_DSTDEPEND_A(KMI)
+ ICHIDX = ICHIDX + 1
+ CSV_CHEM_LIST_A(ICHIDX, KMI) = TRIM( CDEDSTNAMES(JSV-NSV_DSTDEPBEG_A(KMI)+1) )
+
+ WRITE( YNUM3, '( I3.3 )' ) JSV
+
+ TSVLIST_A(JSV, KMI) = TFIELDMETADATA( &
+ CMNHNAME = TRIM( CDEDSTNAMES(JSV-NSV_DSTDEPBEG_A(KMI)+1) ), &
+ CSTDNAME = '', &
+ CLONGNAME = TRIM( CDEDSTNAMES(JSV-NSV_DSTDEPBEG_A(KMI)+1) ), &
+ CUNITS = 'ppv', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_Z_' // 'SVT' // YNUM3, &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+END DO
+
+DO JSV = NSV_SLTBEG_A(KMI), NSV_SLTEND_A(KMI)
+ ICHIDX = ICHIDX + 1
+ CSV_CHEM_LIST_A(ICHIDX, KMI) = TRIM( CSALTNAMES(JSV-NSV_SLTBEG_A(KMI)+1) )
+
+ WRITE( YNUM3, '( I3.3 )' ) JSV
+
+ TSVLIST_A(JSV, KMI) = TFIELDMETADATA( &
+ CMNHNAME = TRIM( CSALTNAMES(JSV-NSV_SLTBEG_A(KMI)+1) ), &
+ CSTDNAME = '', &
+ CLONGNAME = TRIM( YSALTLONGNAMES(JSV-NSV_SLTBEG_A(KMI)+1) ), &
+ CUNITS = 'ppv', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_Z_' // 'SVT' // YNUM3, &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+END DO
+
+DO JSV = NSV_SLTDEPBEG_A(KMI), NSV_SLTDEPEND_A(KMI)
+ ICHIDX = ICHIDX + 1
+ CSV_CHEM_LIST_A(ICHIDX, KMI) = TRIM( CDESLTNAMES(JSV-NSV_SLTDEPBEG_A(KMI)+1) )
+
+ WRITE( YNUM3, '( I3.3 )' ) JSV
+
+ TSVLIST_A(JSV, KMI) = TFIELDMETADATA( &
+ CMNHNAME = TRIM( CDESLTNAMES(JSV-NSV_SLTDEPBEG_A(KMI)+1) ), &
+ CSTDNAME = '', &
+ CLONGNAME = TRIM( CDESLTNAMES(JSV-NSV_SLTDEPBEG_A(KMI)+1) ), &
+ CUNITS = 'ppv', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_Z_' // 'SVT' // YNUM3, &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+END DO
+
+DO JSV = NSV_SNWBEG_A(KMI), NSV_SNWEND_A(KMI)
+ WRITE( YNUM3, '( I3.3 )' ) JSV
+
+ TSVLIST_A(JSV, KMI) = TFIELDMETADATA( &
+ CMNHNAME = TRIM( CSNOWNAMES(JSV-NSV_SNWBEG_A(KMI)+1) ), &
+ CSTDNAME = '', &
+ CLONGNAME = TRIM( CSNOWNAMES(JSV-NSV_SNWBEG_A(KMI)+1) ), &
+ CUNITS = 'kg kg-1', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_Z_' // 'SVT' // YNUM3, &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+END DO
+
+!Check if there is at most 1 LINOX scalar variable
+!if not, the name must be modified and different for all of them
+IF ( NSV_LNOX_A(KMI) > 1 ) &
+ CALL Print_msg( NVERB_ERROR, 'GEN', 'INI_NSV', 'NSV_LNOX_A>1: problem with the names of the corresponding scalar variables' )
+
+DO JSV = NSV_LNOXBEG_A(KMI), NSV_LNOXEND_A(KMI)
+ ICHIDX = ICHIDX + 1
+ CSV_CHEM_LIST_A(ICHIDX, KMI) = 'LINOX'
+
+ WRITE( YNUM3, '( I3.3 )' ) JSV
+
+ TSVLIST_A(JSV, KMI) = TFIELDMETADATA( &
+ CMNHNAME = 'LINOX', &
+ CSTDNAME = '', &
+ CLONGNAME = 'LINOX', &
+ CUNITS = 'ppv', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_Z_' // 'SVT' // YNUM3, &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+END DO
+
+IF ( ICHIDX /= NSV_CHEM_LIST_A(KMI) ) &
+ CALL Print_msg( NVERB_ERROR, 'GEN', 'INI_NSV', 'ICHIDX /= NSV_CHEM_LIST_A(KMI)' )
+
+END SUBROUTINE INI_NSV
diff --git a/src/PHYEX/ext/init_aerosol_concentration.f90 b/src/PHYEX/ext/init_aerosol_concentration.f90
new file mode 100644
index 0000000000000000000000000000000000000000..fc4becd44a533d13ca84300d098be7872458d4f6
--- /dev/null
+++ b/src/PHYEX/ext/init_aerosol_concentration.f90
@@ -0,0 +1,157 @@
+!MNH_LIC Copyright 2013-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_INIT_AEROSOL_CONCENTRATION
+!######################################
+!
+INTERFACE INIT_AEROSOL_CONCENTRATION
+ SUBROUTINE INIT_AEROSOL_CONCENTRATION(PRHODREF, PSVT, PZZ)
+!
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF !Air Density [kg/m**3]
+ REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVT !Particles Concentration [/m**3]
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Height (z)
+!
+ END SUBROUTINE INIT_AEROSOL_CONCENTRATION
+END INTERFACE INIT_AEROSOL_CONCENTRATION
+!
+END MODULE MODI_INIT_AEROSOL_CONCENTRATION
+!
+! ##########################################################
+ SUBROUTINE INIT_AEROSOL_CONCENTRATION(PRHODREF, PSVT, PZZ)
+! ##########################################################
+!!
+!! PURPOSE
+!! -------
+!! Define the aerosol distributions
+!!
+!!
+!! MODD_BLANKn :
+!! CDUMMY2 : CCN ou IFN pour le panache
+!! NDUMMY1 : hauteur base du panache
+!! NDUMMY2 : hauteur sommet du panache
+!! XDUMMY8 : Concentration du panache (N/cm3 pour des CCN, N/L pour des IFN)
+!!
+!!
+!! AUTHOR
+!! ------
+!! J.-P. Pinty * Laboratoire d'Aerologie*
+!! S. Berthet * Laboratoire d'Aerologie*
+!! B. Vié * Laboratoire d'Aerologie*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original ??/??/13
+!! Modification 01/2016 (JP Pinty) Add LIMA
+!!
+!!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_NSV
+USE MODD_PARAM_n, ONLY : CCLOUD
+USE MODD_PARAM_LIMA, ONLY : NMOM_C, LACTI, NMOD_CCN, LSCAV, LAERO_MASS, &
+ XCCN_CONC, LCCN_HOM, &
+ NMOM_I, LNUCL, NMOD_IFN, LMEYERS, &
+ XIFN_CONC, LIFN_HOM
+USE MODD_PARAMETERS, ONLY : JPVEXT
+USE MODD_BLANK_n, ONLY : CDUMMY2, NDUMMY1, NDUMMY2, XDUMMY8
+!
+IMPLICIT NONE
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF !Air Density [kg/m**3]
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVT !Particles Concentration
+ ![particles/kg of dry air]
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Height (z)
+!
+! Local variables
+INTEGER :: JMOD_IFN
+INTEGER :: JSV, JINIT
+INTEGER :: IKB, IKE
+!
+!-------------------------------------------------------------------------------
+!
+!
+!*initialization of N_FREE_CCN/N_ACTIVATED_CCN et N_FREE_IN/N_ACTIVATED_IN
+!
+!
+IF ( NMOM_C.GE.2 .AND. LACTI ) THEN
+ DO JSV = NSV_LIMA_CCN_FREE, NSV_LIMA_CCN_ACTI+NMOD_CCN-1
+ PSVT(:,:,:,JSV) = 0.0
+ ENDDO
+ IKB = 1+JPVEXT
+ IKE = SIZE(PSVT,3)-JPVEXT
+!
+! Initialisation des concentrations en CCN
+!
+!
+ IF (LCCN_HOM) THEN
+! concentration homogène (en nombre par m3) sur la verticale
+ DO JSV = 1, NMOD_CCN
+ PSVT(:,:,IKB:IKE,NSV_LIMA_CCN_FREE+JSV-1) = &
+ XCCN_CONC(JSV)*1.0E6 / PRHODREF(:,:,IKB:IKE)
+ END DO
+ ELSE
+! concentration décroissante selon z
+ DO JSV = 1, NMOD_CCN
+ WHERE (PZZ(:,:,:) .LE. 1000.)
+ PSVT(:,:,:,NSV_LIMA_CCN_FREE+JSV-1) = XCCN_CONC(JSV)*1.0E6 / PRHODREF(:,:,:)
+ ELSEWHERE (PZZ(:,:,:) .LE. 10000.)
+ PSVT(:,:,:,NSV_LIMA_CCN_FREE+JSV-1) = XCCN_CONC(JSV)*1.0E6 &
+ / PRHODREF(:,:,:) * EXP(-LOG(XCCN_CONC(JSV)/0.01)*PZZ(:,:,:)/10000.)
+ ELSEWHERE
+ PSVT(:,:,:,NSV_LIMA_CCN_FREE+JSV-1) = 0.01*1.0E6 / PRHODREF(:,:,:)
+ ENDWHERE
+ END DO
+ ENDIF
+END IF ! LWARM AND LACTI
+!
+! Initialisation des concentrations en IFN
+!
+IF ( NMOM_I.GE.2 .AND. LNUCL .AND. (.NOT. LMEYERS) ) THEN
+ DO JSV = NSV_LIMA_IFN_FREE, NSV_LIMA_IFN_NUCL+NMOD_IFN-1
+ PSVT(:,:,:,JSV) = 0.0
+ ENDDO
+ IKB = 1+JPVEXT
+ IKE = SIZE(PSVT,3)-JPVEXT
+!
+ IF (LIFN_HOM) THEN
+! concentration homogène (en nombre par m3) sur la verticale
+ DO JSV = 1, NMOD_IFN
+ PSVT(:,:,IKB:IKE,NSV_LIMA_IFN_FREE+JSV-1) = &
+ XIFN_CONC(JSV)*1.0E3 / PRHODREF(:,:,IKB:IKE)
+ END DO
+ ELSE
+! concentration décroissante selon z
+ DO JSV = 1, NMOD_IFN
+ WHERE (PZZ(:,:,:) .LE. 1000.)
+ PSVT(:,:,:,NSV_LIMA_IFN_FREE+JSV-1) = XIFN_CONC(JSV)*1.0E3 / PRHODREF(:,:,:)
+ ELSEWHERE (PZZ(:,:,:) .LE. 10000.)
+ PSVT(:,:,:,NSV_LIMA_IFN_FREE+JSV-1) = XIFN_CONC(JSV)*1.0E3 &
+ / PRHODREF(:,:,:) * EXP(-LOG(XIFN_CONC(JSV)/1.)*PZZ(:,:,:)/10000.)
+ ELSEWHERE
+ PSVT(:,:,:,NSV_LIMA_IFN_FREE+JSV-1) = 1*1.0E3 / PRHODREF(:,:,:)
+ ENDWHERE
+ END DO
+ ENDIF
+END IF ! LCOLD AND LNUCL AND NOT LMEYERS
+!
+!
+! Cas d'un panache de "pollution", concentration homogène dans le panache :
+!
+SELECT CASE (CDUMMY2)
+ CASE ('CCN')
+ PSVT(:,:,:,NSV_LIMA_CCN_FREE+NMOD_CCN-1)=0.
+ WHERE ( (PZZ(:,:,:) .GE. NDUMMY1) .AND. (PZZ(:,:,:) .LE. NDUMMY2) ) &
+ PSVT(:,:,:,NSV_LIMA_CCN_FREE+NMOD_CCN-1)=XDUMMY8*1.0E6 / PRHODREF(:,:,:)
+ CASE ('IFN')
+ PSVT(:,:,:,NSV_LIMA_IFN_FREE+NMOD_IFN-1)=0.
+ WHERE ( (PZZ(:,:,:) .GE. NDUMMY1) .AND. (PZZ(:,:,:) .LE. NDUMMY2) ) &
+ PSVT(:,:,:,NSV_LIMA_IFN_FREE+NMOD_IFN-1)=XDUMMY8*1.0E3 / PRHODREF(:,:,:)
+END SELECT
+!
+!
+END SUBROUTINE INIT_AEROSOL_CONCENTRATION
diff --git a/src/PHYEX/ext/modeln.f90 b/src/PHYEX/ext/modeln.f90
new file mode 100644
index 0000000000000000000000000000000000000000..b5ab334898edb2435108ee39274f9f58f0bd6ee0
--- /dev/null
+++ b/src/PHYEX/ext/modeln.f90
@@ -0,0 +1,2414 @@
+!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.
+!-----------------------------------------------------------------
+! ###################
+ MODULE MODI_MODEL_n
+! ###################
+!
+INTERFACE
+!
+ SUBROUTINE MODEL_n( KTCOUNT, TPBAKFILE, TPDTMODELN, OEXIT )
+!
+USE MODD_IO, ONLY: TFILEDATA
+USE MODD_TYPE_DATE, ONLY: DATE_TIME
+!
+INTEGER, INTENT(IN) :: KTCOUNT ! Temporal loop index of model KMODEL
+TYPE(TFILEDATA), POINTER, INTENT(OUT) :: TPBAKFILE ! Pointer for backup file
+TYPE(DATE_TIME), INTENT(OUT) :: TPDTMODELN ! Time of current model computation
+LOGICAL, INTENT(INOUT) :: OEXIT ! Switch for the end of the temporal loop
+!
+END SUBROUTINE MODEL_n
+!
+END INTERFACE
+!
+END MODULE MODI_MODEL_n
+
+! ###################################
+ SUBROUTINE MODEL_n( KTCOUNT, TPBAKFILE, TPDTMODELN, OEXIT )
+! ###################################
+!
+!!**** *MODEL_n * -monitor of the model version _n
+!!
+!! PURPOSE
+!! -------
+! The purpose of this routine is to build up a typical model version
+! by sequentially calling the specialized routines.
+!
+!!** METHOD
+!! ------
+!! Some preliminary initializations are performed in the first section.
+!! Then, specialized routines are called to update the guess of the future
+!! instant XRxxS of the variable xx by adding the effects of all the
+!! different sources of evolution.
+!!
+!! (guess of xx at t+dt) * Rhod_ref * Jacobian
+!! XRxxS = -------------------------------------------
+!! 2 dt
+!!
+!! At this level, the informations are transferred with a USE association
+!! from the INIT step, where the modules have been previously filled. The
+!! transfer to the subroutines computing each source term is performed by
+!! argument in order to avoid repeated compilations of these subroutines.
+!! This monitor model_n, must therefore be duplicated for each model,
+!! model1 corresponds in this case to the outermost model, model2 is used
+!! for the first level of gridnesting,....
+!! The effect of all parameterizations is computed in PHYS_PARAM_n, which
+!! is itself a monitor. This is due to a possible large number of
+!! parameterizations, which can be activated and therefore, will require a
+!! very large list of arguments. To circumvent this problem, we transfer by
+!! a USE association, the necessary informations in this monitor, which will
+!! dispatch the pertinent information to every parametrization.
+!! Some elaborated diagnostics, LES tools, budget storages are also called
+!! at this level because they require informations about the fields at every
+!! timestep.
+!!
+!!
+!! EXTERNAL
+!! --------
+!! Subroutine IO_File_open: to open a file
+!! Subroutine WRITE_DESFM: to write the descriptive part of a FMfile
+!! Subroutine WRITE_LFIFM: to write the binary part of a FMfile
+!! Subroutine SET_MASK : to compute all the masks selected for budget
+!! computations
+!! Subroutine BOUNDARIES : set the fields at the marginal points in every
+!! directions according the selected boundary conditions
+!! Subroutine INITIAL_GUESS: initializes the guess of the future instant
+!! Subroutine LES_FLX_SPECTRA: computes the resolved fluxes and the
+!! spectra of some quantities when running in LES mode.
+!! Subroutine ADVECTION: computes the advection terms.
+!! Subroutine DYN_SOURCES: computes the curvature, Coriolis, gravity terms.
+!! Subroutine NUM_DIFF: applies the fourth order numerical diffusion.
+!! Subroutine RELAXATION: performs the relaxation to Larger Scale fields
+!! in the upper levels and outermost vertical planes
+!! Subroutine PHYS_PARAM_n : computes the parameterized physical terms
+!! Subroutine RAD_BOUND: prepares the velocity normal components for the bc.
+!! Subroutine RESOLVED_CLOUD : computes the sources terms for water in any
+!! form
+!! Subroutine PRESSURE : computes the pressure gradient term and the
+!! absolute pressure
+!! Subroutine EXCHANGE : updates the halo of each subdomains
+!! Subroutine ENDSTEP : advances in time the fields.
+!! Subroutines UVW_LS_COUPLING and SCALAR_LS_COUPLING:
+!! compute the large scale fields, used to
+!! couple Model_n with outer informations.
+!! Subroutine ENDSTEP_BUDGET: writes the budget informations.
+!! Subroutine IO_File_close: closes a file
+!! Subroutine DATETIME_CORRECTDATE: transform the current time in GMT
+!! Subroutine FORCING : computes forcing terms
+!! Subroutine ADD3DFIELD_ll : add a field to 3D-list
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! MODD_DYN
+!! MODD_CONF
+!! MODD_NESTING
+!! MODD_BUDGET
+!! MODD_PARAMETERS
+!! MODD_CONF_n
+!! MODD_CURVCOR_n
+!! MODD_DYN_n
+!! MODD_DIM_n
+!! MODD_ADV_n
+!! MODD_FIELD_n
+!! MODD_LSFIELD_n
+!! MODD_GRID_n
+!! MODD_METRICS_n
+!! MODD_LBC_n
+!! MODD_PARAM_n
+!! MODD_REF_n
+!! MODD_LUNIT_n
+!! MODD_OUT_n
+!! MODD_TIME_n
+!! MODD_TURB_n
+!! MODD_CLOUDPAR_n
+!! MODD_TIME
+!!
+!! REFERENCE
+!! ---------
+!!
+!! AUTHOR
+!! ------
+!! J.-P. Pinty * LA *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 15/09/94
+!! Modification 20/10/94 (J.Stein) for the outputs and abs_layers routines
+!! Modification 10/11/94 (J.Stein) change ABS_LAYER_FIELDS call
+!! Modification 16/11/94 (J.Stein) add call to the renormalization
+!! Modification 17/11/94 (J.-P. Lafore and J.-P. Pinty) call NUM_DIFF
+!! Modification 08/12/94 (J.Stein) cleaning + remove (RENORM + ABS_LAYER..
+!! ..) + add RELAXATION + LS fiels in the arguments
+!! Modification 19/12/94 (J.Stein) switch for the num diff
+!! Modification 22/12/94 (J.Stein) update tdtcur + change dyn_source call
+!! Modification 05/01/95 (J.Stein) add the parameterization monitor
+!! Modification 09/01/95 (J.Stein) add the 1D switch
+!! Modification 10/01/95 (J.Stein) displace the TDTCUR computation
+!! Modification 03/01/95 (J.-P. Lafore) Absolute pressure diagnosis
+!! Modification Jan 19, 1995 (J. Cuxart) Shunt the DYN_SOURCES in 1D cases.
+!! Modification Jan 24, 1995 (J. Stein) Interchange Boundaries and
+!! Initial_guess to correct a bug in 2D configuration
+!! Modification Feb 02, 1995 (I.Mallet) update BOUNDARIES and RAD_BOUND
+!! calls
+!! Modification Mar 10, 1995 (I.Mallet) add call to SET_COUPLING
+!! March,21, 1995 (J. Stein) remove R from the historical var.
+!! March,26, 1995 (J. Stein) add the EPS variable
+!! April 18, 1995 (J. Cuxart) add the LES call
+!! Sept 20,1995 (Lafore) coupling for the dry mass Md
+!! Nov 2,1995 (Stein) displace the temporal counter increase
+!! Jan 2,1996 (Stein) rm the test on the temporal counter
+!! Modification Feb 5,1996 (J. Vila) implementation new advection
+!! schemes for scalars
+!! Modification Feb 20,1996 (J.Stein) doctor norm
+!! Dec95 - Jul96 (Georgelin, Pinty, Mari, Suhre) FORCING
+!! June 17,1996 (Vincent, Lafore, Jabouille)
+!! statistics of computing time
+!! Aug 8, 1996 (K. Suhre) add chemistry
+!! October 12, 1996 (J. Stein) save the PSRC value
+!! Sept 05,1996 (V.Masson) print of loop index for debugging
+!! purposes
+!! July 22,1996 (Lafore) improve write of computing time statistics
+!! July 29,1996 (Lafore) nesting introduction
+!! Aug. 1,1996 (Lafore) synchronization between models
+!! Sept. 4,1996 (Lafore) modification of call to routine SET_COUPLING
+!! now split in 2 routines
+!! (UVW_LS_COUPLING and SCALAR_LS_COUPLING)
+!! Sept 5,1996 (V.Masson) print of loop index for debugging
+!! purposes
+!! Sept 25,1996 (V.Masson) test for coupling performed here
+!! Oct. 29,1996 (Lafore) one-way nesting implementation
+!! Oct. 12,1996 (J. Stein) save the PSRC value
+!! Dec. 12,1996 (Lafore) change call to RAD_BOUND
+!! Dec. 21,1996 (Lafore) two-way nesting implementation
+!! Mar. 12,1997 (Lafore) introduction of "surfacic" LS fields
+!! Nov 18, 1996 (J.-P. Pinty) FORCING revisited (translation)
+!! Dec 04, 1996 (J.-P. Pinty) include mixed-phase clouds
+!! Dec 20, 1996 (J.-P. Pinty) update the budgets
+!! Dec 23, 1996 (J.-P. Pinty) add the diachronic file control
+!! Jan 11, 1997 (J.-P. Pinty) add the deep convection control
+!! Dec 20,1996 (V.Masson) call boundaries before the writing
+!! Fev 25, 1997 (P.Jabouille) modify the LES tools
+!! April 3,1997 (Lafore) merging of the nesting
+!! developments on MASTER3
+!! Jul. 8,1997 (Lafore) print control for nesting (NVERB>=7)
+!! Jul. 28,1997 (Masson) supress LSTEADY_DMASS
+!! Aug. 19,1997 (Lafore) full Clark's formulation introduction
+!! Sept 26,1997 (Lafore) LS source calculation at restart
+!! (temporarily test to have LS at instant t)
+!! Jan. 28,1998 (Bechtold) add SST forcing
+!! fev. 10,1998 (Lafore) RHODJ computation and storage for budget
+!! Jul. 10,1998 (Stein ) sequentiel loop for nesting
+!! Apr. 07,1999 (Stein ) cleaning of the nesting subroutines
+!! oct. 20,1998 (Jabouille) //
+!! oct. 20,2000 (J.-P. Pinty) add the C2R2 scheme
+!! fev. 01,2001 (D.Gazen) add module MODD_NSV for NSV variables
+!! mar, 4,2002 (V.Ducrocq) call to temporal series
+!! mar, 8, 2001 (V. Masson) advection of perturbation of theta in neutral cases.
+!! Nov, 6, 2002 (V. Masson) time counters for budgets & LES
+!! mars 20,2001 (Pinty) add ICE4 and C3R5 options
+!! jan. 2004 (Masson) surface externalization
+!! sept 2004 (M. Tomasini) Cloud mixing length modification
+!! june 2005 (P. Tulet) add aerosols / dusts
+!! Jul. 2005 (N. Asencio) two_way and phys_param calls:
+!! Add the surface parameters : precipitating
+!! hydrometeors, Short and Long Wave , MASKkids array
+!! Fev. 2006 (M. Leriche) add aqueous phase chemistry
+!! april 2006 (T.Maric) Add halo related to 4th order advection scheme
+!! May 2006 Remove KEPS
+!! Oct 2008 (C.Lac) FIT for variables advected with PPM
+!! July 2009 : Displacement of surface diagnostics call to be
+!! coherent with surface diagnostics obtained with DIAG
+!! 10/11/2009 (P. Aumond) Add mean moments
+!! Nov, 12, 2009 (C. Barthe) add cloud electrification and lightning flashes
+!! July 2010 (M. Leriche) add ice phase chemical species
+!! April 2011 (C.Lac) : Remove instant M
+!! April 2011 (C.Lac, V.Masson) : Time splitting for advection
+!! J.Escobar 21/03/2013: for HALOK comment all NHALO=1 test
+!! P. Tulet Nov 2014 accumulated moles of aqueous species that fall at the surface
+!! Dec 2014 (C.Lac) : For reproducibility START/RESTA
+!! J.Escobar 20/04/2015: missing UPDATE_HALO before UPDATE_HALO2
+!! July, 2015 (O.Nuissier/F.Duffourg) Add microphysics diagnostic for
+!! aircraft, ballon and profiler
+!! C.Lac 11/09/2015: correction of the budget due to FIT temporal scheme
+!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
+!! Sep 2015 (S. Bielli) : Remove YDADFILE from argument call
+! of write_phys_param
+!! J.Escobar : 19/04/2016 : Pb IOZ/NETCDF , missing OPARALLELIO=.FALSE. for PGD files
+!! M.Mazoyer : 04/2016 DTHRAD used for radiative cooling when LACTIT
+!!! Modification 01/2016 (JP Pinty) Add LIMA
+!! 06/2016 (G.Delautier) phasage surfex 8
+!! M.Leriche : 03/2016 Move computation of accumulated chem. in rain to ch_monitor
+!! 09/2016 Add filter on negative values on AERDEP SV before relaxation
+!! 10/2016 (C.Lac) _ Correction on the flag for Strang splitting
+!! to insure reproducibility between START and RESTA
+!! _ Add OSPLIT_WENO
+!! _ Add droplet deposition
+!! 10/2016 (M.Mazoyer) New KHKO output fields
+!! P.Wautelet : 11/07/2016 : removed MNH_NCWRIT define
+!! 09/2017 Q.Rodier add LTEND_UV_FRC
+!! 10/2017 (C.Lac) Necessity to have chemistry processes as
+!! the las process modifying XRSVS
+!! 01/2018 (G.Delautier) SURFEX 8.1
+!! 03/2018 (P.Wautelet) replace ADD_FORECAST_TO_DATE by DATETIME_CORRECTDATE
+!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+!! 07/2017 (V. Vionnet) : Add blowing snow scheme
+!! S. Riette : 11/2016 Add ZPABST to keep pressure constant during timestep
+!! 01/2018 (C.Lac) Add VISCOSITY
+!! Philippe Wautelet: 21/01/2019: add LIO_ALLOW_NO_BACKUP and LIO_NO_WRITE to modd_io_ll
+! to allow to disable writes (for bench purposes)
+! P. Wautelet 07/02/2019: remove OPARALLELIO argument from open and close files subroutines
+! (nsubfiles_ioz is now determined in IO_File_add2list)
+!! 02/2019 C.Lac add rain fraction as an output field
+!! Bielli S. 02/2019 Sea salt : significant sea wave height influences salt emission; 5 salt modes
+! P. Wautelet 28/03/2019: use MNHTIME for time measurement variables
+! P. Wautelet 28/03/2019: use TFILE instead of unit number for set_iluout_timing
+! P. Wautelet 19/04/2019: removed unused dummy arguments and variables
+! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
+! P. Wautelet 20/05/2019: add name argument to ADDnFIELD_ll + new ADD4DFIELD_ll subroutine
+! J. Escobar 09/07/2019: norme Doctor -> Rename Module Type variable TZ -> T
+! J. Escobar 09/07/2019: for bug in management of XLSZWSM variable, add/use specific 2D TLSFIELD2D_ll pointer
+! P. Wautelet 13/09/2019: budget: simplify and modernize date/time management
+! J. Escobar 27/09/2019: add missing report timing of RESOLVED_ELEC
+! P. Wautelet 02-03/2020: use the new data structures and subroutines for budgets
+! P. Wautelet 12/10/2020: Write_les_n: remove HLES_AVG dummy argument and group all 4 calls
+! F. Auguste 01/02/2021: add IBM
+! 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)
+! 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)
+!!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_2D_FRC
+USE MODD_ADV_n
+USE MODD_AIRCRAFT_BALLOON
+USE MODD_ARGSLIST_ll, ONLY : LIST_ll
+USE MODD_BAKOUT
+USE MODD_BIKHARDT_n
+USE MODD_BLANK_n
+USE MODD_BLOWSNOW
+USE MODD_BLOWSNOW_n
+use modd_budget, only: cbutype, lbu_ru, lbu_rv, lbu_rw, lbudget_u, lbudget_v, lbudget_w, lbudget_sv, lbu_enable, &
+ NBUDGET_U, NBUDGET_V, NBUDGET_W, NBUDGET_SV1, nbumod, nbutime, &
+ tbudgets, tbuconf, tburhodj, &
+ xtime_bu, xtime_bu_process
+USE MODD_CH_AERO_n, ONLY: XSOLORG, XMI
+USE MODD_CH_MNHC_n, ONLY: LUSECHEM,LCH_CONV_LINOX,LUSECHAQ,LUSECHIC, &
+ LCH_INIT_FIELD
+USE MODD_CLOUD_MF_n
+USE MODD_CLOUDPAR_n
+USE MODD_CONF
+USE MODD_CONF_n
+USE MODD_CST, ONLY: CST
+USE MODD_CURVCOR_n
+USE MODD_DEEP_CONVECTION_n
+USE MODD_DIM_n
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+USE MODD_DRAG_n
+USE MODD_DUST, ONLY: LDUST
+USE MODD_DYN
+USE MODD_DYN_n
+USE MODD_DYNZD
+USE MODD_DYNZD_n
+USE MODD_ELEC_DESCR
+USE MODD_EOL_MAIN
+USE MODD_FIELD_n
+USE MODD_FRC
+USE MODD_FRC_n
+USE MODD_GET_n
+USE MODD_GRID, ONLY: XLONORI,XLATORI
+USE MODD_GRID_n
+USE MODD_IBM_PARAM_n, ONLY: CIBM_ADV, LIBM, LIBM_TROUBLE, XIBM_LS
+USE MODD_ICE_C1R3_DESCR, ONLY: XRTMIN_C1R3=>XRTMIN
+USE MODD_IO, ONLY: LIO_NO_WRITE, TFILEDATA, TFILE_SURFEX, TFILE_DUMMY
+USE MODD_LBC_n
+USE MODD_LES
+USE MODD_LES_BUDGET
+USE MODD_LIMA_PRECIP_SCAVENGING_n
+USE MODD_LSFIELD_n
+USE MODD_LUNIT, ONLY: TOUTDATAFILE
+USE MODD_LUNIT_n, ONLY: TDIAFILE,TINIFILE,TINIFILEPGD,TLUOUT
+USE MODD_MEAN_FIELD
+USE MODD_MEAN_FIELD_n
+USE MODD_METRICS_n
+USE MODD_MNH_SURFEX_n
+USE MODD_NESTING
+USE MODD_NSV
+USE MODD_NUDGING_n
+USE MODD_OUT_n
+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, ONLY: LWARM,LSEDIC,LCONVHG,LDEPOSC
+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_MFSHALL_n
+USE MODD_PARAM_n
+USE MODD_PAST_FIELD_n
+USE MODD_PRECIP_n
+use modd_precision, only: MNHTIME
+USE MODD_PROFILER_n
+USE MODD_RADIATIONS_n, ONLY: XTSRAD,XSCAFLASWD,XDIRFLASWD,XDIRSRFSWD, XAER, XDTHRAD
+USE MODD_RAIN_ICE_DESCR, ONLY: XRTMIN
+USE MODD_RECYCL_PARAM_n, ONLY: LRECYCL
+USE MODD_REF, ONLY: LCOUPLES
+USE MODD_REF_n
+USE MODD_SALT, ONLY: LSALT
+USE MODD_SERIES, ONLY: LSERIES
+USE MODD_SERIES_n, ONLY: NFREQSERIES
+USE MODD_STATION_n
+USE MODD_SUB_MODEL_n
+USE MODD_TIME
+USE MODD_TIME_n
+USE MODD_TIMEZ
+USE MODD_TURB_CLOUD, ONLY: NMODEL_CLOUD,CTURBLEN_CLOUD,XCEI
+USE MODD_TURB_n
+USE MODD_TYPE_DATE, ONLY: DATE_TIME
+USE MODD_VISCOSITY
+!
+USE MODE_AIRCRAFT_BALLOON
+use mode_budget, only: Budget_store_init, Budget_store_end
+USE MODE_DATETIME
+USE MODE_ELEC_ll
+USE MODE_GRIDCART
+USE MODE_GRIDPROJ
+USE MODE_IO_FIELD_WRITE, only: IO_Field_user_write, IO_Fieldlist_write, IO_Header_write
+USE MODE_IO_FILE, only: IO_File_close, IO_File_open
+USE MODE_IO_MANAGE_STRUCT, only: IO_File_add2list
+USE MODE_ll
+#ifdef MNH_IOLFI
+use mode_menu_diachro, only: MENU_DIACHRO
+#endif
+USE MODE_MNH_TIMING
+USE MODE_MODELN_HANDLER
+USE MODE_MPPDB
+USE MODE_MSG
+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 MODI_ADDFLUCTUATIONS
+USE MODI_ADVECTION_METSV
+USE MODI_ADVECTION_UVW
+USE MODI_ADVECTION_UVW_CEN
+USE MODI_ADV_FORCING_n
+USE MODI_AER_MONITOR_n
+USE MODI_BLOWSNOW
+USE MODI_BOUNDARIES
+USE MODI_BUDGET_FLAGS
+USE MODI_CART_COMPRESS
+USE MODI_CH_MONITOR_n
+USE MODI_DIAG_SURF_ATM_N
+USE MODI_DYN_SOURCES
+USE MODI_END_DIAG_IN_RUN
+USE MODI_ENDSTEP
+USE MODI_ENDSTEP_BUDGET
+USE MODI_EXCHANGE
+USE MODI_FORCING
+USE MODI_FORC_SQUALL_LINE
+USE MODI_FORC_WIND
+USE MODI_GET_HALO
+USE MODI_GRAVITY_IMPL
+USE MODI_IBM_INIT
+USE MODI_IBM_FORCING
+USE MODI_IBM_FORCING_TR
+USE MODI_IBM_FORCING_ADV
+USE MODI_INI_DIAG_IN_RUN
+USE MODI_INI_LG
+USE MODI_INI_MEAN_FIELD
+USE MODI_INITIAL_GUESS
+USE MODI_LES_INI_TIMESTEP_n
+USE MODI_LES_N
+USE MODI_LIMA_PRECIP_SCAVENGING
+USE MODI_LS_COUPLING
+USE MODI_MASK_COMPRESS
+USE MODI_MEAN_FIELD
+USE MODI_MNHGET_SURF_PARAM_n
+USE MODI_MNHWRITE_ZS_DUMMY_n
+USE MODI_NUDGING
+USE MODI_NUM_DIFF
+USE MODI_PHYS_PARAM_n
+USE MODI_PRESSUREZ
+USE MODI_PROFILER_n
+USE MODI_RAD_BOUND
+USE MODI_RECYCLING
+USE MODI_RELAX2FW_ION
+USE MODI_RELAXATION
+USE MODI_REL_FORCING_n
+USE MODI_RESOLVED_CLOUD
+USE MODI_RESOLVED_ELEC_n
+USE MODI_SERIES_N
+USE MODI_SETLB_LG
+USE MODI_SET_MASK
+USE MODI_SHUMAN
+USE MODI_SPAWN_LS_n
+USE MODI_STATION_n
+USE MODI_TURB_CLOUD_INDEX
+USE MODI_TWO_WAY
+USE MODI_UPDATE_NSV
+USE MODI_VISCOSITY
+USE MODI_WRITE_DESFM_n
+USE MODI_WRITE_DIAG_SURF_ATM_N
+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
+!
+!
+!
+INTEGER, INTENT(IN) :: KTCOUNT ! Temporal loop index of model KMODEL
+TYPE(TFILEDATA), POINTER, INTENT(OUT) :: TPBAKFILE ! Pointer for backup file
+TYPE(DATE_TIME), INTENT(OUT) :: TPDTMODELN ! Time of current model computation
+LOGICAL, INTENT(INOUT) :: OEXIT ! Switch for the end of the temporal loop
+!
+!* 0.2 declarations of local variables
+!
+INTEGER :: ILUOUT ! Logical unit number for the output listing
+INTEGER :: IIU,IJU,IKU ! array size in first, second and third dimensions
+INTEGER :: IIB,IIE,IJB,IJE ! index values for the physical subdomain
+INTEGER :: JSV,JRR ! Loop index for scalar and moist variables
+INTEGER :: INBVAR ! number of HALO2_lls to allocate
+INTEGER :: IINFO_ll ! return code of parallel routine
+INTEGER :: IVERB ! LFI verbosity level
+LOGICAL :: GSTEADY_DMASS ! conditional call to mass computation
+!
+ ! for computing time analysis
+REAL(kind=MNHTIME), DIMENSION(2) :: ZTIME, ZTIME1, ZTIME2, ZEND, ZTOT, ZALL, ZTOT_PT, ZBLAZETOT
+REAL(kind=MNHTIME), DIMENSION(2) :: ZTIME_STEP,ZTIME_STEP_PTS
+CHARACTER :: YMI
+INTEGER :: IPOINTS
+CHARACTER(len=16) :: YTCOUNT,YPOINTS
+CHARACTER(LEN=:), ALLOCATABLE :: YDADNAME
+!
+INTEGER :: ISYNCHRO ! model synchronic index relative to its father
+ ! = 1 for the first time step in phase with DAD
+ ! = 0 for the last time step (out of phase)
+INTEGER :: IMI ! Current model index
+REAL, DIMENSION(:,:),ALLOCATABLE :: ZSEA
+REAL, DIMENSION(:,:),ALLOCATABLE :: ZTOWN
+! Dummy pointers needed to correct an ifort Bug
+REAL, DIMENSION(:), POINTER :: DPTR_XZHAT
+REAL, DIMENSION(:), POINTER :: DPTR_XBMX1,DPTR_XBMX2,DPTR_XBMX3,DPTR_XBMX4
+REAL, DIMENSION(:), POINTER :: DPTR_XBMY1,DPTR_XBMY2,DPTR_XBMY3,DPTR_XBMY4
+REAL, DIMENSION(:), POINTER :: DPTR_XBFX1,DPTR_XBFX2,DPTR_XBFX3,DPTR_XBFX4
+REAL, DIMENSION(:), POINTER :: DPTR_XBFY1,DPTR_XBFY2,DPTR_XBFY3,DPTR_XBFY4
+CHARACTER(LEN=4), DIMENSION(:), POINTER :: DPTR_CLBCX,DPTR_CLBCY
+INTEGER, DIMENSION(:,:,:), POINTER :: DPTR_NKLIN_LBXU,DPTR_NKLIN_LBYU,DPTR_NKLIN_LBXV,DPTR_NKLIN_LBYV
+INTEGER, DIMENSION(:,:,:), POINTER :: DPTR_NKLIN_LBXW,DPTR_NKLIN_LBYW,DPTR_NKLIN_LBXM,DPTR_NKLIN_LBYM
+REAL, DIMENSION(:,:,:), POINTER :: DPTR_XCOEFLIN_LBXU,DPTR_XCOEFLIN_LBYU
+REAL, DIMENSION(:,:,:), POINTER :: DPTR_XCOEFLIN_LBXV,DPTR_XCOEFLIN_LBYV
+REAL, DIMENSION(:,:,:), POINTER :: DPTR_XCOEFLIN_LBXW,DPTR_XCOEFLIN_LBYW
+REAL, DIMENSION(:,:,:), POINTER :: DPTR_XCOEFLIN_LBXM,DPTR_XCOEFLIN_LBYM
+REAL, DIMENSION(:,:,:), POINTER :: DPTR_XLBXUM,DPTR_XLBYUM,DPTR_XLBXVM,DPTR_XLBYVM
+REAL, DIMENSION(:,:,:), POINTER :: DPTR_XLBXWM,DPTR_XLBYWM,DPTR_XLBXTHM,DPTR_XLBYTHM
+REAL, DIMENSION(:,:,:), POINTER :: DPTR_XLBXTKEM,DPTR_XLBYTKEM
+REAL, DIMENSION(:,:,:,:), POINTER :: DPTR_XLBXSVM,DPTR_XLBYSVM
+REAL, DIMENSION(:,:,:,:), POINTER :: DPTR_XLBXRM,DPTR_XLBYRM
+REAL, DIMENSION(:,:,:), POINTER :: DPTR_XZZ
+REAL, DIMENSION(:,:,:), POINTER :: DPTR_XLSUM,DPTR_XLSVM,DPTR_XLSWM,DPTR_XLSTHM,DPTR_XLSRVM
+REAL, DIMENSION(:,:,:), POINTER :: DPTR_XLSUS,DPTR_XLSVS,DPTR_XLSWS,DPTR_XLSTHS,DPTR_XLSRVS
+REAL, DIMENSION(:,:), POINTER :: DPTR_XLSZWSM,DPTR_XLSZWSS
+REAL, DIMENSION(:,:,:), POINTER :: DPTR_XLBXUS,DPTR_XLBYUS,DPTR_XLBXVS,DPTR_XLBYVS
+REAL, DIMENSION(:,:,:), POINTER :: DPTR_XLBXWS,DPTR_XLBYWS,DPTR_XLBXTHS,DPTR_XLBYTHS
+REAL, DIMENSION(:,:,:), POINTER :: DPTR_XLBXTKES,DPTR_XLBYTKES
+REAL, DIMENSION(:,:,:,:), POINTER :: DPTR_XLBXRS,DPTR_XLBYRS,DPTR_XLBXSVS,DPTR_XLBYSVS
+!
+REAL, DIMENSION(:,:,:), POINTER :: DPTR_XRHODJ,DPTR_XUM,DPTR_XVM,DPTR_XWM,DPTR_XTHM
+REAL, DIMENSION(:,:,:), POINTER :: DPTR_XTKEM,DPTR_XRUS,DPTR_XRVS,DPTR_XRWS,DPTR_XRTHS
+REAL, DIMENSION(:,:,:), POINTER :: DPTR_XRTKES,DPTR_XDIRFLASWD,DPTR_XSCAFLASWD,DPTR_XDIRSRFSWD
+REAL, DIMENSION(:,:,:,:), POINTER :: DPTR_XRM,DPTR_XSVM,DPTR_XRRS,DPTR_XRSVS
+REAL, DIMENSION(:,:), POINTER :: DPTR_XINPRC,DPTR_XINPRR,DPTR_XINPRS,DPTR_XINPRG
+REAL, DIMENSION(:,:), POINTER :: DPTR_XINPRH,DPTR_XPRCONV,DPTR_XPRSCONV
+LOGICAL, DIMENSION(:,:),POINTER :: DPTR_GMASKkids
+!
+REAL, DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)) :: ZSPEEDC
+REAL, DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)) :: ZSPEEDR
+REAL, DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)) :: ZSPEEDS
+REAL, DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)) :: ZSPEEDG
+REAL, DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)) :: ZSPEEDH
+REAL, DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)) :: ZINPRC3D
+REAL, DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)) :: ZINPRS3D
+REAL, DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)) :: ZINPRG3D
+REAL, DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)) :: ZINPRH3D
+!
+LOGICAL :: KWARM
+LOGICAL :: KRAIN
+LOGICAL :: KSEDC
+LOGICAL :: KACTIT
+LOGICAL :: KSEDI
+LOGICAL :: KHHONI
+!
+REAL, DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)) :: ZRUS,ZRVS,ZRWS
+REAL, DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)) :: ZPABST !To give pressure at t
+ ! (and not t+1) to resolved_cloud
+REAL, DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)) :: ZJ
+!
+TYPE(LIST_ll), POINTER :: TZFIELDC_ll ! list of fields to exchange
+TYPE(HALO2LIST_ll), POINTER :: TZHALO2C_ll ! list of fields to exchange
+LOGICAL :: GCLD ! conditionnal call for dust wet deposition
+LOGICAL :: GCLOUD_ONLY ! conditionnal radiation computations for
+ ! the only cloudy columns
+REAL, DIMENSION(SIZE(XRSVS,1), SIZE(XRSVS,2), SIZE(XRSVS,3), NSV_AER) :: ZWETDEPAER
+!
+TYPE(TFILEDATA),POINTER :: TZOUTFILE
+! TYPE(TFILEDATA),SAVE :: TZDIACFILE
+TYPE(DIMPHYEX_t) :: YLDIMPHYEX
+!-------------------------------------------------------------------------------
+!
+TPBAKFILE=> NULL()
+TZOUTFILE=> NULL()
+!
+TPDTMODELN = TDTCUR
+!
+!* 0. MICROPHYSICAL SCHEME
+! -------------------
+SELECT CASE(CCLOUD)
+CASE('C2R2','KHKO','C3R5')
+ KWARM = .TRUE.
+ KRAIN = NRAIN
+ KSEDC = NSEDC
+ KACTIT = NACTIT
+!
+ KSEDI = NSEDI
+ KHHONI = NHHONI
+CASE('LIMA')
+ KRAIN = NMOM_R.GE.1
+ KWARM = NMOM_C.GE.1
+ KSEDC = MSEDC
+ KACTIT = MACTIT
+!
+ KSEDI = MSEDI
+ KHHONI = MHHONI
+CASE('ICE3','ICE4') !default values
+ KWARM = LWARM
+ KRAIN = .TRUE.
+ KSEDC = .TRUE.
+ KACTIT = .FALSE.
+!
+ KSEDI = .TRUE.
+ KHHONI = .FALSE.
+END SELECT
+!
+!
+!* 1 PRELIMINARY
+! ------------
+IMI = GET_CURRENT_MODEL_INDEX()
+!
+!* 1.0 update NSV_* variables for current model
+! ----------------------------------------
+!
+CALL UPDATE_NSV(IMI)
+!
+!* 1.1 RECOVER THE LOGICAL UNIT NUMBER FOR THE OUTPUT PRINTS
+!
+ILUOUT = TLUOUT%NLU
+!
+!* 1.2 SET ARRAY SIZE
+!
+CALL GET_DIM_EXT_ll('B',IIU,IJU)
+IKU=NKMAX+2*JPVEXT
+CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
+!
+IF (IMI==1) THEN
+ GSTEADY_DMASS=LSTEADYLS
+ELSE
+ GSTEADY_DMASS=.FALSE.
+END IF
+!
+!* 1.3 OPEN THE DIACHRONIC FILE
+!
+IF (KTCOUNT == 1) THEN
+!
+ NULLIFY(TFIELDS_ll,TLSFIELD_ll,TFIELDT_ll)
+ NULLIFY(TLSFIELD2D_ll)
+ NULLIFY(THALO2T_ll)
+ NULLIFY(TLSHALO2_ll)
+ NULLIFY(TFIELDSC_ll)
+!
+ ALLOCATE(XWT_ACT_NUC(SIZE(XWT,1),SIZE(XWT,2),SIZE(XWT,3)))
+ ALLOCATE(GMASKkids(SIZE(XWT,1),SIZE(XWT,2)))
+!
+ IF ( .NOT. LIO_NO_WRITE ) THEN
+ CALL IO_File_open(TDIAFILE)
+!
+ CALL IO_Header_write(TDIAFILE)
+ CALL WRITE_DESFM_n(IMI,TDIAFILE)
+ CALL WRITE_LFIFMN_FORDIACHRO_n(TDIAFILE)
+ END IF
+!
+!* 1.4 Initialization of the list of fields for the halo updates
+!
+! a) Sources terms
+!
+ CALL ADD3DFIELD_ll( TFIELDS_ll, XRUS, 'MODEL_n::XRUS' )
+ CALL ADD3DFIELD_ll( TFIELDS_ll, XRVS, 'MODEL_n::XRVS' )
+ CALL ADD3DFIELD_ll( TFIELDS_ll, XRWS, 'MODEL_n::XRWS' )
+ CALL ADD3DFIELD_ll( TFIELDS_ll, XRTHS, 'MODEL_n::XRTHS' )
+ CALL ADD3DFIELD_ll( TFIELDS_ll, XRUS_PRES, 'MODEL_n::XRUS_PRES' )
+ CALL ADD3DFIELD_ll( TFIELDS_ll, XRVS_PRES, 'MODEL_n::XRVS_PRES' )
+ CALL ADD3DFIELD_ll( TFIELDS_ll, XRWS_PRES, 'MODEL_n::XRWS_PRES' )
+ CALL ADD3DFIELD_ll( TFIELDS_ll, XRTHS_CLD, 'MODEL_n::XRTHS_CLD' )
+ IF (SIZE(XRTKES,1) /= 0) CALL ADD3DFIELD_ll( TFIELDS_ll, XRTKES, 'MODEL_n::XRTKES' )
+ CALL ADD4DFIELD_ll( TFIELDS_ll, XRRS (:,:,:,1:NRR), 'MODEL_n::XRRS' )
+ CALL ADD4DFIELD_ll( TFIELDS_ll, XRRS_CLD (:,:,:,1:NRR), 'MODEL_n::XRRS_CLD' )
+ CALL ADD4DFIELD_ll( TFIELDS_ll, XRSVS (:,:,:,1:NSV), 'MODEL_n::XRSVS')
+ CALL ADD4DFIELD_ll( TFIELDS_ll, XRSVS_CLD(:,:,:,1:NSV), 'MODEL_n::XRSVS_CLD')
+ IF (SIZE(XSRCT,1) /= 0) CALL ADD3DFIELD_ll( TFIELDS_ll, XSRCT, 'MODEL_n::XSRCT' )
+ ! Fire model parallel setup
+ IF (LBLAZE) THEN
+ CALL ADD3DFIELD_ll( TFIELDS_ll, XLSPHI, 'MODEL_n::XLSPHI')
+ CALL ADD3DFIELD_ll( TFIELDS_ll, XBMAP, 'MODEL_n::XBMAP')
+ CALL ADD3DFIELD_ll( TFIELDS_ll, XFMRFA, 'MODEL_n::XFMRFA')
+ CALL ADD3DFIELD_ll( TFIELDS_ll, XFMWF0, 'MODEL_n::XFMWF0')
+ CALL ADD3DFIELD_ll( TFIELDS_ll, XFMR0, 'MODEL_n::XFMR0')
+ CALL ADD3DFIELD_ll( TFIELDS_ll, XFMR00, 'MODEL_n::XFMR00')
+ CALL ADD3DFIELD_ll( TFIELDS_ll, XFMIGNITION, 'MODEL_n::XFMIGNITION')
+ CALL ADD3DFIELD_ll( TFIELDS_ll, XFMFUELTYPE, 'MODEL_n::XFMFUELTYPE')
+ CALL ADD3DFIELD_ll( TFIELDS_ll, XFIRETAU, 'MODEL_n::XFIRETAU')
+ CALL ADD4DFIELD_ll( TFIELDS_ll, XFLUXPARAMH(:,:,:,1:SIZE(XFLUXPARAMH,4)), 'MODEL_n::XFLUXPARAMH')
+ CALL ADD4DFIELD_ll( TFIELDS_ll, XFLUXPARAMW(:,:,:,1:SIZE(XFLUXPARAMW,4)), 'MODEL_n::XFLUXPARAMW')
+ CALL ADD3DFIELD_ll( TFIELDS_ll, XFIRERW, 'MODEL_n::XFIRERW')
+ CALL ADD3DFIELD_ll( TFIELDS_ll, XFMASE, 'MODEL_n::XFMASE')
+ CALL ADD3DFIELD_ll( TFIELDS_ll, XFMAWC, 'MODEL_n::XFMAWC')
+ CALL ADD3DFIELD_ll( TFIELDS_ll, XFMWALKIG, 'MODEL_n::XFMWALKIG')
+ CALL ADD3DFIELD_ll( TFIELDS_ll, XFMFLUXHDH, 'MODEL_n::XFMFLUXHDH')
+ CALL ADD3DFIELD_ll( TFIELDS_ll, XFMFLUXHDW, 'MODEL_n::XFMFLUXHDW')
+ CALL ADD3DFIELD_ll( TFIELDS_ll, XFMHWS, 'MODEL_n::XFMHWS')
+ CALL ADD3DFIELD_ll( TFIELDS_ll, XFMWINDU, 'MODEL_n::XFMWINDU')
+ CALL ADD3DFIELD_ll( TFIELDS_ll, XFMWINDV, 'MODEL_n::XFMWINDV')
+ CALL ADD3DFIELD_ll( TFIELDS_ll, XFMWINDW, 'MODEL_n::XFMWINDW')
+ CALL ADD3DFIELD_ll( TFIELDS_ll, XFMGRADOROX, 'MODEL_n::XFMGRADOROX')
+ CALL ADD3DFIELD_ll( TFIELDS_ll, XFMGRADOROY, 'MODEL_n::XFMGRADOROY')
+ END IF
+ !
+ IF ((LNUMDIFU .OR. LNUMDIFTH .OR. LNUMDIFSV) ) THEN
+ !
+ ! b) LS fields
+ !
+ CALL ADD3DFIELD_ll( TLSFIELD_ll, XLSUM, 'MODEL_n::XLSUM' )
+ CALL ADD3DFIELD_ll( TLSFIELD_ll, XLSVM, 'MODEL_n::XLSVM' )
+ CALL ADD3DFIELD_ll( TLSFIELD_ll, XLSWM, 'MODEL_n::XLSWM' )
+ CALL ADD3DFIELD_ll( TLSFIELD_ll, XLSTHM, 'MODEL_n::XLSTHM' )
+ CALL ADD2DFIELD_ll( TLSFIELD2D_ll, XLSZWSM, 'MODEL_n::XLSZWSM' )
+ IF (NRR >= 1) THEN
+ CALL ADD3DFIELD_ll( TLSFIELD_ll, XLSRVM, 'MODEL_n::XLSRVM' )
+ ENDIF
+ !
+ ! c) Fields at t
+ !
+ CALL ADD3DFIELD_ll( TFIELDT_ll, XUT, 'MODEL_n::XUT' )
+ CALL ADD3DFIELD_ll( TFIELDT_ll, XVT, 'MODEL_n::XVT' )
+ CALL ADD3DFIELD_ll( TFIELDT_ll, XWT, 'MODEL_n::XWT' )
+ CALL ADD3DFIELD_ll( TFIELDT_ll, XTHT, 'MODEL_n::XTHT' )
+ IF (SIZE(XRTKES,1) /= 0) CALL ADD3DFIELD_ll( TFIELDT_ll, XTKET, 'MODEL_n::XTKET' )
+ CALL ADD4DFIELD_ll(TFIELDT_ll, XRT (:,:,:,1:NRR), 'MODEL_n::XSV' )
+ CALL ADD4DFIELD_ll(TFIELDT_ll, XSVT(:,:,:,1:NSV), 'MODEL_n::XSVT' )
+ !
+ !* 1.5 Initialize the list of fields for the halo updates (2nd layer)
+ !
+ INBVAR = 4+NRR+NSV
+ IF (SIZE(XRTKES,1) /= 0) INBVAR=INBVAR+1
+ CALL INIT_HALO2_ll(THALO2T_ll,INBVAR,IIU,IJU,IKU)
+ CALL INIT_HALO2_ll(TLSHALO2_ll,4+MIN(1,NRR),IIU,IJU,IKU)
+ !
+ !* 1.6 Initialise the 2nd layer of the halo of the LS fields
+ !
+ IF ( LSTEADYLS ) THEN
+ CALL UPDATE_HALO_ll(TLSFIELD_ll, IINFO_ll)
+ CALL UPDATE_HALO_ll(TLSFIELD2D_ll,IINFO_ll)
+ CALL UPDATE_HALO2_ll(TLSFIELD_ll, TLSHALO2_ll, IINFO_ll)
+ END IF
+ END IF
+ !
+!
+ !
+ XT_START = 0.0_MNHTIME
+ !
+ XT_STORE = 0.0_MNHTIME
+ XT_BOUND = 0.0_MNHTIME
+ XT_GUESS = 0.0_MNHTIME
+ XT_FORCING = 0.0_MNHTIME
+ XT_NUDGING = 0.0_MNHTIME
+ XT_ADV = 0.0_MNHTIME
+ XT_ADVUVW = 0.0_MNHTIME
+ XT_GRAV = 0.0_MNHTIME
+ XT_SOURCES = 0.0_MNHTIME
+ !
+ XT_DIFF = 0.0_MNHTIME
+ XT_RELAX = 0.0_MNHTIME
+ XT_PARAM = 0.0_MNHTIME
+ XT_SPECTRA = 0.0_MNHTIME
+ XT_HALO = 0.0_MNHTIME
+ XT_VISC = 0.0_MNHTIME
+ XT_RAD_BOUND = 0.0_MNHTIME
+ XT_PRESS = 0.0_MNHTIME
+ !
+ XT_CLOUD = 0.0_MNHTIME
+ XT_STEP_SWA = 0.0_MNHTIME
+ XT_STEP_MISC = 0.0_MNHTIME
+ XT_COUPL = 0.0_MNHTIME
+ XT_1WAY = 0.0_MNHTIME
+ XT_STEP_BUD = 0.0_MNHTIME
+ !
+ XT_RAD = 0.0_MNHTIME
+ XT_DCONV = 0.0_MNHTIME
+ XT_GROUND = 0.0_MNHTIME
+ XT_TURB = 0.0_MNHTIME
+ XT_MAFL = 0.0_MNHTIME
+ XT_DRAG = 0.0_MNHTIME
+ XT_EOL = 0.0_MNHTIME
+ XT_TRACER = 0.0_MNHTIME
+ XT_SHADOWS = 0.0_MNHTIME
+ XT_ELEC = 0.0_MNHTIME
+ XT_CHEM = 0.0_MNHTIME
+ XT_2WAY = 0.0_MNHTIME
+ !
+ XT_IBM_FORC = 0.0_MNHTIME
+ ! Blaze fire model
+ XFIREPERF = 0.0_MNHTIME
+ !
+END IF
+!
+!* 1.7 Allocation of arrays for observation diagnostics
+!
+CALL INI_DIAG_IN_RUN(IIU,IJU,IKU,LFLYER,LSTATION,LPROFILER)
+!
+!
+CALL SECOND_MNH2(ZEND)
+!
+!-------------------------------------------------------------------------------
+!
+!* 2. ONE-WAY NESTING AND LARGE SCALE FIELD REFRESH
+! ---------------------------------------------
+!
+!
+CALL SECOND_MNH2(ZTIME1)
+!
+ISYNCHRO = MODULO (KTCOUNT, NDTRATIO(IMI) ) ! test of synchronisation
+!
+!
+IF (LCOUPLES.AND.LOCEAN) THEN
+ CALL NHOA_COUPL_n(NDAD(IMI),XTSTEP,IMI,KTCOUNT,IKU)
+END IF
+! No Gridnest in coupled OA LES for now
+IF (.NOT. LCOUPLES .AND. IMI/=1 .AND. NDAD(IMI)/=IMI .AND. (ISYNCHRO==1 .OR. NDTRATIO(IMI) == 1) ) THEN
+!
+! Use dummy pointers to correct an ifort BUG
+ DPTR_XBMX1=>XBMX1
+ DPTR_XBMX2=>XBMX2
+ DPTR_XBMX3=>XBMX3
+ DPTR_XBMX4=>XBMX4
+ DPTR_XBMY1=>XBMY1
+ DPTR_XBMY2=>XBMY2
+ DPTR_XBMY3=>XBMY3
+ DPTR_XBMY4=>XBMY4
+ DPTR_XBFX1=>XBFX1
+ DPTR_XBFX2=>XBFX2
+ DPTR_XBFX3=>XBFX3
+ DPTR_XBFX4=>XBFX4
+ DPTR_XBFY1=>XBFY1
+ DPTR_XBFY2=>XBFY2
+ DPTR_XBFY3=>XBFY3
+ DPTR_XBFY4=>XBFY4
+ DPTR_CLBCX=>CLBCX
+ DPTR_CLBCY=>CLBCY
+ !
+ DPTR_XZZ=>XZZ
+ DPTR_XZHAT=>XZHAT
+ DPTR_XCOEFLIN_LBXM=>XCOEFLIN_LBXM
+ DPTR_XLSTHM=>XLSTHM
+ DPTR_XLSRVM=>XLSRVM
+ DPTR_XLSUM=>XLSUM
+ DPTR_XLSVM=>XLSVM
+ DPTR_XLSWM=>XLSWM
+ DPTR_XLSZWSM=>XLSZWSM
+ DPTR_XLSTHS=>XLSTHS
+ DPTR_XLSRVS=>XLSRVS
+ DPTR_XLSUS=>XLSUS
+ DPTR_XLSVS=>XLSVS
+ DPTR_XLSWS=>XLSWS
+ DPTR_XLSZWSS=>XLSZWSS
+ !
+ IF ( LSTEADYLS ) THEN
+ NCPL_CUR=0
+ ELSE
+ IF (NCPL_CUR/=1) THEN
+ IF ( KTCOUNT+1 == NCPL_TIMES(NCPL_CUR-1,IMI) ) THEN
+ !
+ ! LS sources are interpolated from the LS field
+ ! values of model DAD(IMI)
+ CALL SPAWN_LS_n(NDAD(IMI),XTSTEP,IMI, &
+ DPTR_XBMX1,DPTR_XBMX2,DPTR_XBMX3,DPTR_XBMX4,DPTR_XBMY1,DPTR_XBMY2,DPTR_XBMY3,DPTR_XBMY4, &
+ DPTR_XBFX1,DPTR_XBFX2,DPTR_XBFX3,DPTR_XBFX4,DPTR_XBFY1,DPTR_XBFY2,DPTR_XBFY3,DPTR_XBFY4, &
+ NDXRATIO_ALL(IMI),NDYRATIO_ALL(IMI), &
+ DPTR_CLBCX,DPTR_CLBCY,DPTR_XZZ,DPTR_XZHAT,LSLEVE,XLEN1,XLEN2,DPTR_XCOEFLIN_LBXM, &
+ DPTR_XLSTHM,DPTR_XLSRVM,DPTR_XLSUM,DPTR_XLSVM,DPTR_XLSWM,DPTR_XLSZWSM, &
+ DPTR_XLSTHS,DPTR_XLSRVS,DPTR_XLSUS,DPTR_XLSVS,DPTR_XLSWS, DPTR_XLSZWSS )
+ END IF
+ END IF
+ !
+ END IF
+ !
+ DPTR_NKLIN_LBXU=>NKLIN_LBXU
+ DPTR_XCOEFLIN_LBXU=>XCOEFLIN_LBXU
+ DPTR_NKLIN_LBYU=>NKLIN_LBYU
+ DPTR_XCOEFLIN_LBYU=>XCOEFLIN_LBYU
+ DPTR_NKLIN_LBXV=>NKLIN_LBXV
+ DPTR_XCOEFLIN_LBXV=>XCOEFLIN_LBXV
+ DPTR_NKLIN_LBYV=>NKLIN_LBYV
+ DPTR_XCOEFLIN_LBYV=>XCOEFLIN_LBYV
+ DPTR_NKLIN_LBXW=>NKLIN_LBXW
+ DPTR_XCOEFLIN_LBXW=>XCOEFLIN_LBXW
+ DPTR_NKLIN_LBYW=>NKLIN_LBYW
+ DPTR_XCOEFLIN_LBYW=>XCOEFLIN_LBYW
+ !
+ DPTR_NKLIN_LBXM=>NKLIN_LBXM
+ DPTR_XCOEFLIN_LBXM=>XCOEFLIN_LBXM
+ DPTR_NKLIN_LBYM=>NKLIN_LBYM
+ DPTR_XCOEFLIN_LBYM=>XCOEFLIN_LBYM
+ !
+ DPTR_XLBXUM=>XLBXUM
+ DPTR_XLBYUM=>XLBYUM
+ DPTR_XLBXVM=>XLBXVM
+ DPTR_XLBYVM=>XLBYVM
+ DPTR_XLBXWM=>XLBXWM
+ DPTR_XLBYWM=>XLBYWM
+ DPTR_XLBXTHM=>XLBXTHM
+ DPTR_XLBYTHM=>XLBYTHM
+ DPTR_XLBXTKEM=>XLBXTKEM
+ DPTR_XLBYTKEM=>XLBYTKEM
+ DPTR_XLBXRM=>XLBXRM
+ DPTR_XLBYRM=>XLBYRM
+ DPTR_XLBXSVM=>XLBXSVM
+ DPTR_XLBYSVM=>XLBYSVM
+ !
+ DPTR_XLBXUS=>XLBXUS
+ DPTR_XLBYUS=>XLBYUS
+ DPTR_XLBXVS=>XLBXVS
+ DPTR_XLBYVS=>XLBYVS
+ DPTR_XLBXWS=>XLBXWS
+ DPTR_XLBYWS=>XLBYWS
+ DPTR_XLBXTHS=>XLBXTHS
+ DPTR_XLBYTHS=>XLBYTHS
+ DPTR_XLBXTKES=>XLBXTKES
+ DPTR_XLBYTKES=>XLBYTKES
+ DPTR_XLBXRS=>XLBXRS
+ DPTR_XLBYRS=>XLBYRS
+ DPTR_XLBXSVS=>XLBXSVS
+ DPTR_XLBYSVS=>XLBYSVS
+ !
+ CALL ONE_WAY_n(NDAD(IMI),XTSTEP,IMI,KTCOUNT, &
+ DPTR_XBMX1,DPTR_XBMX2,DPTR_XBMX3,DPTR_XBMX4,DPTR_XBMY1,DPTR_XBMY2,DPTR_XBMY3,DPTR_XBMY4, &
+ DPTR_XBFX1,DPTR_XBFX2,DPTR_XBFX3,DPTR_XBFX4,DPTR_XBFY1,DPTR_XBFY2,DPTR_XBFY3,DPTR_XBFY4, &
+ NDXRATIO_ALL(IMI),NDYRATIO_ALL(IMI),NDTRATIO(IMI), &
+ DPTR_CLBCX,DPTR_CLBCY,NRIMX,NRIMY, &
+ DPTR_NKLIN_LBXU,DPTR_XCOEFLIN_LBXU,DPTR_NKLIN_LBYU,DPTR_XCOEFLIN_LBYU, &
+ DPTR_NKLIN_LBXV,DPTR_XCOEFLIN_LBXV,DPTR_NKLIN_LBYV,DPTR_XCOEFLIN_LBYV, &
+ DPTR_NKLIN_LBXW,DPTR_XCOEFLIN_LBXW,DPTR_NKLIN_LBYW,DPTR_XCOEFLIN_LBYW, &
+ DPTR_NKLIN_LBXM,DPTR_XCOEFLIN_LBXM,DPTR_NKLIN_LBYM,DPTR_XCOEFLIN_LBYM, &
+ GSTEADY_DMASS,CCLOUD,LUSECHAQ,LUSECHIC, &
+ DPTR_XLBXUM,DPTR_XLBYUM,DPTR_XLBXVM,DPTR_XLBYVM,DPTR_XLBXWM,DPTR_XLBYWM, &
+ DPTR_XLBXTHM,DPTR_XLBYTHM, &
+ DPTR_XLBXTKEM,DPTR_XLBYTKEM, &
+ DPTR_XLBXRM,DPTR_XLBYRM,DPTR_XLBXSVM,DPTR_XLBYSVM, &
+ XDRYMASST,XDRYMASSS, &
+ DPTR_XLBXUS,DPTR_XLBYUS,DPTR_XLBXVS,DPTR_XLBYVS,DPTR_XLBXWS,DPTR_XLBYWS, &
+ DPTR_XLBXTHS,DPTR_XLBYTHS, &
+ DPTR_XLBXTKES,DPTR_XLBYTKES, &
+ DPTR_XLBXRS,DPTR_XLBYRS,DPTR_XLBXSVS,DPTR_XLBYSVS )
+ !
+END IF
+!
+CALL SECOND_MNH2(ZTIME2)
+XT_1WAY = XT_1WAY + ZTIME2 - ZTIME1
+!
+!* 2.1 RECYCLING TURBULENCE
+! ----
+IF (CTURB /= 'NONE' .AND. LRECYCL) THEN
+ CALL RECYCLING(XFLUCTUNW,XFLUCTVNN,XFLUCTUTN,XFLUCTVTW,XFLUCTWTW,XFLUCTWTN, &
+ XFLUCTUNE,XFLUCTVNS,XFLUCTUTS,XFLUCTVTE,XFLUCTWTE,XFLUCTWTS, &
+ KTCOUNT)
+ENDIF
+!
+!* 2.2 IBM
+! ----
+!
+IF (LIBM .AND. KTCOUNT==1) THEN
+ !
+ IF (.NOT.LCARTESIAN) THEN
+ CALL PRINT_MSG(NVERB_FATAL, 'GEN', 'MODELN', 'IBM can only be used in combination with cartesian coordinates')
+ ENDIF
+ !
+ CALL IBM_INIT(XIBM_LS)
+ !
+ENDIF
+!
+!-------------------------------------------------------------------------------
+!
+!* 3. LATERAL BOUNDARY CONDITIONS EXCEPT FOR NORMAL VELOCITY
+! ------------------------------------------------------
+!
+ZTIME1=ZTIME2
+!
+!* 3.1 Set the lagragian variables values at the LB
+!
+IF( LLG .AND. IMI==1 ) CALL SETLB_LG
+!
+IF (CCONF == "START" .OR. (CCONF == "RESTA" .AND. KTCOUNT /= 1 )) THEN
+CALL MPPDB_CHECK3DM("before BOUNDARIES:XUT, XVT, XWT, XTHT, XTKET",PRECISION,&
+ & XUT, XVT, XWT, XTHT, XTKET)
+CALL BOUNDARIES ( &
+ XTSTEP,CLBCX,CLBCY,NRR,NSV,KTCOUNT, &
+ XLBXUM,XLBXVM,XLBXWM,XLBXTHM,XLBXTKEM,XLBXRM,XLBXSVM, &
+ XLBYUM,XLBYVM,XLBYWM,XLBYTHM,XLBYTKEM,XLBYRM,XLBYSVM, &
+ XLBXUS,XLBXVS,XLBXWS,XLBXTHS,XLBXTKES,XLBXRS,XLBXSVS, &
+ XLBYUS,XLBYVS,XLBYWS,XLBYTHS,XLBYTKES,XLBYRS,XLBYSVS, &
+ XRHODJ,XRHODREF, &
+ XUT, XVT, XWT, XTHT, XTKET, XRT, XSVT, XSRCT )
+CALL MPPDB_CHECK3DM("after BOUNDARIES:XUT, XVT, XWT, XTHT, XTKET",PRECISION,&
+ & XUT, XVT, XWT, XTHT, XTKET)
+END IF
+!
+CALL SECOND_MNH2(ZTIME2)
+!
+XT_BOUND = XT_BOUND + ZTIME2 - ZTIME1
+!
+!
+! For START/RESTART MPPDB_CHECK use
+!IF ( (IMI==1) .AND. (CCONF == "START") .AND. (KTCOUNT == 2) ) THEN
+! CALL MPPDB_START_DEBUG()
+!ENDIF
+!IF ( (IMI==1) .AND. (CCONF == "RESTA") .AND. (KTCOUNT == 1) ) THEN
+! CALL MPPDB_START_DEBUG()
+!ENDIF
+!-------------------------------------------------------------------------------
+!* initializes surface number
+IF (CSURF=='EXTE') CALL GOTO_SURFEX(IMI)
+!-------------------------------------------------------------------------------
+!
+!* 4. STORAGE IN A SYNCHRONOUS FILE
+! -----------------------------
+!
+ZTIME1 = ZTIME2
+!
+IF ( nfile_backup_current < NBAK_NUMB ) THEN
+ IF ( KTCOUNT == TBACKUPN(nfile_backup_current + 1)%NSTEP ) THEN
+ nfile_backup_current = nfile_backup_current + 1
+ !
+ TPBAKFILE => TBACKUPN(nfile_backup_current)%TFILE
+ IVERB = TPBAKFILE%NLFIVERB
+ !
+ CALL IO_File_open(TPBAKFILE)
+ !
+ CALL WRITE_DESFM_n(IMI,TPBAKFILE)
+ CALL IO_Header_write( TBACKUPN(nfile_backup_current)%TFILE )
+ IF ( ASSOCIATED( TBACKUPN(nfile_backup_current)%TFILE%TDADFILE ) ) THEN
+ YDADNAME = TBACKUPN(nfile_backup_current)%TFILE%TDADFILE%CNAME
+ ELSE
+ ! Set a dummy name for the dad file. Its non-zero size will allow the writing of some data in the backup file
+ YDADNAME = 'DUMMY'
+ END IF
+ CALL WRITE_LFIFM_n( TBACKUPN(nfile_backup_current)%TFILE, TRIM( YDADNAME ) )
+ TOUTDATAFILE => TPBAKFILE
+ CALL MNHWRITE_ZS_DUMMY_n(TPBAKFILE)
+ IF (CSURF=='EXTE') THEN
+ TFILE_SURFEX => TPBAKFILE
+ CALL GOTO_SURFEX(IMI)
+ CALL WRITE_SURF_ATM_n(YSURF_CUR,'MESONH','ALL',.FALSE.)
+ IF ( KTCOUNT > 1) THEN
+ CALL DIAG_SURF_ATM_n(YSURF_CUR,'MESONH')
+ CALL WRITE_DIAG_SURF_ATM_n(YSURF_CUR,'MESONH','ALL')
+ END IF
+ NULLIFY(TFILE_SURFEX)
+ END IF
+ !
+ ! Reinitialize Lagragian variables at every model backup
+ IF (LLG .AND. LINIT_LG .AND. CINIT_LG=='FMOUT') THEN
+ CALL INI_LG( XXHATM, XYHATM, XZZ, XSVT, XLBXSVM, XLBYSVM )
+ IF (IVERB>=5) THEN
+ WRITE(UNIT=ILUOUT,FMT=*) '************************************'
+ WRITE(UNIT=ILUOUT,FMT=*) '*** Lagrangian variables refreshed after ',TRIM(TPBAKFILE%CNAME),' backup'
+ WRITE(UNIT=ILUOUT,FMT=*) '************************************'
+ END IF
+ END IF
+ ! Reinitialise mean variables
+ IF (LMEAN_FIELD) THEN
+ CALL INI_MEAN_FIELD
+ END IF
+!
+ ELSE
+ !Necessary to have a 'valid' CNAME when calling some subroutines
+ TPBAKFILE => TFILE_DUMMY
+ END IF
+ELSE
+ !Necessary to have a 'valid' CNAME when calling some subroutines
+ TPBAKFILE => TFILE_DUMMY
+END IF
+!
+IF ( nfile_output_current < NOUT_NUMB ) THEN
+ IF ( KTCOUNT == TOUTPUTN(nfile_output_current + 1)%NSTEP ) THEN
+ nfile_output_current = nfile_output_current + 1
+ !
+ TZOUTFILE => TOUTPUTN(nfile_output_current)%TFILE
+ !
+ CALL IO_File_open(TZOUTFILE)
+ !
+ CALL IO_Header_write(TZOUTFILE)
+ CALL IO_Fieldlist_write( TOUTPUTN(nfile_output_current) )
+ CALL IO_Field_user_write( TOUTPUTN(nfile_output_current) )
+ !
+ CALL IO_File_close(TZOUTFILE)
+ !
+ END IF
+END IF
+!
+CALL SECOND_MNH2(ZTIME2)
+!
+XT_STORE = XT_STORE + ZTIME2 - ZTIME1
+!
+!-------------------------------------------------------------------------------
+!
+!* 4.BIS IBM and Fluctuations application
+! -----------------------------
+!
+!* 4.B1 Add fluctuations at the domain boundaries
+!
+IF (LRECYCL) THEN
+ CALL ADDFLUCTUATIONS ( &
+ CLBCX,CLBCY, &
+ XUT, XVT, XWT, XTHT, XTKET, XRT, XSVT, XSRCT, &
+ XFLUCTUTN,XFLUCTVTW,XFLUCTUTS,XFLUCTVTE, &
+ XFLUCTWTW,XFLUCTWTN,XFLUCTWTS,XFLUCTWTE )
+ENDIF
+!
+!* 4.B2 Immersed boundaries
+!
+IF (LIBM) THEN
+ !
+ ZTIME1=ZTIME2
+ !
+ IF (.NOT.LCARTESIAN) THEN
+ CALL PRINT_MSG(NVERB_FATAL, 'GEN', 'MODELN', 'IBM can only be used in combination with cartesian coordinates')
+ ENDIF
+ !
+ CALL IBM_FORCING(XUT,XVT,XWT,XTHT,XRT,XSVT,XTKET)
+ !
+ IF (LIBM_TROUBLE) THEN
+ CALL IBM_FORCING_TR(XUT,XVT,XWT,XTHT,XRT,XSVT,XTKET)
+ ENDIF
+ !
+ CALL SECOND_MNH2(ZTIME2)
+ !
+ XT_IBM_FORC = XT_IBM_FORC + ZTIME2 - ZTIME1
+ !
+ENDIF
+!-------------------------------------------------------------------------------
+!
+!* 5. INITIALIZATION OF THE BUDGET VARIABLES
+! --------------------------------------
+!
+IF (NBUMOD==IMI) THEN
+ LBU_ENABLE = CBUTYPE /='NONE'.AND. CBUTYPE /='SKIP'
+ELSE
+ LBU_ENABLE = .FALSE.
+END IF
+!
+IF (NBUMOD==IMI .AND. CBUTYPE=='MASK' ) THEN
+ CALL SET_MASK()
+ if ( lbu_ru ) then
+ tbudgets(NBUDGET_U)%trhodj%xdata(:, nbutime, :) = tbudgets(NBUDGET_U)%trhodj%xdata(:, nbutime, :) &
+ + Mask_compress( Mxm( xrhodj(:, :, :) ) )
+ end if
+ if ( lbu_rv ) then
+ tbudgets(NBUDGET_V)%trhodj%xdata(:, nbutime, :) = tbudgets(NBUDGET_V)%trhodj%xdata(:, nbutime, :) &
+ + Mask_compress( Mym( xrhodj(:, :, :) ) )
+ end if
+ if ( lbu_rw ) then
+ tbudgets(NBUDGET_W)%trhodj%xdata(:, nbutime, :) = tbudgets(NBUDGET_W)%trhodj%xdata(:, nbutime, :) &
+ + Mask_compress( Mzm( xrhodj(:, :, :) ) )
+ end if
+ if ( associated( tburhodj ) ) tburhodj%xdata(:, nbutime, :) = tburhodj%xdata(:, nbutime, :) + Mask_compress( xrhodj(:, :, :) )
+END IF
+!
+IF (NBUMOD==IMI .AND. CBUTYPE=='CART' ) THEN
+ if ( lbu_ru ) then
+ tbudgets(NBUDGET_U)%trhodj%xdata(:, :, :) = tbudgets(NBUDGET_U)%trhodj%xdata(:, :, :) + Cart_compress( Mxm( xrhodj(:, :, :) ) )
+ end if
+ if ( lbu_rv ) then
+ tbudgets(NBUDGET_V)%trhodj%xdata(:, :, :) = tbudgets(NBUDGET_V)%trhodj%xdata(:, :, :) + Cart_compress( Mym( xrhodj(:, :, :) ) )
+ end if
+ if ( lbu_rw ) then
+ tbudgets(NBUDGET_W)%trhodj%xdata(:, :, :) = tbudgets(NBUDGET_W)%trhodj%xdata(:, :, :) &
+ + Cart_compress( Mzm( xrhodj(:, :, :) ) )
+ end if
+ if ( associated( tburhodj ) ) tburhodj%xdata(:, :, :) = tburhodj%xdata(:, :, :) + Cart_compress( xrhodj(:, :, :) )
+END IF
+!
+CALL BUDGET_FLAGS(LUSERV, LUSERC, LUSERR, &
+ LUSERI, LUSERS, LUSERG, LUSERH )
+!
+XTIME_BU = 0.0
+!
+!-------------------------------------------------------------------------------
+!
+!* 6. INITIALIZATION OF THE FIELD TENDENCIES
+! --------------------------------------
+!
+ZTIME1 = ZTIME2
+XTIME_BU_PROCESS = 0.
+!
+CALL INITIAL_GUESS ( NRR, NSV, KTCOUNT, XRHODJ,IMI, XTSTEP, &
+ XRUS, XRVS, XRWS, XRTHS, XRRS, XRTKES, XRSVS, &
+ XUT, XVT, XWT, XTHT, XRT, XTKET, XSVT )
+!
+CALL SECOND_MNH2(ZTIME2)
+!
+XT_GUESS = XT_GUESS + ZTIME2 - ZTIME1 - XTIME_BU_PROCESS
+!
+!-------------------------------------------------------------------------------
+!
+!* 7. INITIALIZATION OF THE LES FOR CURRENT TIME-STEP
+! -----------------------------------------------
+!
+XTIME_LES_BU = 0.0
+XTIME_LES = 0.0
+IF (LLES) CALL LES_INI_TIMESTEP_n(KTCOUNT)
+!
+!-------------------------------------------------------------------------------
+!
+!* 8. TWO-WAY INTERACTIVE GRID-NESTING
+! --------------------------------
+!
+!
+CALL SECOND_MNH2(ZTIME1)
+XTIME_BU_PROCESS = 0.
+XTIME_LES_BU_PROCESS = 0.
+!
+GMASKkids(:,:)=.FALSE.
+!
+IF (NMODEL>1) THEN
+ ! correct an ifort bug
+ DPTR_XRHODJ=>XRHODJ
+ DPTR_XUM=>XUT
+ DPTR_XVM=>XVT
+ DPTR_XWM=>XWT
+ DPTR_XTHM=>XTHT
+ DPTR_XRM=>XRT
+ DPTR_XTKEM=>XTKET
+ DPTR_XSVM=>XSVT
+ DPTR_XRUS=>XRUS
+ DPTR_XRVS=>XRVS
+ DPTR_XRWS=>XRWS
+ DPTR_XRTHS=>XRTHS
+ DPTR_XRRS=>XRRS
+ DPTR_XRTKES=>XRTKES
+ DPTR_XRSVS=>XRSVS
+ DPTR_XINPRC=>XINPRC
+ DPTR_XINPRR=>XINPRR
+ DPTR_XINPRS=>XINPRS
+ DPTR_XINPRG=>XINPRG
+ DPTR_XINPRH=>XINPRH
+ DPTR_XPRCONV=>XPRCONV
+ DPTR_XPRSCONV=>XPRSCONV
+ DPTR_XDIRFLASWD=>XDIRFLASWD
+ DPTR_XSCAFLASWD=>XSCAFLASWD
+ DPTR_XDIRSRFSWD=>XDIRSRFSWD
+ DPTR_GMASKkids=>GMASKkids
+ !
+ CALL TWO_WAY( NRR,NSV,KTCOUNT,DPTR_XRHODJ,IMI,XTSTEP, &
+ DPTR_XUM ,DPTR_XVM ,DPTR_XWM , DPTR_XTHM, DPTR_XRM,DPTR_XSVM, &
+ DPTR_XRUS,DPTR_XRVS,DPTR_XRWS,DPTR_XRTHS,DPTR_XRRS,DPTR_XRSVS, &
+ DPTR_XINPRC,DPTR_XINPRR,DPTR_XINPRS,DPTR_XINPRG,DPTR_XINPRH,DPTR_XPRCONV,DPTR_XPRSCONV, &
+ DPTR_XDIRFLASWD,DPTR_XSCAFLASWD,DPTR_XDIRSRFSWD,DPTR_GMASKkids )
+END IF
+!
+CALL SECOND_MNH2(ZTIME2)
+XT_2WAY = XT_2WAY + ZTIME2 - ZTIME1 - XTIME_LES_BU_PROCESS - XTIME_BU_PROCESS
+!
+!-------------------------------------------------------------------------------
+!-------------------------------------------------------------------------------
+!
+!* 10. FORCING
+! -------
+!
+!
+ZTIME1 = ZTIME2
+XTIME_BU_PROCESS = 0.
+XTIME_LES_BU_PROCESS = 0.
+IF (LCARTESIAN) THEN
+ CALL SM_GRIDCART(XXHAT,XYHAT,XZHAT,XZS,LSLEVE,XLEN1,XLEN2,XZSMT,XDXHAT,XDYHAT,XZZ,ZJ)
+ XMAP=1.
+ELSE
+ CALL SM_GRIDPROJ( XXHAT, XYHAT, XZHAT, XXHATM, XYHATM, XZS, &
+ LSLEVE, XLEN1, XLEN2, XZSMT, XLATORI, XLONORI, &
+ XMAP, XLAT, XLON, XDXHAT, XDYHAT, XZZ, ZJ )
+END IF
+!
+IF ( LFORCING ) THEN
+ CALL FORCING(XTSTEP,LUSERV,XRHODJ,XCORIOZ,XZHAT,XZZ,TDTCUR,&
+ XUFRC_PAST, XVFRC_PAST,XWTFRC, &
+ XUT,XVT,XWT,XTHT,XTKET,XRT,XSVT, &
+ XRUS,XRVS,XRWS,XRTHS,XRTKES,XRRS,XRSVS,IMI,ZJ)
+END IF
+!
+IF ( L2D_ADV_FRC ) THEN
+ CALL ADV_FORCING_n(XRHODJ,TDTCUR,XTHT,XRT,XZZ,XRTHS,XRRS)
+END IF
+IF ( L2D_REL_FRC ) THEN
+ CALL REL_FORCING_n(XRHODJ,TDTCUR,XTHT,XRT,XZZ,XRTHS,XRRS)
+END IF
+!
+CALL SECOND_MNH2(ZTIME2)
+!
+XT_FORCING = XT_FORCING + ZTIME2 - ZTIME1 &
+ - XTIME_LES_BU_PROCESS - XTIME_BU_PROCESS
+!
+!-------------------------------------------------------------------------------
+!
+!* 11. NUDGING
+! -------
+!
+!
+ZTIME1 = ZTIME2
+XTIME_BU_PROCESS = 0.
+XTIME_LES_BU_PROCESS = 0.
+!
+IF ( LNUDGING ) THEN
+ CALL NUDGING(LUSERV,XRHODJ,XTNUDGING, &
+ XUT,XVT,XWT,XTHT,XRT, &
+ XLSUM,XLSVM,XLSWM,XLSTHM,XLSRVM, &
+ XRUS,XRVS,XRWS,XRTHS,XRRS)
+
+END IF
+!
+CALL SECOND_MNH2(ZTIME2)
+!
+XT_NUDGING = XT_NUDGING + ZTIME2 - ZTIME1 &
+ - XTIME_LES_BU_PROCESS - XTIME_BU_PROCESS
+!
+!-------------------------------------------------------------------------------
+!
+!* 12. DYNAMICAL SOURCES
+! -----------------
+!
+ZTIME1 = ZTIME2
+XTIME_BU_PROCESS = 0.
+XTIME_LES_BU_PROCESS = 0.
+!
+IF( LTRANS ) THEN
+ XUT(:,:,:) = XUT(:,:,:) + XUTRANS
+ XVT(:,:,:) = XVT(:,:,:) + XVTRANS
+END IF
+!
+CALL DYN_SOURCES( NRR,NRRL, NRRI, &
+ XUT, XVT, XWT, XTHT, XRT, &
+ XCORIOX, XCORIOY, XCORIOZ, XCURVX, XCURVY, &
+ XRHODJ, XZZ, XTHVREF, XEXNREF, &
+ XRUS, XRVS, XRWS, XRTHS )
+!
+IF( LTRANS ) THEN
+ XUT(:,:,:) = XUT(:,:,:) - XUTRANS
+ XVT(:,:,:) = XVT(:,:,:) - XVTRANS
+END IF
+!
+CALL SECOND_MNH2(ZTIME2)
+!
+XT_SOURCES = XT_SOURCES + ZTIME2 - ZTIME1 &
+ - XTIME_LES_BU_PROCESS - XTIME_BU_PROCESS
+!
+!-------------------------------------------------------------------------------
+!
+!* 13. NUMERICAL DIFFUSION
+! -------------------
+!
+ZTIME1 = ZTIME2
+XTIME_BU_PROCESS = 0.
+XTIME_LES_BU_PROCESS = 0.
+!
+IF ( LNUMDIFU .OR. LNUMDIFTH .OR. LNUMDIFSV ) THEN
+!
+ CALL UPDATE_HALO_ll(TFIELDT_ll, IINFO_ll)
+ CALL UPDATE_HALO2_ll(TFIELDT_ll, THALO2T_ll, IINFO_ll)
+ IF ( .NOT. LSTEADYLS ) THEN
+ CALL UPDATE_HALO_ll(TLSFIELD_ll, IINFO_ll)
+ CALL UPDATE_HALO_ll(TLSFIELD2D_ll,IINFO_ll)
+ CALL UPDATE_HALO2_ll(TLSFIELD_ll, TLSHALO2_ll, IINFO_ll)
+ END IF
+ CALL NUM_DIFF ( CLBCX, CLBCY, NRR, NSV, &
+ XDK2U, XDK4U, XDK2TH, XDK4TH, XDK2SV, XDK4SV, IMI, &
+ XUT, XVT, XWT, XTHT, XTKET, XRT, XSVT, &
+ XLSUM,XLSVM,XLSWM,XLSTHM,XLSRVM,XRHODJ, &
+ XRUS, XRVS, XRWS, XRTHS, XRTKES, XRRS, XRSVS, &
+ LZDIFFU,LNUMDIFU, LNUMDIFTH, LNUMDIFSV, &
+ THALO2T_ll, TLSHALO2_ll,XZDIFFU_HALO2 )
+END IF
+
+if ( lbudget_sv ) then
+ do jsv = 1, nsv
+ call Budget_store_init( tbudgets(jsv + NBUDGET_SV1 - 1), 'NEGA2', xrsvs(:, :, :, jsv) )
+ end do
+end if
+
+DO JSV = NSV_CHEMBEG,NSV_CHEMEND
+ XRSVS(:,:,:,JSV) = MAX(XRSVS(:,:,:,JSV),0.)
+END DO
+DO JSV = NSV_CHICBEG,NSV_CHICEND
+ XRSVS(:,:,:,JSV) = MAX(XRSVS(:,:,:,JSV),0.)
+END DO
+DO JSV = NSV_AERBEG,NSV_AEREND
+ XRSVS(:,:,:,JSV) = MAX(XRSVS(:,:,:,JSV),0.)
+END DO
+DO JSV = NSV_LNOXBEG,NSV_LNOXEND
+ XRSVS(:,:,:,JSV) = MAX(XRSVS(:,:,:,JSV),0.)
+END DO
+DO JSV = NSV_DSTBEG,NSV_DSTEND
+ XRSVS(:,:,:,JSV) = MAX(XRSVS(:,:,:,JSV),0.)
+END DO
+DO JSV = NSV_SLTBEG,NSV_SLTEND
+ XRSVS(:,:,:,JSV) = MAX(XRSVS(:,:,:,JSV),0.)
+END DO
+DO JSV = NSV_PPBEG,NSV_PPEND
+ XRSVS(:,:,:,JSV) = MAX(XRSVS(:,:,:,JSV),0.)
+END DO
+#ifdef MNH_FOREFIRE
+DO JSV = NSV_FFBEG,NSV_FFEND
+ XRSVS(:,:,:,JSV) = MAX(XRSVS(:,:,:,JSV),0.)
+END DO
+#endif
+! Blaze smoke
+DO JSV = NSV_FIREBEG,NSV_FIREEND
+ XRSVS(:,:,:,JSV) = MAX(XRSVS(:,:,:,JSV),0.)
+END DO
+DO JSV = NSV_CSBEG,NSV_CSEND
+ XRSVS(:,:,:,JSV) = MAX(XRSVS(:,:,:,JSV),0.)
+END DO
+DO JSV = NSV_DSTDEPBEG,NSV_DSTDEPEND
+ XRSVS(:,:,:,JSV) = MAX(XRSVS(:,:,:,JSV),0.)
+END DO
+DO JSV = NSV_SLTDEPBEG,NSV_SLTDEPEND
+ XRSVS(:,:,:,JSV) = MAX(XRSVS(:,:,:,JSV),0.)
+END DO
+DO JSV = NSV_AERDEPBEG,NSV_AERDEPEND
+ XRSVS(:,:,:,JSV) = MAX(XRSVS(:,:,:,JSV),0.)
+END DO
+DO JSV = NSV_SNWBEG,NSV_SNWEND
+ XRSVS(:,:,:,JSV) = MAX(XRSVS(:,:,:,JSV),0.)
+END DO
+IF (CELEC .NE. 'NONE') THEN
+ XRSVS(:,:,:,NSV_ELECBEG) = MAX(XRSVS(:,:,:,NSV_ELECBEG),0.)
+ XRSVS(:,:,:,NSV_ELECEND) = MAX(XRSVS(:,:,:,NSV_ELECEND),0.)
+END IF
+
+if ( lbudget_sv ) then
+ do jsv = 1, nsv
+ call Budget_store_end( tbudgets(jsv + NBUDGET_SV1 - 1), 'NEGA2', xrsvs(:, :, :, jsv) )
+ end do
+end if
+!
+CALL SECOND_MNH2(ZTIME2)
+!
+XT_DIFF = XT_DIFF + ZTIME2 - ZTIME1 &
+ - XTIME_LES_BU_PROCESS - XTIME_BU_PROCESS
+!
+!-------------------------------------------------------------------------------
+!
+!* 14. UPPER AND LATERAL RELAXATION
+! ----------------------------
+!
+ZTIME1 = ZTIME2
+XTIME_BU_PROCESS = 0.
+XTIME_LES_BU_PROCESS = 0.
+!
+IF(LVE_RELAX .OR. LVE_RELAX_GRD .OR. LHORELAX_UVWTH .OR. LHORELAX_RV .OR.&
+ LHORELAX_RC .OR. LHORELAX_RR .OR. LHORELAX_RI .OR. LHORELAX_RS .OR. &
+ LHORELAX_RG .OR. LHORELAX_RH .OR. LHORELAX_TKE .OR. &
+ ANY(LHORELAX_SV)) THEN
+ CALL RELAXATION (LVE_RELAX,LVE_RELAX_GRD,LHORELAX_UVWTH,LHORELAX_RV,LHORELAX_RC, &
+ LHORELAX_RR,LHORELAX_RI,LHORELAX_RS,LHORELAX_RG, &
+ LHORELAX_RH,LHORELAX_TKE,LHORELAX_SV, &
+ LHORELAX_SVC2R2,LHORELAX_SVC1R3, &
+ LHORELAX_SVELEC,LHORELAX_SVLG, &
+ LHORELAX_SVCHEM,LHORELAX_SVCHIC,LHORELAX_SVAER, &
+ LHORELAX_SVDST,LHORELAX_SVSLT,LHORELAX_SVPP, &
+ LHORELAX_SVCS,LHORELAX_SVSNW,LHORELAX_SVFIRE, &
+#ifdef MNH_FOREFIRE
+ LHORELAX_SVFF, &
+#endif
+ KTCOUNT,NRR,NSV,XTSTEP,XRHODJ, &
+ XUT, XVT, XWT, XTHT, XRT, XSVT, XTKET, &
+ XLSUM, XLSVM, XLSWM, XLSTHM, &
+ XLBXUM, XLBXVM, XLBXWM, XLBXTHM, &
+ XLBXRM, XLBXSVM, XLBXTKEM, &
+ XLBYUM, XLBYVM, XLBYWM, XLBYTHM, &
+ XLBYRM, XLBYSVM, XLBYTKEM, &
+ NALBOT, XALK, XALKW, &
+ NALBAS, XALKBAS, XALKWBAS, &
+ LMASK_RELAX,XKURELAX, XKVRELAX, XKWRELAX, &
+ NRIMX,NRIMY, &
+ XRUS, XRVS, XRWS, XRTHS, XRRS, XRSVS, XRTKES )
+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
+!
+CALL SECOND_MNH2(ZTIME2)
+!
+XT_RELAX = XT_RELAX + ZTIME2 - ZTIME1 &
+ - XTIME_LES_BU_PROCESS - XTIME_BU_PROCESS
+!
+!-------------------------------------------------------------------------------
+!
+!* 15. PARAMETRIZATIONS' MONITOR
+! -------------------------
+!
+ZTIME1 = ZTIME2
+!
+CALL PHYS_PARAM_n( KTCOUNT, TPBAKFILE, &
+ XT_RAD, XT_SHADOWS, XT_DCONV, XT_GROUND, &
+ XT_MAFL, XT_DRAG, XT_EOL, XT_TURB, XT_TRACER, &
+ ZTIME, ZWETDEPAER, GMASKkids, GCLOUD_ONLY )
+!
+IF (CDCONV/='NONE') THEN
+ XPACCONV = XPACCONV + XPRCONV * XTSTEP
+ IF (LCH_CONV_LINOX) THEN
+ XIC_TOTAL_NUMBER = XIC_TOTAL_NUMBER + XIC_RATE * XTSTEP
+ XCG_TOTAL_NUMBER = XCG_TOTAL_NUMBER + XCG_RATE * XTSTEP
+ END IF
+END IF
+!
+!
+CALL SECOND_MNH2(ZTIME2)
+!
+XT_PARAM = XT_PARAM + ZTIME2 - ZTIME1 - XTIME_LES - ZTIME
+!
+!-------------------------------------------------------------------------------
+!
+!* 16. TEMPORAL SERIES
+! ---------------
+!
+ZTIME1 = ZTIME2
+!
+IF (LSERIES) THEN
+ IF ( MOD (KTCOUNT-1,NFREQSERIES) == 0 ) CALL SERIES_n
+END IF
+!
+CALL SECOND_MNH2(ZTIME2)
+!
+XT_STEP_MISC = XT_STEP_MISC + ZTIME2 - ZTIME1
+!
+!-------------------------------------------------------------------------------
+!
+!* 17. LARGE SCALE FIELD REFRESH
+! -------------------------
+!
+ZTIME1 = ZTIME2
+!
+IF (.NOT. LSTEADYLS) THEN
+ IF ( IMI==1 .AND. &
+ NCPL_CUR < NCPL_NBR ) THEN
+ IF (KTCOUNT+1 == NCPL_TIMES(NCPL_CUR,1) ) THEN
+ ! The next current time reachs a
+ NCPL_CUR=NCPL_CUR+1 ! coupling one, LS sources are refreshed
+ !
+ CALL LS_COUPLING(XTSTEP,GSTEADY_DMASS,CCONF, &
+ CGETTKET, &
+ CGETRVT,CGETRCT,CGETRRT,CGETRIT, &
+ CGETRST,CGETRGT,CGETRHT,CGETSVT,LCH_INIT_FIELD, NSV, &
+ NIMAX_ll,NJMAX_ll, &
+ NSIZELBX_ll,NSIZELBXU_ll,NSIZELBY_ll,NSIZELBYV_ll, &
+ NSIZELBXTKE_ll,NSIZELBYTKE_ll, &
+ NSIZELBXR_ll,NSIZELBYR_ll,NSIZELBXSV_ll,NSIZELBYSV_ll, &
+ XLSUM,XLSVM,XLSWM,XLSTHM,XLSRVM,XLSZWSM,XDRYMASST, &
+ XLBXUM,XLBXVM,XLBXWM,XLBXTHM,XLBXTKEM,XLBXRM,XLBXSVM, &
+ XLBYUM,XLBYVM,XLBYWM,XLBYTHM,XLBYTKEM,XLBYRM,XLBYSVM, &
+ XLSUS,XLSVS,XLSWS,XLSTHS,XLSRVS,XLSZWSS,XDRYMASSS, &
+ XLBXUS,XLBXVS,XLBXWS,XLBXTHS,XLBXTKES,XLBXRS,XLBXSVS, &
+ XLBYUS,XLBYVS,XLBYWS,XLBYTHS,XLBYTKES,XLBYRS,XLBYSVS )
+ !
+ DO JSV=NSV_CHEMBEG,NSV_CHEMEND
+ XLBXSVS(:,:,:,JSV)=MAX(XLBXSVS(:,:,:,JSV),0.)
+ XLBYSVS(:,:,:,JSV)=MAX(XLBYSVS(:,:,:,JSV),0.)
+ ENDDO
+ !
+ DO JSV=NSV_LNOXBEG,NSV_LNOXEND
+ XLBXSVS(:,:,:,JSV)=MAX(XLBXSVS(:,:,:,JSV),0.)
+ XLBYSVS(:,:,:,JSV)=MAX(XLBYSVS(:,:,:,JSV),0.)
+ ENDDO
+ !
+ DO JSV=NSV_AERBEG,NSV_AEREND
+ XLBXSVS(:,:,:,JSV)=MAX(XLBXSVS(:,:,:,JSV),0.)
+ XLBYSVS(:,:,:,JSV)=MAX(XLBYSVS(:,:,:,JSV),0.)
+ ENDDO
+ !
+ DO JSV=NSV_DSTBEG,NSV_DSTEND
+ XLBXSVS(:,:,:,JSV)=MAX(XLBXSVS(:,:,:,JSV),0.)
+ XLBYSVS(:,:,:,JSV)=MAX(XLBYSVS(:,:,:,JSV),0.)
+ ENDDO
+ !
+ DO JSV=NSV_DSTDEPBEG,NSV_DSTDEPEND
+ XLBXSVS(:,:,:,JSV)=MAX(XLBXSVS(:,:,:,JSV),0.)
+ XLBYSVS(:,:,:,JSV)=MAX(XLBYSVS(:,:,:,JSV),0.)
+ ENDDO
+ !
+ DO JSV=NSV_SLTBEG,NSV_SLTEND
+ XLBXSVS(:,:,:,JSV)=MAX(XLBXSVS(:,:,:,JSV),0.)
+ XLBYSVS(:,:,:,JSV)=MAX(XLBYSVS(:,:,:,JSV),0.)
+ ENDDO
+ !
+ DO JSV=NSV_SLTDEPBEG,NSV_SLTDEPEND
+ XLBXSVS(:,:,:,JSV)=MAX(XLBXSVS(:,:,:,JSV),0.)
+ XLBYSVS(:,:,:,JSV)=MAX(XLBYSVS(:,:,:,JSV),0.)
+ ENDDO
+ !
+ DO JSV=NSV_PPBEG,NSV_PPEND
+ XLBXSVS(:,:,:,JSV)=MAX(XLBXSVS(:,:,:,JSV),0.)
+ XLBYSVS(:,:,:,JSV)=MAX(XLBYSVS(:,:,:,JSV),0.)
+ ENDDO
+ !
+#ifdef MNH_FOREFIRE
+ DO JSV=NSV_FFBEG,NSV_FFEND
+ XLBXSVS(:,:,:,JSV)=MAX(XLBXSVS(:,:,:,JSV),0.)
+ XLBYSVS(:,:,:,JSV)=MAX(XLBYSVS(:,:,:,JSV),0.)
+ ENDDO
+ !
+#endif
+ DO JSV=NSV_FIREBEG,NSV_FIREEND
+ XLBXSVS(:,:,:,JSV)=MAX(XLBXSVS(:,:,:,JSV),0.)
+ XLBYSVS(:,:,:,JSV)=MAX(XLBYSVS(:,:,:,JSV),0.)
+ ENDDO
+ !
+ DO JSV=NSV_CSBEG,NSV_CSEND
+ XLBXSVS(:,:,:,JSV)=MAX(XLBXSVS(:,:,:,JSV),0.)
+ XLBYSVS(:,:,:,JSV)=MAX(XLBYSVS(:,:,:,JSV),0.)
+ ENDDO
+ !
+ DO JSV=NSV_SNWBEG,NSV_SNWEND
+ XLBXSVS(:,:,:,JSV)=MAX(XLBXSVS(:,:,:,JSV),0.)
+ XLBYSVS(:,:,:,JSV)=MAX(XLBYSVS(:,:,:,JSV),0.)
+ ENDDO
+ !
+ END IF
+ END IF
+END IF
+!
+CALL SECOND_MNH2(ZTIME2)
+!
+XT_COUPL = XT_COUPL + ZTIME2 - ZTIME1
+!
+!-------------------------------------------------------------------------------
+!
+!
+!
+!* 8 Bis . Blowing snow scheme
+! ---------
+!
+IF ( LBLOWSNOW ) THEN
+ CALL BLOWSNOW( XTSTEP, NRR, XPABST, XTHT, XRT, XZZ, XRHODREF, &
+ XRHODJ, XEXNREF, XRRS, XRTHS, XSVT, XRSVS, XSNWSUBL3D )
+ENDIF
+!
+!-----------------------------------------------------------------------
+!
+!* 8 Ter VISCOSITY (no-slip condition inside)
+! ---------
+!
+!
+IF ( LVISC ) THEN
+!
+ZTIME1 = ZTIME2
+!
+ CALL VISCOSITY(CLBCX, CLBCY, NRR, NSV, XMU_V,XPRANDTL, &
+ LVISC_UVW,LVISC_TH,LVISC_SV,LVISC_R, &
+ LDRAG, &
+ XUT, XVT, XWT, XTHT, XRT, XSVT, &
+ XRHODJ, XDXX, XDYY, XDZZ, XDZX, XDZY, &
+ XRUS, XRVS, XRWS, XRTHS, XRRS, XRSVS,XDRAG )
+!
+ENDIF
+!
+CALL SECOND_MNH2(ZTIME2)
+!
+XT_VISC = XT_VISC + ZTIME2 - ZTIME1
+!!
+!-------------------------------------------------------------------------------
+!
+!* 9. ADVECTION
+! ---------
+!
+ZTIME1 = ZTIME2
+XTIME_BU_PROCESS = 0.
+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, &
+ CLBCX, CLBCY, NRR, NSV, TDTCUR, XTSTEP, &
+ XUT, XVT, XWT, XTHT, XRT, XTKET, XSVT, XPABST, &
+ XTHVREF, XRHODJ, XDXX, XDYY, XDZZ, XDZX, XDZY, &
+ XRTHS, XRRS, XRTKES, XRSVS, &
+ XRTHS_CLD, XRRS_CLD, XRSVS_CLD, XRTKEMS )
+CALL MPPDB_CHECK3DM("after ADVEC_METSV:XU/V/W/TH/TKE/T,XRHODJ ",PRECISION,&
+ & XUT, XVT, XWT, XTHT, XTKET,XRHODJ)
+!
+CALL SECOND_MNH2(ZTIME2)
+!
+XT_ADV = XT_ADV + ZTIME2 - ZTIME1 - XTIME_LES_BU_PROCESS - XTIME_BU_PROCESS
+!
+!-------------------------------------------------------------------------------
+ZTIME1 = ZTIME2
+XTIME_BU_PROCESS = 0.
+XTIME_LES_BU_PROCESS = 0.
+!
+ZRWS = XRWS
+!
+CALL GRAVITY_IMPL ( CLBCX, CLBCY, NRR, NRRL, NRRI,XTSTEP, &
+ XTHT, XRT, XTHVREF, XRHODJ, XRWS, XRTHS, XRRS, &
+ XRTHS_CLD, XRRS_CLD )
+!
+! At the initial instant the difference with the ref state creates a
+! vertical velocity production that must not be advected as it is
+! compensated by the pressure gradient
+!
+IF (KTCOUNT == 1 .AND. CCONF=='START') XRWS_PRES = - (XRWS - ZRWS)
+!
+CALL SECOND_MNH2(ZTIME2)
+!
+XT_GRAV = XT_GRAV + ZTIME2 - ZTIME1 - XTIME_LES_BU_PROCESS - XTIME_BU_PROCESS
+!
+IF ( LIBM .AND. CIBM_ADV=='FORCIN' ) THEN
+ !
+ ZTIME1=ZTIME2
+ !
+ CALL IBM_FORCING_ADV (XRUS,XRVS,XRWS)
+ !
+ CALL SECOND_MNH2(ZTIME2)
+ !
+ XT_IBM_FORC = XT_IBM_FORC + ZTIME2 - ZTIME1
+ !
+ENDIF
+!
+ZTIME1 = ZTIME2
+XTIME_BU_PROCESS = 0.
+XTIME_LES_BU_PROCESS = 0.
+!
+!MPPDB_CHECK_LB=.TRUE.
+CALL MPPDB_CHECK3DM("before ADVEC_UVW:XU/V/W/TH/TKE/T,XRHODJ,XRU/V/Ws",PRECISION,&
+ & XUT, XVT, XWT, XTHT, XTKET,XRHODJ,XRUS,XRVS,XRWS)
+IF ((CUVW_ADV_SCHEME(1:3)=='CEN') .AND. (CTEMP_SCHEME == 'LEFR')) THEN
+ IF (CUVW_ADV_SCHEME=='CEN4TH') THEN
+ NULLIFY(TZFIELDC_ll)
+ NULLIFY(TZHALO2C_ll)
+ CALL ADD3DFIELD_ll( TZFIELDC_ll, XUT, 'MODEL_n::XUT' )
+ CALL ADD3DFIELD_ll( TZFIELDC_ll, XVT, 'MODEL_n::XVT' )
+ CALL ADD3DFIELD_ll( TZFIELDC_ll, XWT, 'MODEL_n::XWT' )
+ CALL INIT_HALO2_ll(TZHALO2C_ll,3,IIU,IJU,IKU)
+ CALL UPDATE_HALO_ll(TZFIELDC_ll,IINFO_ll)
+ CALL UPDATE_HALO2_ll(TZFIELDC_ll, TZHALO2C_ll, IINFO_ll)
+ END IF
+ CALL ADVECTION_UVW_CEN(CUVW_ADV_SCHEME, &
+ CLBCX, CLBCY, &
+ XTSTEP, KTCOUNT, &
+ XUM, XVM, XWM, XDUM, XDVM, XDWM, &
+ XUT, XVT, XWT, &
+ XRHODJ, XDXX, XDYY, XDZZ, XDZX, XDZY, &
+ XRUS,XRVS, XRWS, &
+ TZHALO2C_ll )
+ IF (CUVW_ADV_SCHEME=='CEN4TH') THEN
+ CALL CLEANLIST_ll(TZFIELDC_ll)
+ NULLIFY(TZFIELDC_ll)
+ CALL DEL_HALO2_ll(TZHALO2C_ll)
+ NULLIFY(TZHALO2C_ll)
+ END IF
+ELSE
+
+ CALL ADVECTION_UVW(CUVW_ADV_SCHEME, CTEMP_SCHEME, &
+ NWENO_ORDER, LSPLIT_WENO, &
+ CLBCX, CLBCY, XTSTEP, &
+ XUT, XVT, XWT, &
+ XRHODJ, XDXX, XDYY, XDZZ, XDZX, XDZY, &
+ XRUS, XRVS, XRWS, &
+ XRUS_PRES, XRVS_PRES, XRWS_PRES )
+END IF
+!
+CALL MPPDB_CHECK3DM("after ADVEC_UVW:XU/V/W/TH/TKE/T,XRHODJ,XRU/V/Ws",PRECISION,&
+ & XUT, XVT, XWT, XTHT, XTKET,XRHODJ,XRUS,XRVS,XRWS)
+!MPPDB_CHECK_LB=.FALSE.
+!
+CALL SECOND_MNH2(ZTIME2)
+!
+XT_ADVUVW = XT_ADVUVW + ZTIME2 - ZTIME1 - XTIME_LES_BU_PROCESS - XTIME_BU_PROCESS
+!
+!-------------------------------------------------------------------------------
+!
+IF (NMODEL_CLOUD==IMI .AND. CTURBLEN_CLOUD/='NONE') THEN
+ CALL TURB_CLOUD_INDEX( XTSTEP, TPBAKFILE, &
+ LTURB_DIAG, NRRI, &
+ XRRS, XRT, XRHODJ, XDXX, XDYY, XDZZ, XDZX, XDZY, &
+ XCEI )
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+!* 18. LATERAL BOUNDARY CONDITION FOR THE NORMAL VELOCITY
+! --------------------------------------------------
+!
+ZTIME1 = ZTIME2
+!
+CALL MPPDB_CHECK3DM("before RAD_BOUND :XRU/V/WS",PRECISION,XRUS,XRVS,XRWS)
+ZRUS=XRUS
+ZRVS=XRVS
+ZRWS=XRWS
+!
+if ( .not. l1d ) then
+ if ( lbudget_u ) call Budget_store_init( tbudgets(NBUDGET_U), 'PRES', xrus(:, :, :) )
+ if ( lbudget_v ) call Budget_store_init( tbudgets(NBUDGET_V), 'PRES', xrvs(:, :, :) )
+ if ( lbudget_w ) call Budget_store_init( tbudgets(NBUDGET_W), 'PRES', xrws(:, :, :) )
+end if
+!
+CALL MPPDB_CHECK3DM("before RAD_BOUND : other var",PRECISION,XUT,XVT,XRHODJ,XTKET)
+CALL MPPDB_CHECKLB(XLBXUM,"modeln XLBXUM",PRECISION,'LBXU',NRIMX)
+CALL MPPDB_CHECKLB(XLBYVM,"modeln XLBYVM",PRECISION,'LBYV',NRIMY)
+CALL MPPDB_CHECKLB(XLBXUS,"modeln XLBXUS",PRECISION,'LBXU',NRIMX)
+CALL MPPDB_CHECKLB(XLBYVS,"modeln XLBYVS",PRECISION,'LBYV',NRIMY)
+!
+ CALL RAD_BOUND (CLBCX,CLBCY,CTURB,XCARPKMAX, &
+ XTSTEP, &
+ XDXHAT, XDYHAT, XZHAT, &
+ XUT, XVT, &
+ XLBXUM, XLBYVM, XLBXUS, XLBYVS, &
+ XFLUCTUNW,XFLUCTVNN,XFLUCTUNE,XFLUCTVNS, &
+ XCPHASE, XCPHASE_PBL, XRHODJ, &
+ XTKET,XRUS, XRVS, XRWS )
+ZRUS=XRUS-ZRUS
+ZRVS=XRVS-ZRVS
+ZRWS=XRWS-ZRWS
+!
+CALL SECOND_MNH2(ZTIME2)
+!
+XT_RAD_BOUND = XT_RAD_BOUND + ZTIME2 - ZTIME1
+!
+!-------------------------------------------------------------------------------
+!
+!* 19. PRESSURE COMPUTATION
+! --------------------
+!
+ZTIME1 = ZTIME2
+XTIME_BU_PROCESS = 0.
+XTIME_LES_BU_PROCESS = 0.
+!
+ZPABST = XPABST
+!
+IF(.NOT. L1D) THEN
+!
+CALL MPPDB_CHECK3DM("before pressurez:XRU/V/WS",PRECISION,XRUS,XRVS,XRWS)
+ XRUS_PRES = XRUS
+ XRVS_PRES = XRVS
+ XRWS_PRES = XRWS
+!
+ CALL PRESSUREZ( CLBCX,CLBCY,CPRESOPT,NITR,LITRADJ,KTCOUNT, XRELAX,IMI, &
+ XRHODJ,XDXX,XDYY,XDZZ,XDZX,XDZY,XDXHATM,XDYHATM,XRHOM, &
+ XAF,XBFY,XCF,XTRIGSX,XTRIGSY,NIFAXX,NIFAXY, &
+ NRR,NRRL,NRRI,XDRYMASST,XREFMASS,XMASS_O_PHI0, &
+ XTHT,XRT,XRHODREF,XTHVREF,XRVREF,XEXNREF, XLINMASS, &
+ XRUS, XRVS, XRWS, XPABST, &
+ XBFB,&
+ XBF_SXP2_YP1_Z) !JUAN Z_SPLITING
+!
+ XRUS_PRES = XRUS - XRUS_PRES + ZRUS
+ XRVS_PRES = XRVS - XRVS_PRES + ZRVS
+ XRWS_PRES = XRWS - XRWS_PRES + ZRWS
+ CALL MPPDB_CHECK3DM("after pressurez:XRU/V/WS",PRECISION,XRUS,XRVS,XRWS)
+!
+END IF
+!
+CALL SECOND_MNH2(ZTIME2)
+!
+XT_PRESS = XT_PRESS + ZTIME2 - ZTIME1 &
+ - XTIME_LES_BU_PROCESS - XTIME_BU_PROCESS
+!
+!-------------------------------------------------------------------------------
+!
+!* 20. CHEMISTRY/AEROSOLS
+! ------------------
+!
+ZTIME1 = ZTIME2
+XTIME_BU_PROCESS = 0.
+XTIME_LES_BU_PROCESS = 0.
+!
+IF (LUSECHEM) THEN
+ CALL CH_MONITOR_n(ZWETDEPAER,KTCOUNT,XTSTEP, ILUOUT, NVERB)
+END IF
+!
+! For inert aerosol (dust and sea salt) => aer_monitor_n
+IF ((LDUST).OR.(LSALT)) THEN
+!
+! tests to see if any cloud exists
+!
+ GCLD=.TRUE.
+ IF (GCLD .AND. NRR.LE.3 ) THEN
+ IF( MAX(MAXVAL(XCLDFR(:,:,:)),MAXVAL(XICEFR(:,:,:))).LE. 1.E-10 .AND. GCLOUD_ONLY ) THEN
+ GCLD = .FALSE. ! only the cloudy verticals would be
+ ! refreshed but there is no clouds
+ END IF
+ END IF
+!
+ IF (GCLD .AND. NRR.GE.4 ) THEN
+ IF( CCLOUD(1:3)=='ICE' )THEN
+ IF( MAXVAL(XRT(:,:,:,2)).LE.XRTMIN(2) .AND. &
+ MAXVAL(XRT(:,:,:,4)).LE.XRTMIN(4) .AND. GCLOUD_ONLY ) THEN
+ GCLD = .FALSE. ! only the cloudy verticals would be
+ ! refreshed but there is no cloudwater and ice
+ END IF
+ END IF
+ IF( CCLOUD=='C3R5' )THEN
+ IF( MAXVAL(XRT(:,:,:,2)).LE.XRTMIN_C1R3(2) .AND. &
+ MAXVAL(XRT(:,:,:,4)).LE.XRTMIN_C1R3(4) .AND. GCLOUD_ONLY ) THEN
+ GCLD = .FALSE. ! only the cloudy verticals would be
+ ! refreshed but there is no cloudwater and ice
+ END IF
+ END IF
+ IF( CCLOUD=='LIMA' )THEN
+ IF( MAXVAL(XRT(:,:,:,2)).LE.XRTMIN_LIMA(2) .AND. &
+ MAXVAL(XRT(:,:,:,4)).LE.XRTMIN_LIMA(4) .AND. GCLOUD_ONLY ) THEN
+ GCLD = .FALSE. ! only the cloudy verticals would be
+ ! refreshed but there is no cloudwater and ice
+ END IF
+ END IF
+ END IF
+
+!
+ CALL AER_MONITOR_n(KTCOUNT,XTSTEP, ILUOUT, NVERB, GCLD)
+END IF
+!
+!
+CALL SECOND_MNH2(ZTIME2)
+!
+XT_CHEM = XT_CHEM + ZTIME2 - ZTIME1 &
+ - XTIME_LES_BU_PROCESS - XTIME_BU_PROCESS
+!
+ZTIME = ZTIME + XTIME_LES_BU_PROCESS + XTIME_BU_PROCESS
+
+!-------------------------------------------------------------------------------
+!
+!* 20. WATER MICROPHYSICS
+! ------------------
+!
+ZTIME1 = ZTIME2
+XTIME_BU_PROCESS = 0.
+XTIME_LES_BU_PROCESS = 0.
+!
+IF (CCLOUD /= 'NONE' .AND. CELEC == 'NONE') THEN
+!
+ IF (CCLOUD == 'C2R2' .OR. CCLOUD == 'KHKO' .OR. CCLOUD == 'C3R5' &
+ .OR. CCLOUD == "LIMA" ) THEN
+ IF ( LFORCING ) THEN
+ XWT_ACT_NUC(:,:,:) = XWT(:,:,:) + XWTFRC(:,:,:)
+ ELSE
+ XWT_ACT_NUC(:,:,:) = XWT(:,:,:)
+ END IF
+ IF (CTURB /= 'NONE' ) THEN
+ IF ( ((CCLOUD=='C2R2'.OR.CCLOUD=='KHKO').AND.LACTTKE) .OR. (CCLOUD=='LIMA'.AND.MACTTKE) ) THEN
+ XWT_ACT_NUC(:,:,:) = XWT_ACT_NUC(:,:,:) + (2./3. * XTKET(:,:,:))**0.5
+ ELSE
+ XWT_ACT_NUC(:,:,:) = XWT_ACT_NUC(:,:,:)
+ ENDIF
+ ENDIF
+ ELSE
+ XWT_ACT_NUC(:,:,:) = 0.
+ END IF
+!
+ 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_CLOUD ( CCLOUD, 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)
+ ELSE
+ CALL RESOLVED_CLOUD ( CCLOUD, 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 )
+ END IF
+ XRTHS_CLD = XRTHS - XRTHS_CLD
+ XRRS_CLD = XRRS - XRRS_CLD
+ XRSVS_CLD = XRSVS - XRSVS_CLD
+!
+ IF (CCLOUD /= 'REVE' ) THEN
+ XACPRR = XACPRR + XINPRR * XTSTEP
+ IF ( (CCLOUD(1:3) == 'ICE' .AND. LSEDIC ) .OR. &
+ ((CCLOUD == 'C2R2' .OR. CCLOUD == 'C3R5' .OR. CCLOUD == 'KHKO' &
+ .OR. CCLOUD == 'LIMA' ) .AND. KSEDC ) ) THEN
+ XACPRC = XACPRC + XINPRC * XTSTEP
+ IF (LDEPOSC .OR. LDEPOC) XACDEP = XACDEP + XINDEP * XTSTEP
+ END IF
+ IF (CCLOUD(1:3) == 'ICE' .OR. CCLOUD == 'C3R5' .OR. &
+ (CCLOUD == 'LIMA' .AND. NMOM_I.GE.1 ) ) THEN
+ XACPRS = XACPRS + XINPRS * XTSTEP
+ XACPRG = XACPRG + XINPRG * XTSTEP
+ IF (CCLOUD == 'ICE4' .OR. (CCLOUD == 'LIMA' .AND. NMOM_H.GE.1)) XACPRH = XACPRH + XINPRH * XTSTEP
+ END IF
+!
+! Lessivage des CCN et IFN nucléables par Slinn
+!
+ IF (LSCAV .AND. (CCLOUD == 'LIMA')) THEN
+ CALL LIMA_PRECIP_SCAVENGING( YLDIMPHYEX,CST,TBUCONF,TBUDGETS,SIZE(TBUDGETS), &
+ CCLOUD, ILUOUT, KTCOUNT,XTSTEP,XRT(:,:,:,3), &
+ XRHODREF, XRHODJ, XZZ, XPABST, XTHT, &
+ XSVT(:,:,:,NSV_LIMA_BEG:NSV_LIMA_END), &
+ XRSVS(:,:,:,NSV_LIMA_BEG:NSV_LIMA_END), XINPAP )
+!
+ XACPAP(:,:) = XACPAP(:,:) + XINPAP(:,:) * XTSTEP
+ END IF
+ END IF
+!
+! It is necessary that SV_C2R2 and SV_C1R3 are contiguous in the preceeding CALL
+!
+END IF
+!
+CALL SECOND_MNH2(ZTIME2)
+!
+XT_CLOUD = XT_CLOUD + ZTIME2 - ZTIME1 &
+ - XTIME_LES_BU_PROCESS - XTIME_BU_PROCESS
+!
+!-------------------------------------------------------------------------------
+!
+!* 21. CLOUD ELECTRIFICATION AND LIGHTNING FLASHES
+! -------------------------------------------
+!
+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, &
+ 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, &
+ 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 (CCLOUD(1:3) == 'ICE') THEN
+ XACPRS = XACPRS + XINPRS * XTSTEP
+ XACPRG = XACPRG + XINPRG * XTSTEP
+ IF (CCLOUD == 'ICE4') XACPRH = XACPRH + XINPRH * XTSTEP
+ END IF
+END IF
+!
+CALL SECOND_MNH2(ZTIME2)
+!
+XT_ELEC = XT_ELEC + ZTIME2 - ZTIME1 &
+ - XTIME_LES_BU_PROCESS - XTIME_BU_PROCESS
+!
+!-------------------------------------------------------------------------------
+!
+!* 21. L.E.S. COMPUTATIONS
+! -------------------
+!
+ZTIME1 = ZTIME2
+!
+CALL LES_n
+!
+CALL SECOND_MNH2(ZTIME2)
+!
+XT_SPECTRA = XT_SPECTRA + ZTIME2 - ZTIME1 + XTIME_LES_BU + XTIME_LES
+!
+!-------------------------------------------------------------------------------
+!
+!* 21. bis MEAN_UM
+! --------------------
+!
+IF (LMEAN_FIELD) THEN
+ CALL MEAN_FIELD(XUT, XVT, XWT, XTHT, XTKET, XPABST, XSVT(:,:,:,1))
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+!* 22. UPDATE HALO OF EACH SUBDOMAINS FOR TIME T+DT
+! --------------------------------------------
+!
+ZTIME1 = ZTIME2
+!
+CALL EXCHANGE (XTSTEP,NRR,NSV,XRHODJ,TFIELDS_ll, &
+ XRUS, XRVS,XRWS,XRTHS,XRRS,XRTKES,XRSVS)
+!
+CALL SECOND_MNH2(ZTIME2)
+!
+XT_HALO = XT_HALO + ZTIME2 - ZTIME1
+!
+!-------------------------------------------------------------------------------
+!
+!* 23. TEMPORAL SWAPPING
+! -----------------
+!
+ZTIME1 = ZTIME2
+XTIME_BU_PROCESS = 0.
+!
+CALL ENDSTEP ( XTSTEP,NRR,NSV,KTCOUNT,IMI, &
+ CUVW_ADV_SCHEME,CTEMP_SCHEME,XRHODJ, &
+ XRUS,XRVS,XRWS,XDRYMASSS, &
+ XRTHS,XRRS,XRTKES,XRSVS, &
+ XLSUS,XLSVS,XLSWS, &
+ XLSTHS,XLSRVS,XLSZWSS, &
+ XLBXUS,XLBXVS,XLBXWS, &
+ XLBXTHS,XLBXRS,XLBXTKES,XLBXSVS, &
+ XLBYUS,XLBYVS,XLBYWS, &
+ XLBYTHS,XLBYRS,XLBYTKES,XLBYSVS, &
+ XUM,XVM,XWM,XZWS, &
+ XUT,XVT,XWT,XPABST,XDRYMASST, &
+ XTHT, XRT, XTHM, XRCM, XPABSM,XTKET, XSVT,&
+ XLSUM,XLSVM,XLSWM, &
+ XLSTHM,XLSRVM,XLSZWSM, &
+ XLBXUM,XLBXVM,XLBXWM, &
+ XLBXTHM,XLBXRM,XLBXTKEM,XLBXSVM, &
+ XLBYUM,XLBYVM,XLBYWM, &
+ XLBYTHM,XLBYRM,XLBYTKEM,XLBYSVM )
+!
+CALL SECOND_MNH2(ZTIME2)
+!
+XT_STEP_SWA = XT_STEP_SWA + ZTIME2 - ZTIME1 - XTIME_BU_PROCESS
+!
+!-------------------------------------------------------------------------------
+!
+!* 24.1 BALLOON and AIRCRAFT
+! --------------------
+!
+ZTIME1 = ZTIME2
+!
+IF (LFLYER) THEN
+ IF (CSURF=='EXTE') THEN
+ ALLOCATE(ZSEA(IIU,IJU))
+ ZSEA(:,:) = 0.
+ CALL MNHGET_SURF_PARAM_n (PSEA=ZSEA(:,:))
+ CALL AIRCRAFT_BALLOON( XTSTEP, XZZ, XMAP, XLONORI, XLATORI, &
+ XUT, XVT, XWT, XPABST, XTHT, XRT, XSVT, XTKET, XTSRAD, &
+ XRHODREF, XCIT, PSEA = ZSEA(:,:) )
+ DEALLOCATE(ZSEA)
+ ELSE
+ CALL AIRCRAFT_BALLOON( XTSTEP, XZZ, XMAP, XLONORI, XLATORI, &
+ XUT, XVT, XWT, XPABST, XTHT, XRT, XSVT, XTKET, XTSRAD, &
+ XRHODREF, XCIT )
+ END IF
+END IF
+
+!-------------------------------------------------------------------------------
+!
+!* 24.2 STATION (observation diagnostic)
+! --------------------------------
+!
+IF ( LSTATION ) &
+ CALL STATION_n( XZZ, XUT, XVT, XWT, XTHT, XRT, XSVT, XTKET, XTSRAD, XPABST )
+!
+!---------------------------------------------------------
+!
+!* 24.3 PROFILER (observation diagnostic)
+! ---------------------------------
+!
+IF (LPROFILER) THEN
+ IF (CSURF=='EXTE') THEN
+ ALLOCATE(ZSEA(IIU,IJU))
+ ZSEA(:,:) = 0.
+ CALL MNHGET_SURF_PARAM_n (PSEA=ZSEA(:,:))
+ CALL PROFILER_n( XZZ, XRHODREF, &
+ XUT, XVT, XWT, XTHT, XRT, XSVT, XTKET, &
+ XTSRAD, XPABST, XAER, XCIT, PSEA=ZSEA(:,:) )
+ DEALLOCATE(ZSEA)
+ ELSE
+ CALL PROFILER_n( XZZ, XRHODREF, &
+ XUT, XVT, XWT, XTHT, XRT, XSVT, XTKET, &
+ XTSRAD, XPABST, XAER, XCIT )
+ END IF
+END IF
+!
+IF (ALLOCATED(ZSEA)) DEALLOCATE (ZSEA)
+!
+CALL SECOND_MNH2(ZTIME2)
+!
+XT_STEP_MISC = XT_STEP_MISC + ZTIME2 - ZTIME1
+!
+!-------------------------------------------------------------------------------
+!
+!* 24.4 deallocation of observation diagnostics
+! ---------------------------------------
+!
+CALL END_DIAG_IN_RUN
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 25. STORAGE OF BUDGET FIELDS
+! ------------------------
+!
+ZTIME1 = ZTIME2
+!
+IF ( .NOT. LIO_NO_WRITE ) THEN
+ IF (NBUMOD==IMI .AND. CBUTYPE/='NONE') THEN
+ CALL ENDSTEP_BUDGET(TDIAFILE,KTCOUNT,TDTCUR,XTSTEP,NSV)
+ END IF
+END IF
+!
+CALL SECOND_MNH2(ZTIME2)
+!
+XT_STEP_BUD = XT_STEP_BUD + ZTIME2 - ZTIME1 + XTIME_BU
+!
+!-------------------------------------------------------------------------------
+!
+!* 27. CURRENT TIME REFRESH
+! --------------------
+!
+TDTCUR%xtime=TDTCUR%xtime + XTSTEP
+CALL DATETIME_CORRECTDATE(TDTCUR)
+!
+!-------------------------------------------------------------------------------
+!
+!* 28. CPU ANALYSIS
+! ------------
+!
+CALL SECOND_MNH2(ZTIME2)
+XT_START=XT_START+ZTIME2-ZEND
+!
+!
+IF ( KTCOUNT == NSTOP .AND. IMI==1) THEN
+ OEXIT=.TRUE.
+END IF
+!
+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_les_n( tdiafile )
+#ifdef MNH_IOLFI
+ CALL MENU_DIACHRO(TDIAFILE,'END')
+#endif
+ CALL IO_File_close(TDIAFILE)
+ ! Free memory of flyer that is not present on the master process of the file (was allocated in WRITE_AIRCRAFT_BALLOON)
+ CALL AIRCRAFT_BALLOON_FREE_NONLOCAL( TDIAFILE )
+ END IF
+ !
+ CALL IO_File_close(TINIFILE)
+ IF (CSURF=="EXTE") CALL IO_File_close(TINIFILEPGD)
+!
+!* 28.1 print statistics!
+!
+ ! Set File Timing OUTPUT
+ !
+ CALL SET_ILUOUT_TIMING(TLUOUT)
+ !
+ ! Compute global time
+ !
+ CALL TIME_STAT_ll(XT_START,ZTOT)
+ !
+ CALL TIME_HEADER_ll(IMI)
+ !
+ CALL TIME_STAT_ll(XT_1WAY,ZTOT, ' ONE WAY','=')
+ CALL TIME_STAT_ll(XT_BOUND,ZTOT, ' BOUNDARIES','=')
+ CALL TIME_STAT_ll(XT_STORE,ZTOT, ' STORE-FIELDS','=')
+ CALL TIME_STAT_ll(TIMEZ%T_WRIT3D_SEND,ZTOT, ' W3D_SEND ','-')
+ CALL TIME_STAT_ll(TIMEZ%T_WRIT3D_RECV,ZTOT, ' W3D_RECV ','-')
+ CALL TIME_STAT_ll(TIMEZ%T_WRIT3D_WRIT,ZTOT, ' W3D_WRIT ','-')
+ CALL TIME_STAT_ll(TIMEZ%T_WRIT3D_WAIT,ZTOT, ' W3D_WAIT ','-')
+ CALL TIME_STAT_ll(TIMEZ%T_WRIT3D_ALL ,ZTOT, ' W3D_ALL ','-')
+ CALL TIME_STAT_ll(TIMEZ%T_WRIT2D_GATH,ZTOT, ' W2D_GATH ','-')
+ CALL TIME_STAT_ll(TIMEZ%T_WRIT2D_WRIT,ZTOT, ' W2D_WRIT ','-')
+ CALL TIME_STAT_ll(TIMEZ%T_WRIT2D_ALL ,ZTOT, ' W2D_ALL ','-')
+ CALL TIME_STAT_ll(XT_GUESS,ZTOT, ' INITIAL_GUESS','=')
+ CALL TIME_STAT_ll(XT_2WAY,ZTOT, ' TWO WAY','=')
+ CALL TIME_STAT_ll(XT_ADV,ZTOT, ' ADVECTION MET','=')
+ CALL TIME_STAT_ll(XT_ADVUVW,ZTOT, ' ADVECTION UVW','=')
+ CALL TIME_STAT_ll(XT_GRAV,ZTOT, ' GRAVITY','=')
+ CALL TIME_STAT_ll(XT_FORCING,ZTOT, ' FORCING','=')
+ CALL TIME_STAT_ll(XT_IBM_FORC,ZTOT, ' IBM','=')
+ CALL TIME_STAT_ll(XT_NUDGING,ZTOT, ' NUDGING','=')
+ CALL TIME_STAT_ll(XT_SOURCES,ZTOT, ' DYN_SOURCES','=')
+ CALL TIME_STAT_ll(XT_DIFF,ZTOT, ' NUM_DIFF','=')
+ CALL TIME_STAT_ll(XT_RELAX,ZTOT, ' RELAXATION','=')
+ !
+ CALL TIMING_LEGEND()
+ !
+ CALL TIME_STAT_ll(XT_PARAM,ZTOT, ' PHYS_PARAM','=')
+ CALL TIME_STAT_ll(XT_RAD,ZTOT, ' RAD = '//CRAD ,'-')
+ CALL TIME_STAT_ll(XT_SHADOWS,ZTOT, ' SHADOWS' ,'-')
+ CALL TIME_STAT_ll(XT_DCONV,ZTOT, ' DEEP CONV = '//CDCONV,'-')
+ CALL TIME_STAT_ll(XT_GROUND,ZTOT, ' GROUND' ,'-')
+ ! Blaze perf
+ IF (LBLAZE) THEN
+ CALL TIME_STAT_ll(XFIREPERF,ZBLAZETOT)
+ CALL TIME_STAT_ll(XFIREPERF,ZTOT, ' BLAZE' ,'~')
+ CALL TIME_STAT_ll(XGRADPERF,ZBLAZETOT, ' GRAD(PHI)' ,' ')
+ CALL TIME_STAT_ll(XROSWINDPERF,ZBLAZETOT, ' ROS & WIND' ,' ')
+ CALL TIME_STAT_ll(XPROPAGPERF,ZBLAZETOT, ' PROPAGATION' ,' ')
+ CALL TIME_STAT_ll(XFLUXPERF,ZBLAZETOT, ' HEAT FLUXES' ,' ')
+ END IF
+ CALL TIME_STAT_ll(XT_TURB,ZTOT, ' TURB = '//CTURB ,'-')
+ CALL TIME_STAT_ll(XT_MAFL,ZTOT, ' MAFL = '//CSCONV,'-')
+ CALL TIME_STAT_ll(XT_CHEM,ZTOT, ' CHIMIE' ,'-')
+ CALL TIME_STAT_ll(XT_EOL,ZTOT, ' WIND TURBINE' ,'-')
+ CALL TIMING_LEGEND()
+ CALL TIME_STAT_ll(XT_COUPL,ZTOT, ' SET_COUPLING','=')
+ CALL TIME_STAT_ll(XT_RAD_BOUND,ZTOT, ' RAD_BOUND','=')
+ !
+ CALL TIMING_LEGEND()
+ !
+ CALL TIME_STAT_ll(XT_PRESS,ZTOT, ' PRESSURE ','=','F')
+ !JUAN Z_SPLITTING
+ CALL TIME_STAT_ll(TIMEZ%T_MAP_B_SX_YP2_ZP1,ZTOT, ' REMAP B=>FFTXZ' ,'-','F')
+ CALL TIME_STAT_ll(TIMEZ%T_MAP_SX_YP2_ZP1_SXP2_Y_ZP1,ZTOT, ' REMAP FFTXZ=>FFTYZ' ,'-','F')
+ CALL TIME_STAT_ll(TIMEZ%T_MAP_SXP2_Y_ZP1_B,ZTOT, ' REMAP FTTYZ=>B' ,'-','F')
+ CALL TIME_STAT_ll(TIMEZ%T_MAP_SXP2_Y_ZP1_SXP2_YP1_Z,ZTOT, ' REMAP FFTYZ=>SUBZ' ,'-','F')
+ CALL TIME_STAT_ll(TIMEZ%T_MAP_B_SXP2_Y_ZP1,ZTOT, ' REMAP B=>FFTYZ-1','-','F')
+ CALL TIME_STAT_ll(TIMEZ%T_MAP_SXP2_YP1_Z_SXP2_Y_ZP1,ZTOT, ' REMAP SUBZ=>FFTYZ-1','-','F')
+ CALL TIME_STAT_ll(TIMEZ%T_MAP_SXP2_Y_ZP1_SX_YP2_ZP1,ZTOT, ' REMAP FFTYZ-1=>FFTXZ-1','-','F')
+ CALL TIME_STAT_ll(TIMEZ%T_MAP_SX_YP2_ZP1_B,ZTOT, ' REMAP FFTXZ-1=>B ' ,'-','F')
+ ! JUAN P1/P2
+ CALL TIME_STAT_ll(XT_CLOUD,ZTOT, ' RESOLVED_CLOUD','=')
+ CALL TIME_STAT_ll(XT_ELEC,ZTOT, ' RESOLVED_ELEC','=')
+ CALL TIME_STAT_ll(XT_HALO,ZTOT, ' EXCHANGE_HALO','=')
+ CALL TIME_STAT_ll(XT_STEP_SWA,ZTOT, ' ENDSTEP','=')
+ CALL TIME_STAT_ll(XT_STEP_BUD,ZTOT, ' BUDGETS','=')
+ CALL TIME_STAT_ll(XT_SPECTRA,ZTOT, ' LES','=')
+ CALL TIME_STAT_ll(XT_STEP_MISC,ZTOT, ' MISCELLANEOUS','=')
+ IF (LIBM) CALL TIME_STAT_ll(XT_IBM_FORC,ZTOT,' IBM FORCING','=')
+ !
+ ! sum of call subroutine
+ !
+ ZALL = XT_1WAY + XT_BOUND + XT_STORE + XT_GUESS + XT_2WAY + &
+ XT_ADV + XT_FORCING + XT_NUDGING + XT_SOURCES + XT_DIFF + &
+ XT_ADVUVW + XT_GRAV + XT_IBM_FORC + &
+ XT_RELAX+ XT_PARAM + XT_COUPL + XT_RAD_BOUND+XT_PRESS + &
+ XT_CLOUD+ XT_ELEC + XT_HALO + XT_SPECTRA + XT_STEP_SWA + &
+ XT_STEP_MISC+ XT_STEP_BUD
+ CALL TIME_STAT_ll(ZALL,ZTOT, ' SUM(CALL)','=')
+ CALL TIMING_SEPARATOR('=')
+ !
+ ! Gobale Stat
+ !
+ WRITE(ILUOUT,FMT=*)
+ WRITE(ILUOUT,FMT=*)
+ CALL TIMING_LEGEND()
+ !
+ ! MODELN all included
+ !
+ CALL TIMING_SEPARATOR('+')
+ CALL TIMING_SEPARATOR('+')
+ WRITE(YMI,FMT="(I0)") IMI
+ CALL TIME_STAT_ll(XT_START,ZTOT, ' MODEL'//YMI,'+')
+ CALL TIMING_SEPARATOR('+')
+ CALL TIMING_SEPARATOR('+')
+ CALL TIMING_SEPARATOR('+')
+ !
+ ! Timing/ Steps
+ !
+ ZTIME_STEP = XT_START / REAL(KTCOUNT)
+ WRITE(YTCOUNT,FMT="(I0)") KTCOUNT
+ CALL TIME_STAT_ll(ZTIME_STEP,ZTOT, ' SECOND/STEP='//YTCOUNT,'=')
+ !
+ ! Timing/Step/Points
+ !
+ IPOINTS = NIMAX_ll*NJMAX_ll*NKMAX
+ WRITE(YPOINTS,FMT="(I0)") IPOINTS
+ ZTIME_STEP_PTS = ZTIME_STEP / REAL(IPOINTS) * 1e6
+ CALL TIME_STAT_ll(ZTIME_STEP_PTS,ZTOT_PT)
+ CALL TIME_STAT_ll(ZTIME_STEP_PTS,ZTOT_PT, ' MICROSEC/STP/PT='//YPOINTS,'-')
+ !
+ CALL TIMING_SEPARATOR('=')
+ !
+END IF
+!
+END SUBROUTINE MODEL_n
diff --git a/src/PHYEX/ext/radiations.f90 b/src/PHYEX/ext/radiations.f90
new file mode 100644
index 0000000000000000000000000000000000000000..2ce3ff7dd8565c819745b9051509849eeee27520
--- /dev/null
+++ b/src/PHYEX/ext/radiations.f90
@@ -0,0 +1,3504 @@
+!MNH_LIC Copyright 1995-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.
+!-----------------------------------------------------------------
+! ########################
+ MODULE MODI_RADIATIONS
+! ########################
+!
+CONTAINS
+!
+! ############################################################################
+ SUBROUTINE RADIATIONS (TPFILE,OCLEAR_SKY,OCLOUD_ONLY, &
+ KCLEARCOL_TM1,HEFRADL,HEFRADI,HOPWSW,HOPISW,HOPWLW,HOPILW, &
+ PFUDG, KDLON, KFLEV, KRAD_DIAG, KFLUX, KRAD, KAER, KSWB_OLD, &
+ KSWB_MNH,KLWB_MNH, KSTATM,KRAD_COLNBR,PCOSZEN,PSEA, PCORSOL, &
+ PDIR_ALB, PSCA_ALB,PEMIS, PCLDFR, PCCO2, PTSRAD, PSTATM, &
+ PTHT, PRT, PPABST, POZON, PAER, PDST_WL, PAER_CLIM, PSVT, &
+ PDTHRAD, PSRFLWD, PSRFSWD_DIR,PSRFSWD_DIF, PRHODREF, PZZ, &
+ PRADEFF, PSWU, PSWD, PLWU,PLWD, PDTHRADSW, PDTHRADLW )
+! ############################################################################
+!
+!!**** *RADIATIONS * - routine to call the SW and LW radiation calculations
+!!
+!! PURPOSE
+!! -------
+!! The purpose of this routine is to prepare the temperature, water vapor
+!! liquid water, cloud fraction, ozone profiles for the ECMWF radiation
+!! calculations. There is a great number of available radiative fluxes in
+!! the output, but only the potential temperature radiative tendency and the
+!! SW and LW surface fluxes are provided in the output of the routine.
+!! Two simplified computations are available (switches OCLEAR_SKY and
+!! OCLOUD_ONLY). When OCLOUD_ONLY is .TRUE. the computations are performed
+!! for the cloudy columns only. Furthermore with OCLEAR_SKY being .TRUE.
+!! the clear sky columns are averaged and the computations are made for
+!! the cloudy columns plus a single ensemble-mean clear sky column.
+!!
+!!** METHOD
+!! ------
+!! First the temperature, water vapor, liquid water, cloud fraction
+!! and profile arrays are built using the current model fields and
+!! the standard atmosphere for the upper layer filling.
+!! The standard atmosphere is used between the levels IKUP and
+!! KFLEV where KFLEV is the number of vertical levels for the radiation
+!! computations.
+!! The aerosols optical thickness and the ozone fields come directly
+!! from ini_radiation step (climatlogies used) and are already defined for KFLEV.
+!! Surface parameter ( albedo, emiss ) are also defined from current surface fields.
+!! In the case of clear-sky or cloud-only approximations, the cloudy
+!! columns are selected by testing the vertically integrated cloud fraction
+!! and the radiation computations are performed for these columns plus the
+!! mean clear-sky one. In addition, columns where cloud have disapeared are determined
+!! by saving cloud trace between radiation step and they are also recalculated
+!! in cloud only step. In all case, the sun position correponds to the centered
+!! time between 2 full radiation steps (determined in physparam).
+!! Then the ECMWF radiation package is called and the radiative
+!! heating/cooling tendancies are reformatted in case of partial
+!! computations. In case of "cloud-only approximation" the only cloudy
+!! column radiative fields are updated.
+!!
+!! EXTERNAL
+!! --------
+!! Subroutine ECMWF_RADIATION_VERS2 : ECMWF interface calling radiation routines
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_CST : constants
+!! XP00 : reference pressure
+!! XCPD : calorific capacity of dry air at constant pressure
+!! XRD : gas constant for dry air
+!! Module MODD_PARAMETERS : parameters
+!! JPHEXT : Extra columns on the horizontal boundaries
+!! JPVEXT : Extra levels on the vertical boundaries
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation ( routine RADIATIONS )
+!!
+!! AUTHOR
+!! ------
+!! J.-P. Pinty * Laboratoire d'Aerologie*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 26/02/95
+!! J.Stein 20/12/95 add the array splitting in order to save memory
+!! J.-P. Pinty 19/11/96 change the split arrays, specific humidity
+!! and add the ice phase
+!! J.Stein 22/06/97 use of the absolute pressure
+!! P.Jabouille 31/07/97 impose a zero humidity for dry simulation
+!! V.Masson 22/09/97 case of clear-sky approx. with no clear-sky column
+!! V.Masson 07/11/97 half level pressure defined from averaged Exner
+!! function
+!! V.Masson 07/11/97 modification of junction between standard atm
+!! and model for half level variables (top model
+!! pressure and temperatures are used preferentially
+!! to atm standard profile for the first point).
+!! P.Jabouille 24/08/98 impose positivity for ZQLAVE
+!! J.-P. Pinty 29/01/98 add storage for diagnostics
+!! J. Stein 18/07/99 add the ORAD_DIAG switch and keep inside the
+!! subroutine the partial tendencies
+!!
+!! F.Solmon 04/03/01 MAJOR MODIFICATIONS, updated version of ECMWF radiation scheme
+!! P.Jabouille 05/05/03 bug in humidity conversion
+!! Y.Seity 25/08/03 KSWB=6 for SW direct and scattered surface
+!! downward fluxes used in surface scheme.
+!! P. Tulet 01/20/05 climatologic SSA
+!! A. Grini 05/20/05 dust direct effect (optical properties)
+!! V.Masson, C.Lac 08/10 Correction of inversion of Diffuse and direct albedo
+!! B.Aouizerats 2010 Explicit aerosol optical properties
+!! C.Lac 11/2015 Correction on aerosols
+!! B.Vie /13 LIMA
+!! J.Escobar 30/03/2017 : Management of compilation of ECMWF_RAD in REAL*8 with MNH_REAL=R4
+!! J.Escobar 29/06/2017 : Check if Pressure Decreasing with height <-> elsif PB & STOP
+!! Q.LIBOIS 06/2017 : correction on CLOUD_ONLY
+!! Q.Libois 02/2018 : ECRAD
+!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+!! J.Escobar 28/06/2018 : Reproductible parallelisation of CLOUD_ONLY case
+!! J.Escobar 20/07/2018 : for real*4 compilation, convert with REAL(X) argument to SUM_DD...
+!! P.Wautelet 22/01/2019: use standard FLUSH statement instead of non standard intrinsics
+!! Bielli S. 02/2019 Sea salt : significant sea wave height influences salt emission; 5 salt modes
+! 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 06/09/2022: small fix: GSURF_CLOUD was not set outside of physical domain
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE PARKIND1, ONLY: JPRB
+USE OYOESW , ONLY : RTAUA ,RPIZA ,RCGA
+!
+USE MODD_CH_AEROSOL, ONLY: LORILAM
+USE MODD_CONF, ONLY: LCARTESIAN
+USE MODD_CST
+USE MODD_DUST, ONLY: LDUST
+use modd_field, only: tfieldmetadata, TYPEREAL
+USE MODD_GRID , ONLY: XLAT0, XLON0
+USE MODD_GRID_n , ONLY: XLAT, XLON
+USE MODD_IO, ONLY: TFILEDATA
+USE MODD_LUNIT_n, ONLY: TLUOUT
+USE MODD_NSV, ONLY: NSV_C2R2,NSV_C2R2BEG,NSV_C2R2END, &
+ NSV_C1R3,NSV_C1R3BEG,NSV_C1R3END, &
+ NSV_DSTBEG, NSV_DSTEND, &
+ NSV_AERBEG, NSV_AEREND, &
+ NSV_SLTBEG, NSV_SLTEND, &
+ NSV_LIMA,NSV_LIMA_BEG,NSV_LIMA_END, &
+ NSV_LIMA_NC, NSV_LIMA_NR, NSV_LIMA_NI
+USE MODD_PARAMETERS
+USE MODD_PARAM_LIMA
+USE MODD_PARAM_n, ONLY: CCLOUD, CRAD
+USE MODD_PARAM_RAD_n, ONLY: CAOP
+USE MODD_RAIN_ICE_DESCR
+USE MODD_SALT, ONLY: LSALT
+USE MODD_TIME
+!
+USE MODE_DUSTOPT
+USE MODE_IO_FIELD_WRITE, only: IO_Field_write
+USE MODE_ll
+use mode_msg
+USE MODE_REPRO_SUM, ONLY : SUM_DD_R2_R1_ll,SUM_DD_R1_ll
+!
+#ifdef MNH_PGI
+USE MODE_PACK_PGI
+#endif
+USE MODE_SALTOPT
+USE MODE_SUM_ll, ONLY: MIN_ll
+USE MODE_SUM2_ll, ONLY: GMINLOC_ll
+USE MODE_THERMO
+!
+USE MODI_AEROOPT_GET
+USE MODI_ECMWF_RADIATION_VERS2
+USE MODI_ECRAD_INTERFACE
+USE MODD_VAR_ll, ONLY: IP
+!
+IMPLICIT NONE
+!
+!* 0.1 DECLARATIONS OF DUMMY ARGUMENTS :
+!
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
+LOGICAL, INTENT(IN) :: OCLOUD_ONLY! flag for the cloud column
+ ! computations only
+LOGICAL, INTENT(IN) :: OCLEAR_SKY !
+INTEGER, INTENT(IN) :: KDLON ! number of columns where the
+ ! radiation calculations are
+ ! performed
+INTEGER, INTENT(IN) :: KFLEV ! number of vertical levels
+ ! where the radiation
+ ! calculations are performed
+INTEGER, INTENT(IN) :: KRAD_DIAG ! index for the number of
+ ! fields in the output
+INTEGER, INTENT(IN) :: KFLUX ! number of top and ground
+ ! fluxes for the ZFLUX array
+INTEGER, INTENT(IN) :: KRAD ! number of satellite radiances
+ ! for the ZRAD and ZRADCS arrays
+INTEGER, INTENT(IN) :: KAER ! number of AERosol classes
+
+INTEGER, INTENT(IN) :: KSWB_OLD ! number of SW band ECMWF
+INTEGER, INTENT(IN) :: KSWB_MNH ! number of SW band ECRAD
+INTEGER, INTENT(IN) :: KLWB_MNH ! number of LW band ECRAD
+INTEGER, INTENT(IN) :: KSTATM ! index of the standard
+ ! atmosphere level just above
+ ! the model top
+INTEGER, INTENT(IN) :: KRAD_COLNBR ! factor by which the memory
+ ! is split
+ !
+ !Choice of :
+CHARACTER (LEN=*), INTENT (IN) :: HEFRADL !
+CHARACTER (LEN=*), INTENT (IN) :: HEFRADI !
+CHARACTER (LEN=*), INTENT (IN) :: HOPWSW !cloud water SW optical properties
+CHARACTER (LEN=*), INTENT (IN) :: HOPISW !ice water SW optical properties
+CHARACTER (LEN=*), INTENT (IN) :: HOPWLW !cloud water LW optical properties
+CHARACTER (LEN=*), INTENT (IN) :: HOPILW !ice water LW optical properties
+REAL, INTENT(IN) :: PFUDG ! subgrid cloud inhomogenity factor
+REAL, DIMENSION(:,:), INTENT(IN) :: PCOSZEN ! COS(zenithal solar angle)
+REAL, INTENT(IN) :: PCORSOL ! SOLar constant CORrection
+REAL, DIMENSION(:,:), INTENT(IN) :: PSEA ! Land-sea mask
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDIR_ALB! Surface direct ALBedo
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSCA_ALB! Surface diffuse ALBedo
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PEMIS ! Surface IR EMISsivity
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCLDFR ! CLouD FRaction
+REAL, INTENT(IN) :: PCCO2 ! CO2 content
+REAL, DIMENSION(:,:), INTENT(IN) :: PTSRAD ! RADiative Surface Temperature
+REAL, DIMENSION(:,:), INTENT(IN) :: PSTATM ! selected standard atmosphere
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! THeta at t
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT ! moist variables at t (humidity, cloud water, rain water, ice water)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! pressure at t
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVT ! scalar variable ( C2R2 and C1R3 particle)
+!
+REAL, DIMENSION(:,:,:), POINTER :: POZON ! OZONE field from clim.
+REAL, DIMENSION(:,:,:,:), POINTER :: PAER ! AERosols optical thickness from clim.
+REAL, DIMENSION(:,:,:,:), POINTER :: PDST_WL ! AERosols Extinction by wavelength .
+REAL, DIMENSION(:,:,:,:), POINTER :: PAER_CLIM ! AERosols optical thickness from clim.
+ ! note : the vertical dimension of
+ ! these fields include the "radiation levels"
+ ! above domain top
+ !
+
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ![kg/m3] air density
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ![m] height of layers
+
+INTEGER, DIMENSION(:,:), INTENT(INOUT) :: KCLEARCOL_TM1 ! trace of cloud/clear col
+ ! at the previous radiation step
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PDTHRAD ! THeta RADiative Tendancy
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PSRFLWD ! Downward SuRFace LW Flux
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSRFSWD_DIR ! Downward SuRFace SW Flux DIRect
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSRFSWD_DIF ! Downward SuRFace SW Flux DIFfuse
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSWU ! upward SW Flux
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSWD ! downward SW Flux
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PLWU ! upward LW Flux
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PLWD ! downward LW Flux
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PDTHRADSW ! dthrad sw
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PDTHRADLW ! dthradsw
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRADEFF ! effective radius
+!
+!
+!* 0.2 DECLARATIONS OF LOCAL VARIABLES
+!
+LOGICAL :: GNOCL ! .TRUE. when no cloud is present
+ ! with OCLEAR_SKY .TRUE.
+LOGICAL :: GAOP ! .TRUE. when CAOP='EXPL'
+LOGICAL, DIMENSION(KDLON,KFLEV) :: GCLOUD ! .TRUE. for the cloudy columns
+LOGICAL, DIMENSION(KFLEV,KDLON) :: GCLOUDT ! transpose of the GCLOUD array
+LOGICAL, DIMENSION(KDLON) :: GCLEAR_2D ! .TRUE. for the clear-sky columns
+LOGICAL, DIMENSION(KDLON,KFLEV) :: GCLEAR ! .TRUE. for all the levels of the
+ ! clear-sky columns
+LOGICAL, DIMENSION(KDLON,KSWB_MNH) :: GCLEAR_SWB! .TRUE. for all the bands of the
+ ! clear-sky columns
+INTEGER, DIMENSION(:), ALLOCATABLE :: ICLEAR_2D_TM1 !
+!
+INTEGER :: JI,JJ,JK,JK1,JK2,JKRAD,JALBS! loop indices
+!
+INTEGER :: IIB ! I index value of the first inner mass point
+INTEGER :: IJB ! J index value of the first inner mass point
+INTEGER :: IKB ! K index value of the first inner mass point
+INTEGER :: IIE ! I index value of the last inner mass point
+INTEGER :: IJE ! J index value of the last inner mass point
+INTEGER :: IKE ! K index value of the last inner mass point
+INTEGER :: IKU ! array size for the third index
+INTEGER :: IIJ ! reformatted array index
+INTEGER :: IKSTAE ! level number of the STAndard atmosphere array
+INTEGER :: IKUP ! vertical level above which STAndard atmosphere data
+ ! are filled in
+!
+INTEGER :: ICLEAR_COL ! number of clear-sky columns
+INTEGER :: ICLOUD_COL ! number of cloudy columns
+INTEGER :: ICLOUD ! number of levels corresponding of the cloudy columns
+INTEGER :: IDIM ! effective number of columns for which the radiation
+ ! code is run
+INTEGER :: INIR ! index corresponding to NIR fisrt band (in SW)
+!
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZTAVE ! mean-layer temperature
+REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZTAVE_RAD ! mean-layer temperature
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZPAVE ! mean-layer pressure
+REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZPAVE_RAD ! mean-layer pressure
+REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZQSAVE ! saturation specific humidity
+REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZQVAVE ! mean-layer specific humidity
+REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZQLAVE ! Liquid water KG/KG
+REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZQRAVE ! Rain water KG/KG
+REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZQIAVE ! Ice water Kg/KG
+REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZQLWC ! liquid water content kg/m3
+REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZQRWC ! Rain water content kg/m3
+REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZQIWC ! ice water content kg/m3
+REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZCFAVE ! mean-layer cloud fraction
+REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZO3AVE ! mean-layer ozone content
+REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZPRES_HL ! half-level pressure
+REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZT_HL ! half-level temperature
+REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZDPRES ! layer pressure thickness
+REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZCCT_C2R2! Cloud water Concentarion (C2R2)
+REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZCRT_C2R2! Rain water Concentarion (C2R2)
+REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZCIT_C1R3! Ice water Concentarion (C2R2)
+REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZCCT_LIMA! Cloud water Concentration(LIMA)
+REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZCRT_LIMA! Rain water Concentration(LIMA)
+REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZCIT_LIMA! Ice water Concentration(LIMA)
+REAL(KIND=JPRB), DIMENSION(:,:,:), ALLOCATABLE :: ZAER ! aerosol optical thickness
+REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZALBP ! spectral surface albedo for direct radiations
+REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZALBD ! spectral surface albedo for diffuse radiations
+REAL(KIND=JPRB), DIMENSION (:,:), ALLOCATABLE :: ZEMIS ! surface LW emissivity
+REAL(KIND=JPRB), DIMENSION (:,:), ALLOCATABLE :: ZEMIW ! surface LW WINDOW emissivity
+REAL(KIND=JPRB), DIMENSION(:), ALLOCATABLE :: ZTS ! reformatted surface PTSRAD array
+REAL(KIND=JPRB), DIMENSION(:), ALLOCATABLE :: ZLSM ! reformatted land sea mask
+REAL(KIND=JPRB), DIMENSION(:), ALLOCATABLE :: ZRMU0 ! Reformatted ZMU0 array
+REAL(KIND=JPRB) :: ZRII0 ! corrected solar constant
+!
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZDTLW ! LW temperature tendency
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZDTSW ! SW temperature tendency
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZNFLW_CS ! CLEAR-SKY LW NET FLUXES
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZNFLW ! TOTAL LW NET FLUXES
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZNFSW_CS ! CLEAR-SKY SW NET FLUXES
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZNFSW ! TOTAL SW NET FLUXES
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZFLUX_TOP_GND_IRVISNIR ! Top and
+ ! Ground radiative FLUXes
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZFLUX_SW_DOWN ! DowNward SW Flux profiles
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZFLUX_SW_UP ! UPward SW Flux profiles
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZFLUX_LW ! LW Flux profiles
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZDTLW_CS ! LW Clear-Sky temp. tendency
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZDTSW_CS ! SW Clear-Sky temp. tendency
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZFLUX_TOP_GND_IRVISNIR_CS ! Top and
+ ! Ground Clear-Sky radiative FLUXes
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZSFSWDIR !surface SW direct flux
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZSFSWDIF !surface SW diffuse flux
+
+REAL, DIMENSION(:), ALLOCATABLE :: ZPLAN_ALB_VIS, ZPLAN_ALB_NIR
+ ! PLANetary ALBedo in VISible, Near-InfraRed regions
+REAL, DIMENSION(:), ALLOCATABLE :: ZPLAN_TRA_VIS, ZPLAN_TRA_NIR
+ ! PLANetary TRANsmission in VISible, Near-InfraRed regions
+REAL, DIMENSION(:), ALLOCATABLE :: ZPLAN_ABS_VIS, ZPLAN_ABS_NIR
+ ! PLANetary ABSorption in VISible, Near-InfraRed regions
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZEFCL_LWD, ZEFCL_LWU
+ ! EFective DOWNward and UPward LW nebulosity (equivalent emissivities)
+ ! undefined if RRTM is used for LW
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZFLWP, ZFIWP
+ ! Liquid and Ice Water Path
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZRADLP, ZRADIP
+ ! Cloud liquid water and ice effective radius
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZEFCL_RRTM, ZCLSW_TOTAL
+ ! effective LW nebulosity ( RRTM case)
+ ! and SW CLoud fraction for mixed phase clouds
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTAU_TOTAL, ZOMEGA_TOTAL, ZCG_TOTAL
+ ! effective optical thickness, single scattering albedo
+ ! and asymetry factor for mixed phase clouds
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZFLUX_SW_DOWN_CS, ZFLUX_SW_UP_CS
+ ! Clear-Sky DowNward and UPward SW Flux profiles
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZFLUX_LW_CS
+ ! Thicknes of the mesh
+REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZDZ
+!
+REAL, DIMENSION(KDLON,KFLEV) :: ZZDTSW ! SW diabatic heating
+REAL, DIMENSION(KDLON,KFLEV) :: ZZDTLW ! LW diabatic heating
+REAL, DIMENSION(KDLON) :: ZZTGVIS! SW surface flux in the VIS band
+REAL, DIMENSION(KDLON) :: ZZTGNIR! SW surface flux in the NIR band
+REAL, DIMENSION(KDLON) :: ZZTGIR ! LW surface flux in the IR bands
+REAL, DIMENSION(KDLON,SIZE(PSRFSWD_DIR,3)) :: ZZSFSWDIR
+! ! SW direct surface flux
+REAL, DIMENSION(KDLON,SIZE(PSRFSWD_DIR,3)) :: ZZSFSWDIF
+! ! SW diffuse surface flux
+!
+REAL, DIMENSION(KDLON) :: ZCLOUD ! vertically summed cloud fraction
+!
+REAL, DIMENSION(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)) :: ZEXNT ! Exner function
+REAL, DIMENSION(SIZE(PTHT,1),SIZE(PTHT,2)) :: ZLWD ! surface Downward LW flux
+REAL, DIMENSION(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PSRFSWD_DIR,3)) :: ZSWDDIR ! surface
+REAL, DIMENSION(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PSRFSWD_DIR,3)) :: ZSWDDIF ! surface Downward SW diffuse flux
+REAL, DIMENSION(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3),KSWB_OLD) :: ZPIZAZ ! Aerosols SSA
+REAL, DIMENSION(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3),KSWB_OLD) :: ZTAUAZ ! Aerosols Optical Detph
+REAL, DIMENSION(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3),KSWB_OLD) :: ZCGAZ ! Aerosols Asymetric factor
+REAL :: ZZTGVISC ! downward surface SW flux (VIS band) for clear_sky
+REAL :: ZZTGNIRC ! downward surface SW flux (NIR band) for clear_sky
+REAL :: ZZTGIRC ! downward surface LW flux for clear_sky
+REAL, DIMENSION(SIZE(PSRFSWD_DIR,3)) :: ZZSFSWDIRC
+! ! downward surface SW direct flux for clear sky
+REAL, DIMENSION(SIZE(PSRFSWD_DIR,3)) :: ZZSFSWDIFC
+! ! downward surface SW diffuse flux for clear sky
+REAL, DIMENSION(KFLEV) :: ZT_CLEAR ! ensemble mean clear-sky temperature
+REAL, DIMENSION(KFLEV) :: ZP_CLEAR ! ensemble mean clear-sky temperature
+REAL, DIMENSION(KFLEV) :: ZQV_CLEAR ! ensemble mean clear-sky specific humidity
+REAL, DIMENSION(KFLEV) :: ZOZ_CLEAR ! ensemble mean clear-sky ozone
+REAL, DIMENSION(KFLEV) :: ZHP_CLEAR ! ensemble mean clear-sky half-lev. pression
+REAL, DIMENSION(KFLEV) :: ZHT_CLEAR ! ensemble mean clear-sky half-lev. temp.
+REAL, DIMENSION(KFLEV) :: ZDP_CLEAR ! ensemble mean clear-sky pressure thickness
+REAL, DIMENSION(KFLEV,KAER) :: ZAER_CLEAR ! ensemble mean clear-sky aerosols optical thickness
+REAL, DIMENSION(KSWB_MNH) :: ZALBP_CLEAR ! ensemble mean clear-sky surface albedo (parallel)
+REAL, DIMENSION(KSWB_MNH) :: ZALBD_CLEAR ! ensemble mean clear-sky surface albedo (diffuse)
+REAL :: ZEMIS_CLEAR ! ensemble mean clear-sky surface emissivity
+REAL :: ZEMIW_CLEAR ! ensemble mean clear-sky LW window
+REAL :: ZRMU0_CLEAR ! ensemble mean clear-sky MU0
+REAL :: ZTS_CLEAR ! ensemble mean clear-sky surface temperature.
+REAL :: ZLSM_CLEAR ! ensemble mean clear-sky land sea-mask
+REAL :: ZLAT_CLEAR,ZLON_CLEAR
+!
+!work arrays
+REAL, DIMENSION(:), ALLOCATABLE :: ZWORK1, ZWORK2, ZWORK3, ZWORK
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZWORK4, ZWORK1AER, ZWORK2AER, ZWORK_GRID
+LOGICAL, DIMENSION(SIZE(PTHT,1),SIZE(PTHT,2)) :: ZWORKL
+!
+! split arrays used to split the memory required by the ECMWF_radiation
+! subroutine, the fields have the same meaning as their complete counterpart
+!
+REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZALBP_SPLIT, ZALBD_SPLIT
+REAL(KIND=JPRB), DIMENSION(:), ALLOCATABLE :: ZEMIS_SPLIT, ZEMIW_SPLIT
+REAL(KIND=JPRB), DIMENSION(:), ALLOCATABLE :: ZRMU0_SPLIT
+REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZCFAVE_SPLIT
+REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZO3AVE_SPLIT
+REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZT_HL_SPLIT
+REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZPRES_HL_SPLIT
+REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZTAVE_SPLIT
+REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZPAVE_SPLIT
+REAL(KIND=JPRB), DIMENSION(:,:,:), ALLOCATABLE :: ZAER_SPLIT
+REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZDPRES_SPLIT
+REAL(KIND=JPRB), DIMENSION(:), ALLOCATABLE :: ZLSM_SPLIT
+REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZQVAVE_SPLIT
+REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZQSAVE_SPLIT
+REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZQLAVE_SPLIT
+REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZQIAVE_SPLIT
+REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZQRAVE_SPLIT
+REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZQRWC_SPLIT
+REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZQLWC_SPLIT
+REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZQIWC_SPLIT
+REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZDZ_SPLIT
+REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZCCT_C2R2_SPLIT
+REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZCRT_C2R2_SPLIT
+REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZCIT_C1R3_SPLIT
+REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZCCT_LIMA_SPLIT
+REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZCRT_LIMA_SPLIT
+REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZCIT_LIMA_SPLIT
+REAL(KIND=JPRB), DIMENSION(:), ALLOCATABLE :: ZTS_SPLIT
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZSFSWDIR_SPLIT
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZSFSWDIF_SPLIT
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZNFLW_CS_SPLIT
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZNFLW_SPLIT
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZNFSW_CS_SPLIT
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZNFSW_SPLIT
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZDTLW_SPLIT
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZDTSW_SPLIT
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZFLUX_TOP_GND_IRVISNIR_SPLIT
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZFLUX_SW_DOWN_SPLIT
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZFLUX_SW_UP_SPLIT
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZFLUX_LW_SPLIT
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZDTLW_CS_SPLIT
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZDTSW_CS_SPLIT
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZFLUX_TOP_GND_IRVISNIR_CS_SPLIT
+REAL, DIMENSION(:), ALLOCATABLE :: ZPLAN_ALB_VIS_SPLIT
+REAL, DIMENSION(:), ALLOCATABLE :: ZPLAN_ALB_NIR_SPLIT
+REAL, DIMENSION(:), ALLOCATABLE :: ZPLAN_TRA_VIS_SPLIT
+REAL, DIMENSION(:), ALLOCATABLE :: ZPLAN_TRA_NIR_SPLIT
+REAL, DIMENSION(:), ALLOCATABLE :: ZPLAN_ABS_VIS_SPLIT
+REAL, DIMENSION(:), ALLOCATABLE :: ZPLAN_ABS_NIR_SPLIT
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZEFCL_LWD_SPLIT
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZEFCL_LWU_SPLIT
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZFLWP_SPLIT
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZFIWP_SPLIT
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZRADLP_SPLIT
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZRADIP_SPLIT
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZEFCL_RRTM_SPLIT
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZCLSW_TOTAL_SPLIT
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTAU_TOTAL_SPLIT
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZOMEGA_TOTAL_SPLIT
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZCG_TOTAL_SPLIT
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZFLUX_SW_DOWN_CS_SPLIT
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZFLUX_SW_UP_CS_SPLIT
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZFLUX_LW_CS_SPLIT
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZPIZA_EQ_TMP !Single scattering albedo of aerosols (lon,lat,lev,wvl)
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZIR !Real part of the aerosol refractive index(lon,lat,lev,wvl)
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZII !Imaginary part of the aerosol refractive index (lon,lat,lev,wvl)
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZCGA_EQ_TMP !Assymetry factor aerosols (lon,lat,lev,wvl)
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZTAUREL_EQ_TMP !tau/tau_{550} aerosols (lon,lat,lev,wvl)
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZPIZA_DST_TMP !Single scattering albedo of dust (lon,lat,lev,wvl)
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZCGA_DST_TMP !Assymetry factor dust (lon,lat,lev,wvl)
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZTAUREL_DST_TMP !tau/tau_{550} dust (lon,lat,lev,wvl)
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZPIZA_AER_TMP !Single scattering albedo of aerosol from ORILAM (lon,lat,lev,wvl)
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZCGA_AER_TMP !Assymetry factor aerosol from ORILAM (lon,lat,lev,wvl)
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZTAUREL_AER_TMP !tau/tau_{550} aerosol from ORILAM (lon,lat,lev,wvl)
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZPIZA_SLT_TMP !Single scattering albedo of sea salt (lon,lat,lev,wvl)
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZCGA_SLT_TMP !Assymetry factor of sea salt (lon,lat,lev,wvl)
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZTAUREL_SLT_TMP !tau/tau_{550} of sea salt (lon,lat,lev,wvl)
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: PAER_AER !tau/tau_{550} aerosol from ORILAM (lon,lat,lev,wvl)
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: PAER_SLT !tau/tau_{550} sea salt (lon,lat,lev,wvl)
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: PAER_DST !tau/tau_{550} dust (lon,lat,lev,wvl)
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTAU550_EQ_TMP !tau/tau_{550} aerosols (lon,lat,lev,wvl)
+REAL(KIND=JPRB), DIMENSION(:,:,:), ALLOCATABLE :: ZPIZA_EQ !Single scattering albedo of aerosols (points,lev,wvl)
+REAL(KIND=JPRB), DIMENSION(:,:,:), ALLOCATABLE :: ZCGA_EQ !Assymetry factor aerosols (points,lev,wvl)
+REAL(KIND=JPRB), DIMENSION(:,:,:), ALLOCATABLE :: ZTAUREL_EQ !tau/tau_{550} aerosols (points,lev,wvl)
+REAL(KIND=JPRB), DIMENSION(:,:,:), ALLOCATABLE :: ZPIZA_EQ_SPLIT !Single scattering albedo of aerosols (points,lev,wvl)
+REAL(KIND=JPRB), DIMENSION(:,:,:), ALLOCATABLE :: ZCGA_EQ_SPLIT !Assymetry factor aerosols (points,lev,wvl)
+REAL(KIND=JPRB), DIMENSION(:,:,:), ALLOCATABLE :: ZTAUREL_EQ_SPLIT !tau/tau_{550} aerosols (points,lev,wvl)
+REAL, DIMENSION(KFLEV,KSWB_OLD) :: ZPIZA_EQ_CLEAR !Single scattering albedo of aerosols (lev,wvl)
+REAL, DIMENSION(KFLEV,KSWB_OLD) :: ZCGA_EQ_CLEAR !Assymetry factor aerosols (lev,wvl)
+REAL, DIMENSION(KFLEV,KSWB_OLD) :: ZTAUREL_EQ_CLEAR !tau/tau_{550} aerosols (lev,wvl)
+INTEGER :: WVL_IDX !Counter for wavelength
+
+!
+INTEGER :: JI_SPLIT ! loop on the split array
+INTEGER :: INUM_CALL ! number of CALL of the radiation scheme
+INTEGER :: IDIM_EFF ! effective number of air-columns to compute
+INTEGER :: IDIM_RESIDUE ! number of remaining air-columns to compute
+INTEGER :: IBEG, IEND ! auxiliary indices
+!
+!
+REAL, DIMENSION(SIZE(PDTHRAD,1),SIZE(PDTHRAD,2),SIZE(PDTHRAD,3)) &
+ :: ZDTRAD_LW! LW temperature tendency
+REAL, DIMENSION(SIZE(PDTHRAD,1),SIZE(PDTHRAD,2),SIZE(PDTHRAD,3)) &
+ :: ZDTRAD_SW! SW temperature tendency
+INTEGER :: ILUOUT ! Logical unit number for output-listing
+INTEGER :: IRESP ! Return code of FM routines
+REAL, DIMENSION(SIZE(PDTHRAD,1),SIZE(PDTHRAD,2),SIZE(PDTHRAD,3)) &
+ :: ZSTORE_3D, ZSTORE_3D2! 3D work array for storage
+REAL, DIMENSION(SIZE(PDTHRAD,1),SIZE(PDTHRAD,2)) &
+ :: ZSTORE_2D ! 2D work array for storage!
+INTEGER :: JBAND ! Solar band index
+CHARACTER (LEN=4), DIMENSION(KSWB_OLD) :: YBAND_NAME ! Solar band name
+CHARACTER (LEN=2) :: YDIR ! Type of the data field
+!
+INTEGER :: ISWB ! number of SW spectral bands (between radiations and surface schemes)
+INTEGER :: JSWB ! loop on SW spectral bands
+INTEGER :: JAE ! loop on aerosol class
+TYPE(TFIELDMeTaDATA) :: TZFIELD2D, TZFIELD3D
+!
+REAL, DIMENSION(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)) :: ZDZPABST
+REAL :: ZMINVAL
+INTEGER, DIMENSION(3) :: IMINLOC
+INTEGER :: IINFO_ll
+LOGICAL, DIMENSION(SIZE(PTHT,1),SIZE(PTHT,2)) :: GCLOUD_SURF
+!
+REAL(KIND=JPRB), DIMENSION(:), ALLOCATABLE :: ZLON,ZLAT
+REAL(KIND=JPRB), DIMENSION(:), ALLOCATABLE :: ZLON_SPLIT,ZLAT_SPLIT
+!
+INTEGER :: ICLEAR_COL_ll
+INTEGER, DIMENSION(:), ALLOCATABLE :: INDEX_ICLEAR_COL
+REAL, DIMENSION(KFLEV) :: ZT_CLEAR_DD ! ensemble mean clear-sky temperature
+REAL :: ZCLEAR_COL_ll , ZDLON_ll
+!-------------------------------------------------------------------------
+!-------------------------------------------------------------------------
+!-------------------------------------------------------------------------
+!
+!* 1. COMPUTE DIMENSIONS OF ARRAYS AND OTHER INDICES
+! ----------------------------------------------
+!
+CALL GET_INDICE_ll (IIB,IJB,IIE,IJE) ! this definition must be coherent with
+ ! the one used in ini_radiations routine
+IKU = SIZE(PTHT,3)
+IKB = 1 + JPVEXT
+IKE = IKU - JPVEXT
+!
+IKSTAE = SIZE(PSTATM,1)
+IKUP = IKE-JPVEXT+1
+!
+ISWB = SIZE(PSRFSWD_DIR,3)
+!
+!-------------------------------------------------------------------------------
+!* 1.1 CHECK PRESSURE DECREASING
+! -------------------------
+ZDZPABST(:,:,1:IKU-1) = PPABST(:,:,1:IKU-1) - PPABST(:,:,2:IKU)
+ZDZPABST(:,:,IKU) = ZDZPABST(:,:,IKU-1)
+!
+ZMINVAL=MIN_ll(ZDZPABST,IINFO_ll)
+!
+IF ( ZMINVAL <= 0.0 ) THEN
+ ILUOUT = TLUOUT%NLU
+ IMINLOC=GMINLOC_ll( ZDZPABST )
+ WRITE(ILUOUT,*) ' radiation.f90 STOP :: SOMETHING WRONG WITH PRESSURE , ZDZPABST <= 0.0 '
+ WRITE(ILUOUT,*) ' radiation :: ZDZPABST ', ZMINVAL,' located at ', IMINLOC
+ FLUSH(unit=ILUOUT)
+ call Print_msg( NVERB_FATAL, 'GEN', 'RADIATIONS', 'something wrong with pressure: ZDZPABST <= 0.0' )
+
+ENDIF
+!------------------------------------------------------------------------------
+ALLOCATE(ZLAT(KDLON))
+ALLOCATE(ZLON(KDLON))
+IF(LCARTESIAN) THEN
+ ZLAT(:) = XLAT0*(XPI/180.)
+ ZLON(:) = XLON0*(XPI/180.)
+ELSE
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZLAT(IIJ) = XLAT(JI,JJ)*(XPI/180.)
+ ZLON(IIJ) = XLON(JI,JJ)*(XPI/180.)
+ END DO
+ END DO
+END IF
+!-------------------------------------------------------------------------------
+!
+!* 2. INITIALIZES THE MEAN-LAYER VARIABLES
+! ------------------------------------
+!
+ZEXNT(:,:,:)= ( PPABST(:,:,:)/XP00 ) ** (XRD/XCPD)
+!
+! Columns where radiation is computed are put on a single line
+ALLOCATE(ZTAVE(KDLON,KFLEV))
+ALLOCATE(ZQVAVE(KDLON,KFLEV))
+ALLOCATE(ZQLAVE(KDLON,KFLEV))
+ALLOCATE(ZQIAVE(KDLON,KFLEV))
+ALLOCATE(ZCFAVE(KDLON,KFLEV))
+ALLOCATE(ZQRAVE(KDLON,KFLEV))
+ALLOCATE(ZQLWC(KDLON,KFLEV))
+ALLOCATE(ZQIWC(KDLON,KFLEV))
+ALLOCATE(ZQRWC(KDLON,KFLEV))
+ALLOCATE(ZDZ(KDLON,KFLEV))
+!
+ZQVAVE(:,:) = 0.0
+ZQLAVE(:,:) = 0.0
+ZQIAVE(:,:) = 0.0
+ZQRAVE(:,:) = 0.0
+ZCFAVE(:,:) = 0.0
+ZQLWC(:,:) = 0.0
+ZQIWC(:,:) = 0.0
+ZQRWC(:,:) = 0.0
+ZDZ(:,:)=0.0
+!
+!COMPUTE THE MESH SIZE
+DO JK=IKB,IKE
+ JKRAD = JK-JPVEXT
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZDZ(IIJ,JKRAD) = PZZ(JI,JJ,JK+1) - PZZ(JI,JJ,JK)
+ ZTAVE(IIJ,JKRAD) = PTHT(JI,JJ,JK)*ZEXNT(JI,JJ,JK) ! Conversion potential temperature -> actual temperature
+ END DO
+ END DO
+END DO
+!
+! Check if the humidity mixing ratio is available
+!
+IF( SIZE(PRT(:,:,:,:),4) >= 1 ) THEN
+ DO JK=IKB,IKE
+ JKRAD = JK-JPVEXT
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZQVAVE(IIJ,JKRAD) =MAX(0., PRT(JI,JJ,JK,1))
+ END DO
+ END DO
+ END DO
+END IF
+!
+! Check if the cloudwater mixing ratio is available
+!
+IF( SIZE(PRT(:,:,:,:),4) >= 2 ) THEN
+ DO JK=IKB,IKE
+ JKRAD = JK-JPVEXT
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZQLAVE(IIJ,JKRAD) = MAX(0.,PRT(JI,JJ,JK,2))
+ ZQLWC(IIJ,JKRAD) = MAX(0.,PRT(JI,JJ,JK,2)*PRHODREF(JI,JJ,JK))
+ ZCFAVE(IIJ,JKRAD) = PCLDFR(JI,JJ,JK)
+ END DO
+ END DO
+ END DO
+END IF
+!
+! Check if the rainwater mixing ratio is available
+!
+IF( SIZE(PRT(:,:,:,:),4) >= 3 ) THEN
+ DO JK=IKB,IKE
+ JKRAD = JK-JPVEXT
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZQRWC(IIJ,JKRAD) = MAX(0.,PRT(JI,JJ,JK,3)*PRHODREF(JI,JJ,JK))
+ ZQRAVE(IIJ,JKRAD) = MAX(0.,PRT(JI,JJ,JK,3))
+ END DO
+ END DO
+ END DO
+END IF
+!
+! Check if the cloudice mixing ratio is available
+!
+IF( SIZE(PRT(:,:,:,:),4) >= 4 ) THEN
+ DO JK=IKB,IKE
+ JKRAD = JK-JPVEXT
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZQIWC(IIJ,JKRAD) = MAX(0.,PRT(JI,JJ,JK,4)*PRHODREF(JI,JJ,JK))
+! ZQIAVE(IIJ,JKRAD) = MAX( PRT(JI,JJ,JK,4)-XRTMIN(4),0.0 )
+ ZQIAVE(IIJ,JKRAD) = MAX( PRT(JI,JJ,JK,4),0.0 )
+ END DO
+ END DO
+ END DO
+END IF
+!
+! Standard atmosphere extension
+!
+DO JK=IKUP,KFLEV
+ JK1 = (KSTATM-1)+(JK-IKUP)
+ JK2 = JK1+1
+ ZTAVE(:,JK) = 0.5*( PSTATM(JK1,3)+PSTATM(JK2,3) )
+ ZQVAVE(:,JK) = 0.5*( PSTATM(JK1,5)/PSTATM(JK1,4)+ &
+ PSTATM(JK2,5)/PSTATM(JK2,4) )
+END DO
+!
+! 2.1 pronostic water concentation fields (C2R2 coupling)
+!
+IF( NSV_C2R2 /= 0 ) THEN
+ ALLOCATE (ZCCT_C2R2(KDLON, KFLEV))
+ ALLOCATE (ZCRT_C2R2(KDLON, KFLEV))
+ ZCCT_C2R2(:, :) = 0.
+ ZCRT_C2R2 (:,:) = 0.
+ DO JK=IKB,IKE
+ JKRAD = JK-JPVEXT
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZCCT_C2R2 (IIJ,JKRAD) = MAX(0.,PSVT(JI,JJ,JK,NSV_C2R2BEG+1))
+ ZCRT_C2R2 (IIJ,JKRAD) = MAX(0.,PSVT(JI,JJ,JK,NSV_C2R2BEG+2))
+ END DO
+ END DO
+ END DO
+ELSE
+ ALLOCATE (ZCCT_C2R2(0,0))
+ ALLOCATE (ZCRT_C2R2(0,0))
+END IF
+!
+IF( NSV_C1R3 /= 0 ) THEN
+ ALLOCATE (ZCIT_C1R3(KDLON, KFLEV))
+ ZCIT_C1R3 (:,:) = 0.
+ DO JK=IKB,IKE
+ JKRAD = JK-JPVEXT
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZCIT_C1R3 (IIJ,JKRAD) = MAX(0.,PSVT(JI,JJ,JK,NSV_C1R3BEG))
+ END DO
+ END DO
+ END DO
+ELSE
+ ALLOCATE (ZCIT_C1R3(0,0))
+END IF
+!
+!
+! 2.1*bis pronostic water concentation fields (LIMA coupling)
+!
+IF( CCLOUD == 'LIMA' ) THEN
+ ALLOCATE (ZCCT_LIMA(KDLON, KFLEV))
+ ALLOCATE (ZCRT_LIMA(KDLON, KFLEV))
+ ALLOCATE (ZCIT_LIMA(KDLON, KFLEV))
+ ZCCT_LIMA(:, :) = 0.
+ ZCRT_LIMA (:,:) = 0.
+ ZCIT_LIMA (:,:) = 0.
+ DO JK=IKB,IKE
+ JKRAD = JK-JPVEXT
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ IF (NMOM_C.GE.2) ZCCT_LIMA(IIJ,JKRAD) = MAX(0.,PSVT(JI,JJ,JK,NSV_LIMA_NC))
+ IF (NMOM_R.GE.2) ZCRT_LIMA(IIJ,JKRAD) = MAX(0.,PSVT(JI,JJ,JK,NSV_LIMA_NR))
+ IF (NMOM_I.GE.2) ZCIT_LIMA(IIJ,JKRAD) = MAX(0.,PSVT(JI,JJ,JK,NSV_LIMA_NI))
+ END DO
+ END DO
+ END DO
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+!* 3. INITIALIZES THE HALF-LEVEL VARIABLES
+! ------------------------------------
+!
+ALLOCATE(ZPRES_HL(KDLON,KFLEV+1))
+ALLOCATE(ZT_HL(KDLON,KFLEV+1))
+!
+DO JK=IKB,IKE+1
+ JKRAD = JK-JPVEXT
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZPRES_HL(IIJ,JKRAD) = XP00 * (0.5*(ZEXNT(JI,JJ,JK)+ZEXNT(JI,JJ,JK-1)))**(XCPD/XRD)
+ END DO
+ END DO
+END DO
+
+! Standard atmosphere extension - pressure
+!* begining at ikup+1 level allows to use a model domain higher than 50km
+!
+DO JK=IKUP+1,KFLEV+1
+ JK1 = (KSTATM-1)+(JK-IKUP)
+ ZPRES_HL(:,JK) = PSTATM(JK1,2)*100.0 ! mb -> Pa
+END DO
+!
+! Surface temperature at the first level
+! and surface radiative temperature
+ALLOCATE(ZTS(KDLON))
+!
+DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZT_HL(IIJ,1) = PTSRAD(JI,JJ)
+ ZTS(IIJ) = PTSRAD(JI,JJ)
+ END DO
+END DO
+!
+! Temperature at half levels
+!
+ZT_HL(:,2:IKE-JPVEXT) = 0.5*(ZTAVE(:,1:IKE-JPVEXT-1)+ZTAVE(:,2:IKE-JPVEXT))
+!
+DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZT_HL(IIJ,IKE-JPVEXT+1) = 0.5*PTHT(JI,JJ,IKE )*ZEXNT(JI,JJ,IKE ) &
+ + 0.5*PTHT(JI,JJ,IKE+1)*ZEXNT(JI,JJ,IKE+1)
+ END DO
+END DO
+!
+! Standard atmosphere extension - temperature
+!* begining at ikup+1 level allows to use a model domain higher than 50km
+!
+DO JK=IKUP+1,KFLEV+1
+ JK1 = (KSTATM-1)+(JK-IKUP)
+ ZT_HL(:,JK) = PSTATM(JK1,3)
+END DO
+!
+!mean layer pressure and layer differential pressure (from half level variables)
+!
+ALLOCATE(ZPAVE(KDLON,KFLEV))
+ALLOCATE(ZDPRES(KDLON,KFLEV))
+DO JKRAD=1,KFLEV
+ ZPAVE(:,JKRAD)=0.5*(ZPRES_HL(:,JKRAD)+ZPRES_HL(:,JKRAD+1))
+ ZDPRES(:,JKRAD)=ZPRES_HL(:,JKRAD)-ZPRES_HL(:,JKRAD+1)
+END DO
+!-----------------------------------------------------------------------
+!* 4. INITIALIZES THE AEROSOLS and OZONE PROFILES from climatology
+! -------------------------------------------
+!
+! 4.1 AEROSOL optical thickness
+! EXPL -> defined online, otherwise climatology
+IF (CAOP=='EXPL') THEN
+ GAOP = .TRUE.
+ELSE
+ GAOP = .FALSE.
+ENDIF
+!
+IF (CAOP=='EXPL') THEN
+ ALLOCATE(ZPIZA_EQ_TMP(SIZE(PAER,1),SIZE(PAER,2),SIZE(PAER,3),KSWB_OLD))
+ ALLOCATE(ZCGA_EQ_TMP(SIZE(PAER,1),SIZE(PAER,2),SIZE(PAER,3),KSWB_OLD))
+ ALLOCATE(ZTAUREL_EQ_TMP(SIZE(PAER,1),SIZE(PAER,2),SIZE(PAER,3),KSWB_OLD))
+
+ ALLOCATE(ZPIZA_DST_TMP(SIZE(PAER,1),SIZE(PAER,2),SIZE(PAER,3),KSWB_OLD))
+ ALLOCATE(ZCGA_DST_TMP(SIZE(PAER,1),SIZE(PAER,2),SIZE(PAER,3),KSWB_OLD))
+ ALLOCATE(ZTAUREL_DST_TMP(SIZE(PAER,1),SIZE(PAER,2),SIZE(PAER,3),KSWB_OLD))
+ ALLOCATE(PAER_DST(SIZE(PAER,1),SIZE(PAER,2),SIZE(PAER,3)))
+
+ ALLOCATE(ZPIZA_AER_TMP(SIZE(PAER,1),SIZE(PAER,2),SIZE(PAER,3),KSWB_OLD))
+ ALLOCATE(ZCGA_AER_TMP(SIZE(PAER,1),SIZE(PAER,2),SIZE(PAER,3),KSWB_OLD))
+ ALLOCATE(ZTAUREL_AER_TMP(SIZE(PAER,1),SIZE(PAER,2),SIZE(PAER,3),KSWB_OLD))
+ ALLOCATE(PAER_AER(SIZE(PAER,1),SIZE(PAER,2),SIZE(PAER,3)))
+
+ ALLOCATE(ZPIZA_SLT_TMP(SIZE(PAER,1),SIZE(PAER,2),SIZE(PAER,3),KSWB_OLD))
+ ALLOCATE(ZCGA_SLT_TMP(SIZE(PAER,1),SIZE(PAER,2),SIZE(PAER,3),KSWB_OLD))
+ ALLOCATE(ZTAUREL_SLT_TMP(SIZE(PAER,1),SIZE(PAER,2),SIZE(PAER,3),KSWB_OLD))
+ ALLOCATE(PAER_SLT(SIZE(PAER,1),SIZE(PAER,2),SIZE(PAER,3)))
+
+
+ ALLOCATE(ZII(SIZE(PSVT,1),SIZE(PSVT,2),SIZE(PSVT,3),KSWB_OLD))
+ ALLOCATE(ZIR(SIZE(PSVT,1),SIZE(PSVT,2),SIZE(PSVT,3),KSWB_OLD))
+
+ ZPIZA_EQ_TMP = 0.
+ ZCGA_EQ_TMP = 0.
+ ZTAUREL_EQ_TMP = 0.
+
+ ZPIZA_DST_TMP = 0.
+ ZCGA_DST_TMP = 0.
+ ZTAUREL_DST_TMP = 0
+
+ ZPIZA_SLT_TMP = 0.
+ ZCGA_SLT_TMP = 0.
+ ZTAUREL_SLT_TMP = 0
+
+ ZPIZA_AER_TMP = 0.
+ ZCGA_AER_TMP = 0.
+ ZTAUREL_AER_TMP = 0
+
+ PAER_DST=0.
+ PAER_SLT=0.
+ PAER_AER=0.
+
+ IF (LORILAM) THEN
+ CALL AEROOPT_GET( &
+ PSVT(IIB:IIE,IJB:IJE,:,NSV_AERBEG:NSV_AEREND) & !I [ppv] aerosols concentration
+ ,PZZ(IIB:IIE,IJB:IJE,:) & !I [m] height of layers
+ ,PRHODREF(IIB:IIE,IJB:IJE,:) & !I [kg/m3] density of air
+ ,ZPIZA_AER_TMP(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT,:) & !O [-] single scattering albedo of aerosols
+ ,ZCGA_AER_TMP(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT,:) & !O [-] assymetry factor for aerosols
+ ,ZTAUREL_AER_TMP(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT,:) & !O [-] opt.depth(wvl=lambda)/opt.depth(wvl=550nm)
+ ,PAER_AER(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT) & !O [-] optical depth of aerosols at wvl=550nm
+ ,KSWB_OLD & !I |nbr] number of shortwave bands
+ ,ZIR(IIB:IIE,IJB:IJE,:,:) & !O [-] opt.depth(wvl=lambda)/opt.depth(wvl=550nm)
+ ,ZII(IIB:IIE,IJB:IJE,:,:) & !O [-] opt.depth(wvl=lambda)/opt.depth(wvl=550nm)
+ )
+ ENDIF
+ IF(LDUST) THEN
+ CALL DUSTOPT_GET( &
+ PSVT(IIB:IIE,IJB:IJE,:,NSV_DSTBEG:NSV_DSTEND) & !I [ppv] Dust scalar concentration
+ ,PZZ(IIB:IIE,IJB:IJE,:) & !I [m] height of layers
+ ,PRHODREF(IIB:IIE,IJB:IJE,:) & !I [kg/m3] density of air
+ ,ZPIZA_DST_TMP(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT,:) & !O [-] single scattering albedo of dust
+ ,ZCGA_DST_TMP(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT,:) & !O [-] assymetry factor for dust
+ ,ZTAUREL_DST_TMP(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT,:) & !O [-] opt.depth(wvl=lambda)/opt.depth(wvl=550nm)
+ ,PAER_DST(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT) & !O [-] optical depth of dust at wvl=550nm
+ ,KSWB_OLD & !I |nbr] number of shortwave bands
+ )
+ DO WVL_IDX=1,KSWB_OLD
+ PDST_WL(:,:,:,WVL_IDX) = ZTAUREL_DST_TMP(:,:,:,WVL_IDX)* PAER(:,:,:,3)
+ ENDDO
+ ENDIF
+ IF(LSALT) THEN
+ CALL SALTOPT_GET( &
+ PSVT(IIB:IIE,IJB:IJE,:,NSV_SLTBEG:NSV_SLTEND) & !I [ppv] sea salt scalar concentration
+ ,PZZ(IIB:IIE,IJB:IJE,:) & !I [m] height of layers
+ ,PRHODREF(IIB:IIE,IJB:IJE,:) & !I [kg/m3] density of air
+ ,PTHT(IIB:IIE,IJB:IJE,:) & !I [K] potential temperature
+ ,PPABST(IIB:IIE,IJB:IJE,:) & !I [hPa] pressure
+ ,PRT(IIB:IIE,IJB:IJE,:,:) & !I [kg/kg] water mixing ratio
+ ,ZPIZA_SLT_TMP(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT,:) & !O [-] single scattering albedo of sea salt
+ ,ZCGA_SLT_TMP(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT,:) & !O [-] assymetry factor for sea salt
+ ,ZTAUREL_SLT_TMP(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT,:) & !O [-] opt.depth(wvl=lambda)/opt.depth(wvl=550nm)
+ ,PAER_SLT(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT) & !O [-] optical depth of sea salt at wvl=550nm
+ ,KSWB_OLD & !I |nbr] number of shortwave bands
+ )
+ ENDIF
+
+ ZTAUREL_EQ_TMP(:,:,:,:)=ZTAUREL_DST_TMP(:,:,:,:)+ZTAUREL_AER_TMP(:,:,:,:)+ZTAUREL_SLT_TMP(:,:,:,:)
+
+ PAER(:,:,:,2)=PAER_SLT(:,:,:)
+ PAER(:,:,:,3)=PAER_DST(:,:,:)
+ PAER(:,:,:,4)=PAER_AER(:,:,:)
+
+
+ WHERE (ZTAUREL_EQ_TMP(:,:,:,:).GT.0.0)
+ ZPIZA_EQ_TMP(:,:,:,:)=(ZPIZA_DST_TMP(:,:,:,:)*ZTAUREL_DST_TMP(:,:,:,:)+&
+ ZPIZA_AER_TMP(:,:,:,:)*ZTAUREL_AER_TMP(:,:,:,:)+&
+ ZPIZA_SLT_TMP(:,:,:,:)*ZTAUREL_SLT_TMP(:,:,:,:))/&
+ ZTAUREL_EQ_TMP(:,:,:,:)
+ END WHERE
+ WHERE ((ZTAUREL_EQ_TMP(:,:,:,:).GT.0.0).AND.(ZPIZA_EQ_TMP(:,:,:,:).GT.0.0))
+ ZCGA_EQ_TMP(:,:,:,:)=(ZPIZA_DST_TMP(:,:,:,:)*ZTAUREL_DST_TMP(:,:,:,:)*ZCGA_DST_TMP(:,:,:,:)+&
+ ZPIZA_AER_TMP(:,:,:,:)*ZTAUREL_AER_TMP(:,:,:,:)*ZCGA_AER_TMP(:,:,:,:)+&
+ ZPIZA_SLT_TMP(:,:,:,:)*ZTAUREL_SLT_TMP(:,:,:,:)*ZCGA_SLT_TMP(:,:,:,:))/&
+ (ZTAUREL_EQ_TMP(:,:,:,:)*ZPIZA_EQ_TMP(:,:,:,:))
+ END WHERE
+
+ ZTAUREL_EQ_TMP(:,:,:,:)=max(1.E-8,ZTAUREL_EQ_TMP(:,:,:,:))
+ ZCGA_EQ_TMP(:,:,:,:)=max(1.E-8,ZCGA_EQ_TMP(:,:,:,:))
+ ZPIZA_EQ_TMP(:,:,:,:)=max(1.E-8,ZPIZA_EQ_TMP(:,:,:,:))
+ PAER(:,:,:,3)=max(1.E-8,PAER(:,:,:,3))
+ ZPIZA_EQ_TMP(:,:,:,:)=min(0.99,ZPIZA_EQ_TMP(:,:,:,:))
+
+
+ENDIF
+!
+! Computes SSA, optical depth and assymetry factor for clear sky (aerosols)
+ZTAUAZ(:,:,:,:) = 0.
+ZPIZAZ(:,:,:,:) = 0.
+ZCGAZ(:,:,:,:) = 0.
+DO WVL_IDX=1,KSWB_OLD
+ DO JAE=1,KAER
+ !Special optical properties for dust
+ IF (CAOP=='EXPL'.AND.(JAE==3)) THEN
+ !Ponderation of aerosol optical in case of explicit optical factor
+ !ti
+ ZTAUAZ(IIB:IIE,IJB:IJE,IKB:IKE,WVL_IDX)= ZTAUAZ(IIB:IIE,IJB:IJE,IKB:IKE,WVL_IDX) + &
+ PAER(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT,JAE) * &
+ ZTAUREL_EQ_TMP(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT,WVL_IDX)
+ !wi*ti
+ ZPIZAZ(IIB:IIE,IJB:IJE,IKB:IKE,WVL_IDX)= ZPIZAZ(IIB:IIE,IJB:IJE,IKB:IKE,WVL_IDX) + &
+ PAER(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT,JAE) * &
+ ZTAUREL_EQ_TMP(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT,WVL_IDX) * &
+ ZPIZA_EQ_TMP(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT,WVL_IDX)
+ !wi*ti*gi
+ ZCGAZ(IIB:IIE,IJB:IJE,IKB:IKE,WVL_IDX) = ZCGAZ(IIB:IIE,IJB:IJE,IKB:IKE,WVL_IDX) + &
+ PAER(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT,JAE) * &
+ ZTAUREL_EQ_TMP(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT,WVL_IDX) * &
+ ZPIZA_EQ_TMP(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT,WVL_IDX) * &
+ ZCGA_EQ_TMP(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT,WVL_IDX)
+ ELSE
+
+ !Ponderation of aerosol optical properties
+ !ti
+ ZTAUAZ(IIB:IIE,IJB:IJE,IKB:IKE,WVL_IDX)=ZTAUAZ(IIB:IIE,IJB:IJE,IKB:IKE,WVL_IDX)+&
+ PAER(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT,JAE) * RTAUA(WVL_IDX,JAE)
+ !wi*ti
+ ZPIZAZ(IIB:IIE,IJB:IJE,IKB:IKE,WVL_IDX)=ZPIZAZ(IIB:IIE,IJB:IJE,IKB:IKE,WVL_IDX)+&
+ PAER(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT,JAE) *&
+ RTAUA(WVL_IDX,JAE)*RPIZA(WVL_IDX,JAE)
+ !wi*ti*gi
+ ZCGAZ(IIB:IIE,IJB:IJE,IKB:IKE,WVL_IDX) = ZCGAZ(IIB:IIE,IJB:IJE,IKB:IKE,WVL_IDX) +&
+ PAER(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT,JAE) *&
+ RTAUA(WVL_IDX,JAE)*RPIZA(WVL_IDX,JAE)*RCGA(WVL_IDX,JAE)
+ ENDIF
+ ENDDO
+! assymetry factor:
+
+ZCGAZ(IIB:IIE,IJB:IJE,IKB:IKE,WVL_IDX) = ZCGAZ(IIB:IIE,IJB:IJE,IKB:IKE,WVL_IDX) / &
+ ZPIZAZ(IIB:IIE,IJB:IJE,IKB:IKE,WVL_IDX)
+! SSA:
+ZPIZAZ(IIB:IIE,IJB:IJE,IKB:IKE,WVL_IDX) = ZPIZAZ(IIB:IIE,IJB:IJE,IKB:IKE,WVL_IDX) / &
+ ZTAUAZ(IIB:IIE,IJB:IJE,IKB:IKE,WVL_IDX)
+ENDDO
+!
+
+!
+ALLOCATE(ZAER(KDLON,KFLEV,KAER))
+! Aerosol classes
+! 1=Continental 2=Maritime 3=Desert 4=Urban 5=Volcanic 6=Stratos.Bckgnd
+! Loaded from climatology
+DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZAER (IIJ,:,:) = PAER_CLIM (JI,JJ,:,:)
+ END DO
+END DO
+IF ((CAOP=='EXPL') .AND. LDUST ) THEN
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZAER (IIJ,:,3) = PAER (JI,JJ,:,3)
+ END DO
+ END DO
+END IF
+IF ((CAOP=='EXPL') .AND. LSALT ) THEN
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZAER (IIJ,:,2) = PAER (JI,JJ,:,2)
+ END DO
+ END DO
+END IF
+IF ((CAOP=='EXPL') .AND. LORILAM ) THEN
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZAER (IIJ,:,4) = PAER (JI,JJ,:,4)
+ END DO
+ END DO
+END IF
+!
+ALLOCATE(ZPIZA_EQ(KDLON,KFLEV,KSWB_OLD))
+ALLOCATE(ZCGA_EQ(KDLON,KFLEV,KSWB_OLD))
+ALLOCATE(ZTAUREL_EQ(KDLON,KFLEV,KSWB_OLD))
+IF(CAOP=='EXPL')THEN
+ !Transform from vector of type #lon #lat #lev #wvl
+ !to vectors of type #points, #levs, #wavelengths
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZPIZA_EQ(IIJ,:,:) = ZPIZA_EQ_TMP(JI,JJ,:,:)
+ ZCGA_EQ(IIJ,:,:)= ZCGA_EQ_TMP(JI,JJ,:,:)
+ ZTAUREL_EQ(IIJ,:,:)=ZTAUREL_EQ_TMP(JI,JJ,:,:)
+ END DO
+ END DO
+ DEALLOCATE(ZPIZA_EQ_TMP)
+ DEALLOCATE(ZCGA_EQ_TMP)
+ DEALLOCATE(ZTAUREL_EQ_TMP)
+ DEALLOCATE(ZPIZA_DST_TMP)
+ DEALLOCATE(ZCGA_DST_TMP)
+ DEALLOCATE(ZTAUREL_DST_TMP)
+ DEALLOCATE(ZPIZA_AER_TMP)
+ DEALLOCATE(ZCGA_AER_TMP)
+ DEALLOCATE(ZTAUREL_AER_TMP)
+ DEALLOCATE(ZPIZA_SLT_TMP)
+ DEALLOCATE(ZCGA_SLT_TMP)
+ DEALLOCATE(ZTAUREL_SLT_TMP)
+ DEALLOCATE(PAER_DST)
+ DEALLOCATE(PAER_AER)
+ DEALLOCATE(PAER_SLT)
+ DEALLOCATE(ZIR)
+ DEALLOCATE(ZII)
+END IF
+
+
+!
+! 4.2 OZONE content
+!
+ALLOCATE(ZO3AVE(KDLON,KFLEV))
+!
+DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZO3AVE(IIJ,:) = POZON (JI,JJ,:)
+ END DO
+END DO
+#ifdef MNH_ECRAD
+#if ( VER_ECRAD == 140 )
+POZON = POZON
+#endif
+#endif
+!
+!-------------------------------------------------------------------------------
+!
+!* 5. CALLS THE E.C.M.W.F. RADIATION CODE
+! -----------------------------------
+!
+!
+!* 5.1 INITIALIZES 2D AND SURFACE FIELDS
+!
+ALLOCATE(ZRMU0(KDLON))
+ALLOCATE(ZLSM(KDLON))
+!
+ALLOCATE(ZALBP(KDLON,KSWB_MNH))
+ALLOCATE(ZALBD(KDLON,KSWB_MNH))
+!
+ALLOCATE(ZEMIS(KDLON,KLWB_MNH))
+ALLOCATE(ZEMIW(KDLON,KLWB_MNH))
+!
+DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZEMIS(IIJ,:) = PEMIS(JI,JJ,:)
+ ZRMU0(IIJ) = PCOSZEN(JI,JJ)
+ ZLSM(IIJ) = 1.0 - PSEA(JI,JJ)
+ END DO
+END DO
+!
+! spectral albedo
+!
+IF ( SIZE(PDIR_ALB,3)==1 ) THEN
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ! sw direct and diffuse albedos
+ ZALBP(IIJ,:) = PDIR_ALB(JI,JJ,1)
+ ZALBD(IIJ,:) = PSCA_ALB(JI,JJ,1)
+ !
+ END DO
+ END DO
+ELSE
+ DO JK=1, SIZE(PDIR_ALB,3)
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ! sw direct and diffuse albedos
+ ZALBP(IIJ,JK) = PDIR_ALB(JI,JJ,JK)
+ ZALBD(IIJ,JK) = PSCA_ALB(JI,JJ,JK)
+ ENDDO
+ END DO
+ ENDDO
+END IF
+!
+!
+! LW emissivity
+ZEMIW(:,:)= ZEMIS(:,:)
+!
+!solar constant
+ZRII0= PCORSOL*XI0 ! solar constant multiplied by seasonal variations due to Earth-Sun distance
+!
+!
+!* 5.2 ACCOUNTS FOR THE CLEAR-SKY APPROXIMATION
+!
+! Performs the horizontal average of the fields when no cloud
+!
+ZCLOUD(:) = SUM( ZCFAVE(:,:),DIM=2 ) ! one where no cloud on the vertical
+!
+! MODIF option CLLY
+ALLOCATE ( ICLEAR_2D_TM1(KDLON) )
+!
+DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ICLEAR_2D_TM1(IIJ) = KCLEARCOL_TM1(JI,JJ)
+ END DO
+END DO
+!
+IF(OCLOUD_ONLY .OR. OCLEAR_SKY) THEN
+ !
+ GCLEAR_2D(:) = .TRUE.
+ WHERE( (ZCLOUD(:) > 0.0) .OR. (ICLEAR_2D_TM1(:)==0) ) ! FALSE on cloudy columns
+ GCLEAR_2D(:) = .FALSE.
+ END WHERE
+ !
+ ICLEAR_COL = COUNT( GCLEAR_2D(:) ) ! number of clear sky columns
+ !
+ ALLOCATE(INDEX_ICLEAR_COL(ICLEAR_COL))
+ IIJ = 0
+ DO JI=1,KDLON
+ IF ( GCLEAR_2D(JI) ) THEN
+ IIJ = IIJ + 1
+ INDEX_ICLEAR_COL(IIJ) = JI
+ END IF
+ END DO
+
+ IF( ICLEAR_COL == KDLON ) THEN ! No cloud case so only the mean clear-sky
+!!$ GCLEAR_2D(1) = .FALSE. ! column is selected
+!!$ ICLEAR_COL = KDLON-1
+ GNOCL = .TRUE. ! TRUE if no cloud at all
+ ELSE
+ GNOCL = .FALSE.
+ END IF
+
+ GCLEAR(:,:) = SPREAD( GCLEAR_2D(:),DIM=2,NCOPIES=KFLEV ) ! vertical extension of clear columns 2D map
+ ICLOUD_COL = KDLON - ICLEAR_COL ! number of cloudy columns
+!
+ ZCLEAR_COL_ll = REAL(ICLEAR_COL)
+ CALL REDUCESUM_ll(ZCLEAR_COL_ll,IINFO_ll)
+ !ZDLON_ll = KDLON
+ !CALL REDUCESUM_ll(ZDLON_ll,IINFO_ll)
+
+ !IF (IP == 1 )
+ !print*,",RADIATIOn COULD_ONLY=OCLOUD_ONLY,OCLEAR_SKY,ZCLEAR_COL_ll,ICLEAR_COL,ICLOUD_COL,KDON,ZDLON_ll,GNOCL=", &
+ ! OCLOUD_ONLY,OCLEAR_SKY,ZCLEAR_COL_ll,ICLEAR_COL,ICLOUD_COL,KDLON,ZDLON_ll,GNOCL
+!
+!!$ IF( ICLEAR_COL /=0 ) THEN ! at least one clear-sky column exists -> average profiles on clear columns
+ IF( ZCLEAR_COL_ll /= 0.0 ) THEN ! at least one clear-sky column exists -> average profiles on clear columns
+ ZT_CLEAR(:) = SUM_DD_R2_R1_ll(ZTAVE(INDEX_ICLEAR_COL(:),:)) / ZCLEAR_COL_ll
+ ZP_CLEAR(:) = SUM_DD_R2_R1_ll(ZPAVE(INDEX_ICLEAR_COL(:),:)) / ZCLEAR_COL_ll
+ ZQV_CLEAR(:) = SUM_DD_R2_R1_ll(REAL(ZQVAVE(INDEX_ICLEAR_COL(:),:))) / ZCLEAR_COL_ll
+ ZOZ_CLEAR(:) = SUM_DD_R2_R1_ll(REAL(ZO3AVE(INDEX_ICLEAR_COL(:),:))) / ZCLEAR_COL_ll
+ ZDP_CLEAR(:) = SUM_DD_R2_R1_ll(REAL(ZDPRES(INDEX_ICLEAR_COL(:),:))) / ZCLEAR_COL_ll
+
+ DO JK1=1,KAER
+ ZAER_CLEAR(:,JK1) = SUM_DD_R2_R1_ll(REAL(ZAER(INDEX_ICLEAR_COL(:),:,JK1))) / ZCLEAR_COL_ll
+ END DO
+ !Get an average value for the clear column
+ IF(CAOP=='EXPL')THEN
+ DO WVL_IDX=1,KSWB_OLD
+ ZPIZA_EQ_CLEAR(:,WVL_IDX) = SUM_DD_R2_R1_ll(REAL(ZPIZA_EQ( INDEX_ICLEAR_COL(:),:,WVL_IDX))) / ZCLEAR_COL_ll
+ ZCGA_EQ_CLEAR(:,WVL_IDX) = SUM_DD_R2_R1_ll(REAL(ZCGA_EQ( INDEX_ICLEAR_COL(:),:,WVL_IDX))) / ZCLEAR_COL_ll
+ ZTAUREL_EQ_CLEAR(:,WVL_IDX) = SUM_DD_R2_R1_ll(REAL(ZTAUREL_EQ(INDEX_ICLEAR_COL(:),:,WVL_IDX))) / ZCLEAR_COL_ll
+ ENDDO
+ ENDIF
+ !
+ ZHP_CLEAR(1:KFLEV) = SUM_DD_R2_R1_ll(REAL(ZPRES_HL(INDEX_ICLEAR_COL(:),1:KFLEV))) / ZCLEAR_COL_ll
+ ZHT_CLEAR(1:KFLEV) = SUM_DD_R2_R1_ll(REAL(ZT_HL (INDEX_ICLEAR_COL(:),1:KFLEV))) / ZCLEAR_COL_ll
+ !
+ ZALBP_CLEAR(:) = SUM_DD_R2_R1_ll(REAL(ZALBP(INDEX_ICLEAR_COL(:),:))) / ZCLEAR_COL_ll
+ ZALBD_CLEAR(:) = SUM_DD_R2_R1_ll(REAL(ZALBD(INDEX_ICLEAR_COL(:),:))) / ZCLEAR_COL_ll
+ !
+ ZEMIS_CLEAR = SUM_DD_R1_ll(REAL(ZEMIS(INDEX_ICLEAR_COL(:),1))) / ZCLEAR_COL_ll
+ ZEMIW_CLEAR = SUM_DD_R1_ll(REAL(ZEMIW(INDEX_ICLEAR_COL(:),1))) / ZCLEAR_COL_ll
+ ZRMU0_CLEAR = SUM_DD_R1_ll(REAL(ZRMU0(INDEX_ICLEAR_COL(:)))) / ZCLEAR_COL_ll
+ ZTS_CLEAR = SUM_DD_R1_ll(REAL(ZTS(INDEX_ICLEAR_COL(:)))) / ZCLEAR_COL_ll
+ ZLSM_CLEAR = SUM_DD_R1_ll(REAL(ZLSM(INDEX_ICLEAR_COL(:)))) / ZCLEAR_COL_ll
+ ZLAT_CLEAR = SUM_DD_R1_ll(REAL(ZLAT(INDEX_ICLEAR_COL(:)))) / ZCLEAR_COL_ll
+ ZLON_CLEAR = SUM_DD_R1_ll(REAL(ZLON(INDEX_ICLEAR_COL(:)))) / ZCLEAR_COL_ll
+!
+ ELSE ! no clear columns -> the first column is chosen, without physical meaning: it will not be
+ ! unpacked after the call to the radiation ecmwf routine
+ ZT_CLEAR(:) = ZTAVE(1,:)
+ ZP_CLEAR(:) = ZPAVE(1,:)
+ ZQV_CLEAR(:) = ZQVAVE(1,:)
+ ZOZ_CLEAR(:) = ZO3AVE(1,:)
+ ZDP_CLEAR(:) = ZDPRES(1,:)
+ ZAER_CLEAR(:,:) = ZAER(1,:,:)
+ IF(CAOP=='EXPL')THEN
+ ZPIZA_EQ_CLEAR(:,:)=ZPIZA_EQ(1,:,:)
+ ZCGA_EQ_CLEAR(:,:)=ZCGA_EQ(1,:,:)
+ ZTAUREL_EQ_CLEAR(:,:)=ZTAUREL_EQ(1,:,:)
+ ENDIF
+!
+ ZHP_CLEAR(1:KFLEV) = ZPRES_HL(1,1:KFLEV)
+ ZHT_CLEAR(1:KFLEV) = ZT_HL(1,1:KFLEV)
+ ZALBP_CLEAR(:) = ZALBP(1,:)
+ ZALBD_CLEAR(:) = ZALBD(1,:)
+!
+ ZEMIS_CLEAR = ZEMIS(1,1)
+ ZEMIW_CLEAR = ZEMIW(1,1)
+ ZRMU0_CLEAR = ZRMU0(1)
+ ZTS_CLEAR = ZTS(1)
+ ZLSM_CLEAR = ZLSM(1)
+ ZLAT_CLEAR = ZLAT(1)
+ ZLON_CLEAR = ZLON(1)
+ END IF
+ !
+ GCLOUD(:,:) = .NOT.GCLEAR(:,:) ! .true. where the column is cloudy
+ GCLOUDT(:,:)=TRANSPOSE(GCLOUD(:,:))
+ ICLOUD = ICLOUD_COL*KFLEV ! total number of voxels in cloudy columns
+ ALLOCATE(ZWORK1(ICLOUD))
+ ALLOCATE(ZWORK2(ICLOUD+KFLEV)) ! allocation for the KFLEV levels of
+ ! the ICLOUD cloudy columns
+ ! and of the KFLEV levels of the clear sky one
+ !
+ ! temperature profiles
+ !
+ ZWORK1(:) = PACK( TRANSPOSE(ZTAVE(:,:)),MASK=GCLOUDT(:,:) )
+ ZWORK2(1:ICLOUD) = ZWORK1(1:ICLOUD) ! fills the ICLOUD_COL cloudy columns
+ ZWORK2(ICLOUD+1:)= ZT_CLEAR(1:) ! and the single clear_sky one
+ DEALLOCATE(ZTAVE)
+ ALLOCATE(ZTAVE(ICLOUD_COL+1,KFLEV))
+ ZTAVE(:,:) = TRANSPOSE( RESHAPE( ZWORK2(:),(/KFLEV,ICLOUD_COL+1/) ) )
+ !
+ ! vapor mixing ratio profiles
+ !
+ ZWORK1(:) = PACK( TRANSPOSE(ZQVAVE(:,:)),MASK=GCLOUDT(:,:) )
+ ZWORK2(1:ICLOUD) = ZWORK1(1:ICLOUD) ! fills the ICLOUD_COL cloudy columns
+ ZWORK2(ICLOUD+1:)= ZQV_CLEAR(1:) ! and the single clear_sky one
+ DEALLOCATE(ZQVAVE)
+ ALLOCATE(ZQVAVE(ICLOUD_COL+1,KFLEV))
+ ZQVAVE(:,:) = TRANSPOSE( RESHAPE( ZWORK2(:),(/KFLEV,ICLOUD_COL+1/) ) )
+ !
+ ! mesh size
+ !
+ ZWORK1(:) = PACK( TRANSPOSE(ZDZ(:,:)),MASK=GCLOUDT(:,:) )
+ ZWORK2(1:ICLOUD) = ZWORK1(1:ICLOUD) ! fills the ICLOUD_COL cloudy columns
+ ZWORK2(ICLOUD+1:)= 0.0 ! and the single clear_sky one
+ DEALLOCATE(ZDZ)
+ ALLOCATE(ZDZ(ICLOUD_COL+1,KFLEV))
+ ZDZ(:,:) = TRANSPOSE( RESHAPE( ZWORK2(:),(/KFLEV,ICLOUD_COL+1/) ) )
+ !
+ !
+ ! liquid water mixing ratio profiles
+ !
+ ZWORK1(:) = PACK( TRANSPOSE(ZQLAVE(:,:)),MASK=GCLOUDT(:,:) )
+ ZWORK2(1:ICLOUD) = ZWORK1(1:ICLOUD) ! fills the ICLOUD_COL cloudy columns
+ ZWORK2(ICLOUD+1:)= 0.0 ! and the single clear_sky one
+ DEALLOCATE(ZQLAVE)
+ ALLOCATE(ZQLAVE(ICLOUD_COL+1,KFLEV))
+ ZQLAVE(:,:) = TRANSPOSE( RESHAPE( ZWORK2(:),(/KFLEV,ICLOUD_COL+1/) ) )
+ !
+ !rain
+ !
+ ZWORK1(:) = PACK( TRANSPOSE(ZQRAVE(:,:)),MASK=GCLOUDT(:,:) )
+ ZWORK2(1:ICLOUD) = ZWORK1(1:ICLOUD) ! fills the ICLOUD_COL cloudy columns
+ ZWORK2(ICLOUD+1:)= 0.0 ! and the single clear_sky one
+ DEALLOCATE(ZQRAVE)
+ ALLOCATE(ZQRAVE(ICLOUD_COL+1,KFLEV))
+ ZQRAVE(:,:) = TRANSPOSE( RESHAPE( ZWORK2(:),(/KFLEV,ICLOUD_COL+1/) ) )
+ !
+ ! ice water mixing ratio profiles
+ !
+ ZWORK1(:) = PACK( TRANSPOSE(ZQIAVE(:,:)),MASK=GCLOUDT(:,:) )
+ ZWORK2(1:ICLOUD) = ZWORK1(1:ICLOUD) ! fills the ICLOUD_COL cloudy columns
+ ZWORK2(ICLOUD+1:)= 0.0 ! and the single clear_sky one
+ DEALLOCATE(ZQIAVE)
+ ALLOCATE(ZQIAVE(ICLOUD_COL+1,KFLEV))
+ ZQIAVE(:,:) = TRANSPOSE( RESHAPE( ZWORK2(:),(/KFLEV,ICLOUD_COL+1/) ) )
+ !
+ !
+ ! liquid water mixing ratio profiles
+ !
+ ZWORK1(:) = PACK( TRANSPOSE(ZQLWC(:,:)),MASK=GCLOUDT(:,:) )
+ ZWORK2(1:ICLOUD) = ZWORK1(1:ICLOUD) ! fills the ICLOUD_COL cloudy columns
+ ZWORK2(ICLOUD+1:)= 0.0 ! and the single clear_sky one
+ DEALLOCATE(ZQLWC)
+ ALLOCATE(ZQLWC(ICLOUD_COL+1,KFLEV))
+ ZQLWC(:,:) = TRANSPOSE( RESHAPE( ZWORK2(:),(/KFLEV,ICLOUD_COL+1/) ) )
+ !
+ !rain
+ !
+ ZWORK1(:) = PACK( TRANSPOSE(ZQRWC(:,:)),MASK=GCLOUDT(:,:) )
+ ZWORK2(1:ICLOUD) = ZWORK1(1:ICLOUD) ! fills the ICLOUD_COL cloudy columns
+ ZWORK2(ICLOUD+1:)= 0.0 ! and the single clear_sky one
+ DEALLOCATE(ZQRWC)
+ ALLOCATE(ZQRWC(ICLOUD_COL+1,KFLEV))
+ ZQRWC(:,:) = TRANSPOSE( RESHAPE( ZWORK2(:),(/KFLEV,ICLOUD_COL+1/) ) )
+ !
+ ! ice water mixing ratio profiles
+ !
+ ZWORK1(:) = PACK( TRANSPOSE(ZQIWC(:,:)),MASK=GCLOUDT(:,:) )
+ ZWORK2(1:ICLOUD) = ZWORK1(1:ICLOUD) ! fills the ICLOUD_COL cloudy columns
+ ZWORK2(ICLOUD+1:)= 0.0 ! and the single clear_sky one
+ DEALLOCATE(ZQIWC)
+ ALLOCATE(ZQIWC(ICLOUD_COL+1,KFLEV))
+ ZQIWC(:,:) = TRANSPOSE( RESHAPE( ZWORK2(:),(/KFLEV,ICLOUD_COL+1/) ) )
+ !
+ !
+ ! cloud fraction profiles
+ !
+ ZWORK1(:) = PACK( TRANSPOSE(ZCFAVE(:,:)),MASK=GCLOUDT(:,:) )
+ ZWORK2(1:ICLOUD) = ZWORK1(1:ICLOUD) ! fills the ICLOUD_COL cloudy columns
+ ZWORK2(ICLOUD+1:)= 0.0 ! and the single clear_sky one
+ DEALLOCATE(ZCFAVE)
+ ALLOCATE(ZCFAVE(ICLOUD_COL+1,KFLEV))
+ ZCFAVE(:,:) = TRANSPOSE( RESHAPE( ZWORK2(:),(/KFLEV,ICLOUD_COL+1/) ) )
+ !
+ ! C2R2 water particle concentration
+ !
+ IF ( SIZE(ZCCT_C2R2) > 0 ) THEN
+ ZWORK1(:) = PACK( TRANSPOSE(ZCCT_C2R2(:,:)),MASK=GCLOUDT(:,:) )
+ ZWORK2(1:ICLOUD) = ZWORK1(1:ICLOUD) ! fills the ICLOUD_COL cloudy columns
+ ZWORK2(ICLOUD+1:)= 0.0 ! and the single clear_sky one
+ DEALLOCATE(ZCCT_C2R2)
+ ALLOCATE(ZCCT_C2R2(ICLOUD_COL+1,KFLEV))
+ ZCCT_C2R2 (:,:) = TRANSPOSE( RESHAPE( ZWORK2(:),(/KFLEV,ICLOUD_COL+1/) ) )
+ ENDIF
+ IF ( SIZE (ZCRT_C2R2) > 0 ) THEN
+ ZWORK1(:) = PACK( TRANSPOSE(ZCRT_C2R2(:,:)),MASK=GCLOUDT(:,:) )
+ ZWORK2(1:ICLOUD) = ZWORK1(1:ICLOUD) ! fills the ICLOUD_COL cloudy columns
+ ZWORK2(ICLOUD+1:)= 0.0 ! and the single clear_sky one
+ DEALLOCATE(ZCRT_C2R2)
+ ALLOCATE(ZCRT_C2R2(ICLOUD_COL+1,KFLEV))
+ ZCRT_C2R2 (:,:) = TRANSPOSE( RESHAPE( ZWORK2(:),(/KFLEV,ICLOUD_COL+1/) ) )
+ ENDIF
+ IF ( SIZE (ZCIT_C1R3) > 0) THEN
+ ZWORK1(:) = PACK( TRANSPOSE(ZCIT_C1R3(:,:)),MASK=GCLOUDT(:,:) )
+ ZWORK2(1:ICLOUD) = ZWORK1(1:ICLOUD) ! fills the ICLOUD_COL cloudy columns
+ ZWORK2(ICLOUD+1:)= 0.0 ! and the single clear_sky one
+ DEALLOCATE(ZCIT_C1R3)
+ ALLOCATE(ZCIT_C1R3(ICLOUD_COL+1,KFLEV))
+ ZCIT_C1R3 (:,:) = TRANSPOSE( RESHAPE( ZWORK2(:),(/KFLEV,ICLOUD_COL+1/) ) )
+ ENDIF
+ !
+ ! LIMA water particle concentration
+ !
+ IF( CCLOUD == 'LIMA' ) THEN
+ ZWORK1(:) = PACK( TRANSPOSE(ZCCT_LIMA(:,:)),MASK=GCLOUDT(:,:) )
+ ZWORK2(1:ICLOUD) = ZWORK1(1:ICLOUD) ! fills the ICLOUD_COL cloudy columns
+ ZWORK2(ICLOUD+1:)= 0.0 ! and the single clear_sky one
+ DEALLOCATE(ZCCT_LIMA)
+ ALLOCATE(ZCCT_LIMA(ICLOUD_COL+1,KFLEV))
+ ZCCT_LIMA (:,:) = TRANSPOSE( RESHAPE( ZWORK2(:),(/KFLEV,ICLOUD_COL+1/) ) )
+!
+ ZWORK1(:) = PACK( TRANSPOSE(ZCRT_LIMA(:,:)),MASK=GCLOUDT(:,:) )
+ ZWORK2(1:ICLOUD) = ZWORK1(1:ICLOUD) ! fills the ICLOUD_COL cloudy columns
+ ZWORK2(ICLOUD+1:)= 0.0 ! and the single clear_sky one
+ DEALLOCATE(ZCRT_LIMA)
+ ALLOCATE(ZCRT_LIMA(ICLOUD_COL+1,KFLEV))
+ ZCRT_LIMA (:,:) = TRANSPOSE( RESHAPE( ZWORK2(:),(/KFLEV,ICLOUD_COL+1/) ) )
+!
+ ZWORK1(:) = PACK( TRANSPOSE(ZCIT_LIMA(:,:)),MASK=GCLOUDT(:,:) )
+ ZWORK2(1:ICLOUD) = ZWORK1(1:ICLOUD) ! fills the ICLOUD_COL cloudy columns
+ ZWORK2(ICLOUD+1:)= 0.0 ! and the single clear_sky one
+ DEALLOCATE(ZCIT_LIMA)
+ ALLOCATE(ZCIT_LIMA(ICLOUD_COL+1,KFLEV))
+ ZCIT_LIMA (:,:) = TRANSPOSE( RESHAPE( ZWORK2(:),(/KFLEV,ICLOUD_COL+1/) ) )
+ ENDIF
+ !
+ ! ozone content profiles
+ !
+ ZWORK1(:) = PACK( TRANSPOSE(ZO3AVE(:,:)),MASK=GCLOUDT(:,:) )
+ ZWORK2(1:ICLOUD) = ZWORK1(1:ICLOUD) ! fills the ICLOUD_COL cloudy columns
+ ZWORK2(ICLOUD+1:)= ZOZ_CLEAR(1:) ! and the single clear_sky one
+ DEALLOCATE(ZO3AVE)
+ ALLOCATE(ZO3AVE(ICLOUD_COL+1,KFLEV))
+ ZO3AVE(:,:) = TRANSPOSE( RESHAPE( ZWORK2(:),(/KFLEV,ICLOUD_COL+1/) ) )
+ !
+ ZWORK1(:) = PACK( TRANSPOSE(ZPAVE(:,:)),MASK=GCLOUDT(:,:) )
+ ZWORK2(1:ICLOUD) = ZWORK1(1:ICLOUD) ! fills the ICLOUD_COL cloudy columns
+ ZWORK2(ICLOUD+1:)= ZP_CLEAR(1:) ! and the single clear_sky one
+ DEALLOCATE(ZPAVE)
+ ALLOCATE(ZPAVE(ICLOUD_COL+1,KFLEV))
+ ZPAVE(:,:) = TRANSPOSE( RESHAPE( ZWORK2(:),(/KFLEV,ICLOUD_COL+1/) ) )
+ !
+ !pressure thickness
+ !
+ ZWORK1(:) = PACK( TRANSPOSE(ZDPRES(:,:)),MASK=GCLOUDT(:,:) )
+ ZWORK2(1:ICLOUD) = ZWORK1(1:ICLOUD) ! fills the ICLOUD_COL cloudy columns
+ ZWORK2(ICLOUD+1:)= ZDP_CLEAR(1:) ! and the single clear_sky one
+ DEALLOCATE(ZDPRES)
+ ALLOCATE(ZDPRES(ICLOUD_COL+1,KFLEV))
+ ZDPRES(:,:) = TRANSPOSE( RESHAPE( ZWORK2(:),(/KFLEV,ICLOUD_COL+1/) ) )
+ !
+ !aerosols
+ !
+ ALLOCATE(ZWORK1AER(ICLOUD,KAER))
+ ALLOCATE(ZWORK2AER(ICLOUD+KFLEV,KAER))
+ DO JK=1,KAER
+ ZWORK1AER(:,JK) = PACK( TRANSPOSE(ZAER(:,:,JK)),MASK=GCLOUDT(:,:) )
+ ZWORK2AER(1:ICLOUD,JK)=ZWORK1AER(:,JK)
+ ZWORK2AER(ICLOUD+1:,JK)=ZAER_CLEAR(:,JK)
+ END DO
+ DEALLOCATE(ZAER)
+ ALLOCATE(ZAER(ICLOUD_COL+1,KFLEV,KAER))
+ DO JK=1,KAER
+ ZAER(:,:,JK) = TRANSPOSE( RESHAPE( ZWORK2AER(:,JK),(/KFLEV,ICLOUD_COL+1/) ) )
+ END DO
+ DEALLOCATE (ZWORK1AER)
+ DEALLOCATE (ZWORK2AER)
+ !
+ IF(CAOP=='EXPL')THEN
+ ALLOCATE(ZWORK1AER(ICLOUD,KSWB_OLD)) !New vector with value for all cld. points
+ ALLOCATE(ZWORK2AER(ICLOUD+KFLEV,KSWB_OLD)) !New vector with value for all cld.points + 1 clr column
+ !Single scattering albedo
+ DO WVL_IDX=1,KSWB_OLD
+ ZWORK1AER(:,WVL_IDX) = PACK( TRANSPOSE(ZPIZA_EQ(:,:,WVL_IDX)),MASK=GCLOUDT(:,:) )
+ ZWORK2AER(1:ICLOUD,WVL_IDX) = ZWORK1AER(:,WVL_IDX)
+ ZWORK2AER(ICLOUD+1:,WVL_IDX) = ZPIZA_EQ_CLEAR(:,WVL_IDX)
+ ENDDO
+ DEALLOCATE(ZPIZA_EQ)
+ ALLOCATE(ZPIZA_EQ(ICLOUD_COL+1,KFLEV,KSWB_OLD))
+ DO WVL_IDX=1,KSWB_OLD
+ ZPIZA_EQ(:,:,WVL_IDX) = TRANSPOSE( RESHAPE( ZWORK2AER(:,WVL_IDX),(/KFLEV,ICLOUD_COL+1/) ) )
+ ENDDO
+ !Assymetry factor
+ DO WVL_IDX=1,KSWB_OLD
+ ZWORK1AER(:,WVL_IDX) = PACK(TRANSPOSE(ZCGA_EQ(:,:,WVL_IDX)), MASK=GCLOUDT(:,:))
+ ZWORK2AER(1:ICLOUD,WVL_IDX) = ZWORK1AER(:,WVL_IDX)
+ ZWORK2AER(ICLOUD+1:,WVL_IDX) = ZCGA_EQ_CLEAR(:,WVL_IDX)
+ ENDDO
+ DEALLOCATE(ZCGA_EQ)
+ ALLOCATE(ZCGA_EQ(ICLOUD_COL+1,KFLEV,KSWB_OLD))
+ DO WVL_IDX=1,KSWB_OLD
+ ZCGA_EQ(:,:,WVL_IDX) = TRANSPOSE(RESHAPE(ZWORK2AER(:,WVL_IDX),(/KFLEV,ICLOUD_COL+1/)))
+ ENDDO
+ !Relative wavelength-distributed optical depth
+ DO WVL_IDX=1,KSWB_OLD
+ ZWORK1AER(:,WVL_IDX) = PACK(TRANSPOSE(ZTAUREL_EQ(:,:,WVL_IDX)), MASK=GCLOUDT(:,:))
+ ZWORK2AER(1:ICLOUD,WVL_IDX) = ZWORK1AER(:,WVL_IDX)
+ ZWORK2AER(ICLOUD+1:,WVL_IDX) = ZTAUREL_EQ_CLEAR(:,WVL_IDX)
+ ENDDO
+ DEALLOCATE(ZTAUREL_EQ)
+ ALLOCATE(ZTAUREL_EQ(ICLOUD_COL+1,KFLEV,KSWB_OLD))
+ DO WVL_IDX=1,KSWB_OLD
+ ZTAUREL_EQ(:,:,WVL_IDX) = TRANSPOSE(RESHAPE(ZWORK2AER(:,WVL_IDX),(/KFLEV,ICLOUD_COL+1/)))
+ ENDDO
+ DEALLOCATE(ZWORK1AER)
+ DEALLOCATE(ZWORK2AER)
+ ELSE
+ DEALLOCATE(ZPIZA_EQ)
+ ALLOCATE(ZPIZA_EQ(ICLOUD_COL+1,KFLEV,KSWB_OLD))
+ DEALLOCATE(ZCGA_EQ)
+ ALLOCATE(ZCGA_EQ(ICLOUD_COL+1,KFLEV,KSWB_OLD))
+ DEALLOCATE(ZTAUREL_EQ)
+ ALLOCATE(ZTAUREL_EQ(ICLOUD_COL+1,KFLEV,KSWB_OLD))
+ ENDIF !Check on LDUST
+
+ ! half-level variables
+ !
+ ZWORK1(:) = PACK( TRANSPOSE(ZPRES_HL(:,1:KFLEV)),MASK=GCLOUDT(:,:) )
+ ZWORK2(1:ICLOUD) = ZWORK1(1:ICLOUD) ! fills the ICLOUD_COL cloudy columns
+ ZWORK2(ICLOUD+1:)= ZHP_CLEAR(1:) ! and the single clear_sky one
+ DEALLOCATE(ZPRES_HL)
+ ALLOCATE(ZPRES_HL(ICLOUD_COL+1,KFLEV+1))
+ ZPRES_HL(:,1:KFLEV) = TRANSPOSE( RESHAPE( ZWORK2(:),(/KFLEV,ICLOUD_COL+1/) ) )
+ ZPRES_HL(:,KFLEV+1) = PSTATM(IKSTAE,2)*100.0
+ !
+ ZWORK1(:) = PACK( TRANSPOSE(ZT_HL(:,1:KFLEV)),MASK=GCLOUDT(:,:) )
+ ZWORK2(1:ICLOUD) = ZWORK1(1:ICLOUD) ! fills the ICLOUD_COL cloudy columns
+ ZWORK2(ICLOUD+1:)= ZHT_CLEAR(1:) ! and the single clear_sky one
+ DEALLOCATE(ZT_HL)
+ ALLOCATE(ZT_HL(ICLOUD_COL+1,KFLEV+1))
+ ZT_HL(:,1:KFLEV) = TRANSPOSE( RESHAPE( ZWORK2(:),(/KFLEV,ICLOUD_COL+1/) ) )
+ ZT_HL(:,KFLEV+1) = PSTATM(IKSTAE,3)
+ !
+ ! surface fields
+ !
+ ALLOCATE(ZWORK3(ICLOUD_COL))
+ ALLOCATE(ZWORK4(ICLOUD_COL,KSWB_MNH))
+ ALLOCATE(ZWORK(KDLON))
+ DO JALBS=1,KSWB_MNH
+ ZWORK(:) = ZALBP(:,JALBS)
+ ZWORK3(:) = PACK( ZWORK(:),MASK=.NOT.GCLEAR_2D(:) )
+ ZWORK4(:,JALBS) = ZWORK3(:)
+ END DO
+ DEALLOCATE(ZALBP)
+ ALLOCATE(ZALBP(ICLOUD_COL+1,KSWB_MNH))
+ ZALBP(1:ICLOUD_COL,:) = ZWORK4(1:ICLOUD_COL,:)
+ ZALBP(ICLOUD_COL+1,:) = ZALBP_CLEAR(:)
+ !
+ DO JALBS=1,KSWB_MNH
+ ZWORK(:) = ZALBD(:,JALBS)
+ ZWORK3(:) = PACK( ZWORK(:),MASK=.NOT.GCLEAR_2D(:) )
+ ZWORK4(:,JALBS) = ZWORK3(:)
+ END DO
+ DEALLOCATE(ZALBD)
+ ALLOCATE(ZALBD(ICLOUD_COL+1,KSWB_MNH))
+ ZALBD(1:ICLOUD_COL,:) = ZWORK4(1:ICLOUD_COL,:)
+ ZALBD(ICLOUD_COL+1,:) = ZALBD_CLEAR(:)
+ !
+ DEALLOCATE(ZWORK4)
+ !
+ ZWORK3(:) = PACK( ZEMIS(:,1),MASK=.NOT.GCLEAR_2D(:) )
+ DEALLOCATE(ZEMIS)
+ ALLOCATE(ZEMIS(ICLOUD_COL+1,1))
+ ZEMIS(1:ICLOUD_COL,1) = ZWORK3(1:ICLOUD_COL)
+ ZEMIS(ICLOUD_COL+1,1) = ZEMIS_CLEAR
+ !
+ !
+ ZWORK3(:) = PACK( ZEMIW(:,1),MASK=.NOT.GCLEAR_2D(:) )
+ DEALLOCATE(ZEMIW)
+ ALLOCATE(ZEMIW(ICLOUD_COL+1,1))
+ ZEMIW(1:ICLOUD_COL,1) = ZWORK3(1:ICLOUD_COL)
+ ZEMIW(ICLOUD_COL+1,1) = ZEMIW_CLEAR
+ !
+ !
+ ZWORK3(:) = PACK( ZRMU0(:),MASK=.NOT.GCLEAR_2D(:) )
+ DEALLOCATE(ZRMU0)
+ ALLOCATE(ZRMU0(ICLOUD_COL+1))
+ ZRMU0(1:ICLOUD_COL) = ZWORK3(1:ICLOUD_COL)
+ ZRMU0(ICLOUD_COL+1) = ZRMU0_CLEAR
+ !
+ ZWORK3(:) = PACK( ZLSM(:),MASK=.NOT.GCLEAR_2D(:) )
+ DEALLOCATE(ZLSM)
+ ALLOCATE(ZLSM(ICLOUD_COL+1))
+ ZLSM(1:ICLOUD_COL) = ZWORK3(1:ICLOUD_COL)
+ ZLSM (ICLOUD_COL+1)= ZLSM_CLEAR
+ !
+ ZWORK3(:) = PACK( ZLAT(:),MASK=.NOT.GCLEAR_2D(:) )
+ DEALLOCATE(ZLAT)
+ ALLOCATE(ZLAT(ICLOUD_COL+1))
+ ZLAT(1:ICLOUD_COL) = ZWORK3(1:ICLOUD_COL)
+ ZLAT (ICLOUD_COL+1)= ZLAT_CLEAR
+ !
+ ZWORK3(:) = PACK( ZLON(:),MASK=.NOT.GCLEAR_2D(:) )
+ DEALLOCATE(ZLON)
+ ALLOCATE(ZLON(ICLOUD_COL+1))
+ ZLON(1:ICLOUD_COL) = ZWORK3(1:ICLOUD_COL)
+ ZLON (ICLOUD_COL+1)= ZLON_CLEAR
+ !
+ ZWORK3(:) = PACK( ZTS(:),MASK=.NOT.GCLEAR_2D(:) )
+ DEALLOCATE(ZTS)
+ ALLOCATE(ZTS(ICLOUD_COL+1))
+ ZTS(1:ICLOUD_COL) = ZWORK3(1:ICLOUD_COL)
+ ZTS(ICLOUD_COL+1) = ZTS_CLEAR
+ !
+ DEALLOCATE(ZWORK1)
+ DEALLOCATE(ZWORK2)
+ DEALLOCATE(ZWORK3)
+ DEALLOCATE(ZWORK)
+ !
+ IDIM = ICLOUD_COL +1 ! Number of columns where RT is computed
+!
+ELSE
+ !
+ !* 5.3 RADIATION COMPUTATIONS FOR THE FULL COLUMN NUMBER (KDLON)
+ !
+ IDIM = KDLON
+END IF
+!
+! initialisation of cloud trace for the next radiation time step
+! (if unchanged columns are not recomputed)
+WHERE ( ZCLOUD(:) <= 0.0 )
+ ICLEAR_2D_TM1(:) = 1
+ELSEWHERE
+ ICLEAR_2D_TM1(:) = 0
+END WHERE
+!
+DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ KCLEARCOL_TM1(JI,JJ) = ICLEAR_2D_TM1(IIJ) ! output to be saved for next time step
+ END DO
+END DO
+!
+!
+!* 5.4 VERTICAL grid modification(up-down) for compatibility with ECMWF
+! radiation vertical grid. ALLOCATION of the outputs.
+!
+!
+ALLOCATE (ZWORK_GRID(SIZE(ZPRES_HL,1),KFLEV+1))
+!
+!half level pressure
+ZWORK_GRID(:,:)=ZPRES_HL(:,:)
+DO JKRAD=1, KFLEV+1
+ JK1=(KFLEV+1)+1-JKRAD
+ ZPRES_HL(:,JKRAD) = ZWORK_GRID(:,JK1)
+END DO
+!
+!half level temperature
+ZWORK_GRID(:,:)=ZT_HL(:,:)
+DO JKRAD=1, KFLEV+1
+ JK1=(KFLEV+1)+1-JKRAD
+ ZT_HL(:,JKRAD)=ZWORK_GRID(:,JK1)
+END DO
+!
+DEALLOCATE(ZWORK_GRID)
+!
+!mean layer variables
+!-------------------------------------
+ALLOCATE(ZWORK_GRID(SIZE(ZTAVE,1),KFLEV))
+!
+!mean layer temperature
+ZWORK_GRID(:,:)=ZTAVE(:,:)
+DO JKRAD=1, KFLEV
+ JK1=KFLEV+1-JKRAD
+ ZTAVE(:,JKRAD)=ZWORK_GRID(:,JK1)
+END DO
+!
+!mean layer pressure
+ZWORK_GRID(:,:)=ZPAVE(:,:)
+DO JKRAD=1, KFLEV
+ JK1=KFLEV+1-JKRAD
+ ZPAVE(:,JKRAD)=ZWORK_GRID(:,JK1)
+END DO
+!
+!mean layer pressure thickness
+ZWORK_GRID(:,:)=ZDPRES(:,:)
+DO JKRAD=1, KFLEV
+ JK1=KFLEV+1-JKRAD
+ ZDPRES(:,JKRAD)=ZWORK_GRID(:,JK1)
+END DO
+!
+!mesh size
+ZWORK_GRID(:,:)=ZDZ(:,:)
+DO JKRAD=1, KFLEV
+ JK1=KFLEV+1-JKRAD
+ ZDZ(:,JKRAD)=ZWORK_GRID(:,JK1)
+END DO
+
+!mean layer cloud fraction
+ZWORK_GRID(:,:)=ZCFAVE(:,:)
+DO JKRAD=1, KFLEV
+ JK1=KFLEV+1-JKRAD
+ ZCFAVE(:,JKRAD)=ZWORK_GRID(:,JK1)
+END DO
+!
+!mean layer water vapor mixing ratio
+ZWORK_GRID(:,:)=ZQVAVE(:,:)
+DO JKRAD=1, KFLEV
+ JK1=KFLEV+1-JKRAD
+ ZQVAVE(:,JKRAD)=ZWORK_GRID(:,JK1)
+END DO
+!
+!ice
+ZWORK_GRID(:,:)=ZQIAVE(:,:)
+DO JKRAD=1, KFLEV
+ JK1=KFLEV+1-JKRAD
+ ZQIAVE(:,JKRAD)=ZWORK_GRID(:,JK1)
+END DO
+!
+!liquid water
+ZWORK_GRID(:,:)=ZQLAVE(:,:)
+DO JKRAD=1, KFLEV
+ JK1=KFLEV+1-JKRAD
+ ZQLAVE(:,JKRAD)=ZWORK_GRID(:,JK1)
+END DO
+
+
+!rain water
+ZWORK_GRID(:,:)=ZQRAVE(:,:)
+DO JKRAD=1, KFLEV
+ JK1=KFLEV+1-JKRAD
+ ZQRAVE(:,JKRAD)=ZWORK_GRID(:,JK1)
+END DO
+!
+!ice water content
+ZWORK_GRID(:,:)=ZQIWC(:,:)
+DO JKRAD=1, KFLEV
+ JK1=KFLEV+1-JKRAD
+ ZQIWC(:,JKRAD)=ZWORK_GRID(:,JK1)
+END DO
+!
+!liquid water content
+ZWORK_GRID(:,:)=ZQLWC(:,:)
+DO JKRAD=1, KFLEV
+ JK1=KFLEV+1-JKRAD
+ ZQLWC(:,JKRAD)=ZWORK_GRID(:,JK1)
+END DO
+
+
+!rain water content
+ZWORK_GRID(:,:)=ZQRWC(:,:)
+DO JKRAD=1, KFLEV
+ JK1=KFLEV+1-JKRAD
+ ZQRWC(:,JKRAD)=ZWORK_GRID(:,JK1)
+END DO
+
+
+!C2R2 water particle concentration
+!
+IF (SIZE(ZCCT_C2R2) > 0) THEN
+ ZWORK_GRID(:,:)=ZCCT_C2R2(:,:)
+ DO JKRAD=1, KFLEV
+ JK1=KFLEV+1-JKRAD
+ ZCCT_C2R2(:,JKRAD)=ZWORK_GRID(:,JK1)
+ END DO
+END IF
+IF (SIZE(ZCRT_C2R2) > 0) THEN
+ ZWORK_GRID(:,:)=ZCRT_C2R2(:,:)
+ DO JKRAD=1, KFLEV
+ JK1=KFLEV+1-JKRAD
+ ZCRT_C2R2(:,JKRAD)=ZWORK_GRID(:,JK1)
+ END DO
+END IF
+IF (SIZE(ZCIT_C1R3) > 0) THEN
+ ZWORK_GRID(:,:)=ZCIT_C1R3(:,:)
+ DO JKRAD=1, KFLEV
+ JK1=KFLEV+1-JKRAD
+ ZCIT_C1R3(:,JKRAD)=ZWORK_GRID(:,JK1)
+ END DO
+END IF
+!
+!LIMA water particle concentration
+!
+IF( CCLOUD == 'LIMA' ) THEN
+ ZWORK_GRID(:,:)=ZCCT_LIMA(:,:)
+ DO JKRAD=1, KFLEV
+ JK1=KFLEV+1-JKRAD
+ ZCCT_LIMA(:,JKRAD)=ZWORK_GRID(:,JK1)
+ END DO
+!
+ ZWORK_GRID(:,:)=ZCRT_LIMA(:,:)
+ DO JKRAD=1, KFLEV
+ JK1=KFLEV+1-JKRAD
+ ZCRT_LIMA(:,JKRAD)=ZWORK_GRID(:,JK1)
+ END DO
+!
+ ZWORK_GRID(:,:)=ZCIT_LIMA(:,:)
+ DO JKRAD=1, KFLEV
+ JK1=KFLEV+1-JKRAD
+ ZCIT_LIMA(:,JKRAD)=ZWORK_GRID(:,JK1)
+ END DO
+END IF
+!
+!ozone content
+ZWORK_GRID(:,:)=ZO3AVE(:,:)
+DO JKRAD=1, KFLEV
+ JK1=KFLEV+1-JKRAD
+ ZO3AVE(:,JKRAD)=ZWORK_GRID(:,JK1)
+END DO
+!
+!aerosol optical depth
+DO JI=1,KAER
+ ZWORK_GRID(:,:)=ZAER(:,:,JI)
+ DO JKRAD=1, KFLEV
+ JK1=KFLEV+1-JKRAD
+ ZAER(:,JKRAD,JI)=ZWORK_GRID(:,JK1)
+ END DO
+END DO
+IF (CAOP=='EXPL') THEN
+!TURN MORE FIELDS UPSIDE DOWN...
+!Dust single scattering albedo
+DO JI=1,KSWB_OLD
+ ZWORK_GRID(:,:)=ZPIZA_EQ(:,:,JI)
+ DO JKRAD=1,KFLEV
+ JK1=KFLEV+1-JKRAD
+ ZPIZA_EQ(:,JKRAD,JI)=ZWORK_GRID(:,JK1)
+ ENDDO
+ENDDO
+!Dust asymmetry factor
+DO JI=1,KSWB_OLD
+ ZWORK_GRID(:,:)=ZCGA_EQ(:,:,JI)
+ DO JKRAD=1,KFLEV
+ JK1=KFLEV+1-JKRAD
+ ZCGA_EQ(:,JKRAD,JI)=ZWORK_GRID(:,JK1)
+ ENDDO
+ENDDO
+DO JI=1,KSWB_OLD
+ ZWORK_GRID(:,:)=ZTAUREL_EQ(:,:,JI)
+ DO JKRAD=1,KFLEV
+ JK1=KFLEV+1-JKRAD
+ ZTAUREL_EQ(:,JKRAD,JI)=ZWORK_GRID(:,JK1)
+ ENDDO
+ENDDO
+
+END IF
+
+!
+DEALLOCATE(ZWORK_GRID)
+!
+!mean layer saturation specific humidity
+!
+ALLOCATE(ZQSAVE(SIZE(ZTAVE,1),SIZE(ZTAVE,2)))
+!
+WHERE (ZTAVE(:,:) > XTT)
+ ZQSAVE(:,:) = QSAT(ZTAVE, ZPAVE)
+ELSEWHERE
+ ZQSAVE(:,:) = QSATI(ZTAVE, ZPAVE)
+END WHERE
+!
+! allocations for the radiation code outputs
+!
+ALLOCATE(ZDTLW(IDIM,KFLEV))
+ALLOCATE(ZDTSW(IDIM,KFLEV))
+ALLOCATE(ZFLUX_TOP_GND_IRVISNIR(IDIM,KFLUX))
+ALLOCATE(ZSFSWDIR(IDIM,ISWB))
+ALLOCATE(ZSFSWDIF(IDIM,ISWB))
+ALLOCATE(ZDTLW_CS(IDIM,KFLEV))
+ALLOCATE(ZDTSW_CS(IDIM,KFLEV))
+ALLOCATE(ZFLUX_TOP_GND_IRVISNIR_CS(IDIM,KFLUX))
+!
+!
+ALLOCATE(ZFLUX_LW(IDIM,2,KFLEV+1))
+ALLOCATE(ZFLUX_SW_DOWN(IDIM,KFLEV+1))
+ALLOCATE(ZFLUX_SW_UP(IDIM,KFLEV+1))
+ALLOCATE(ZRADLP(IDIM,KFLEV))
+IF( KRAD_DIAG >= 1) THEN
+ ALLOCATE(ZNFLW(IDIM,KFLEV+1))
+ ALLOCATE(ZNFSW(IDIM,KFLEV+1))
+ELSE
+ ALLOCATE(ZNFLW(0,0))
+ ALLOCATE(ZNFSW(0,0))
+END IF
+!
+IF( KRAD_DIAG >= 2) THEN
+ ALLOCATE(ZFLUX_SW_DOWN_CS(IDIM,KFLEV+1))
+ ALLOCATE(ZFLUX_SW_UP_CS(IDIM,KFLEV+1))
+ ALLOCATE(ZFLUX_LW_CS(IDIM,2,KFLEV+1))
+ ALLOCATE(ZNFLW_CS(IDIM,KFLEV+1))
+ ALLOCATE(ZNFSW_CS(IDIM,KFLEV+1))
+ELSE
+ ALLOCATE(ZFLUX_SW_DOWN_CS(0,0))
+ ALLOCATE(ZFLUX_SW_UP_CS(0,0))
+ ALLOCATE(ZFLUX_LW_CS(0,0,0))
+ ALLOCATE(ZNFSW_CS(0,0))
+ ALLOCATE(ZNFLW_CS(0,0))
+END IF
+!
+IF( KRAD_DIAG >= 3) THEN
+ ALLOCATE(ZPLAN_ALB_VIS(IDIM))
+ ALLOCATE(ZPLAN_ALB_NIR(IDIM))
+ ALLOCATE(ZPLAN_TRA_VIS(IDIM))
+ ALLOCATE(ZPLAN_TRA_NIR(IDIM))
+ ALLOCATE(ZPLAN_ABS_VIS(IDIM))
+ ALLOCATE(ZPLAN_ABS_NIR(IDIM))
+ELSE
+ ALLOCATE(ZPLAN_ALB_VIS(0))
+ ALLOCATE(ZPLAN_ALB_NIR(0))
+ ALLOCATE(ZPLAN_TRA_VIS(0))
+ ALLOCATE(ZPLAN_TRA_NIR(0))
+ ALLOCATE(ZPLAN_ABS_VIS(0))
+ ALLOCATE(ZPLAN_ABS_NIR(0))
+END IF
+!
+IF( KRAD_DIAG >= 4) THEN
+ ALLOCATE(ZEFCL_RRTM(IDIM,KFLEV))
+ ALLOCATE(ZCLSW_TOTAL(IDIM,KFLEV))
+ ALLOCATE(ZTAU_TOTAL(IDIM,KSWB_OLD,KFLEV))
+ ALLOCATE(ZOMEGA_TOTAL(IDIM,KSWB_OLD,KFLEV))
+ ALLOCATE(ZCG_TOTAL(IDIM,KSWB_OLD,KFLEV))
+ ALLOCATE(ZEFCL_LWD(IDIM,KFLEV))
+ ALLOCATE(ZEFCL_LWU(IDIM,KFLEV))
+ ALLOCATE(ZFLWP(IDIM,KFLEV))
+ ALLOCATE(ZFIWP(IDIM,KFLEV))
+ ALLOCATE(ZRADIP(IDIM,KFLEV))
+ELSE
+ ALLOCATE(ZEFCL_RRTM(0,0))
+ ALLOCATE(ZCLSW_TOTAL(0,0))
+ ALLOCATE(ZTAU_TOTAL(0,0,0))
+ ALLOCATE(ZOMEGA_TOTAL(0,0,0))
+ ALLOCATE(ZCG_TOTAL(0,0,0))
+ ALLOCATE(ZEFCL_LWD(0,0))
+ ALLOCATE(ZEFCL_LWU(0,0))
+ ALLOCATE(ZFLWP(0,0))
+ ALLOCATE(ZFIWP(0,0))
+ ALLOCATE(ZRADIP(0,0))
+END IF
+!
+!* 5.6 CALLS THE ECMWF_RADIATION ROUTINES
+!
+! mixing ratio -> specific humidity conversion (for ECMWF routine)
+! mixing ratio = mv/md ; specific humidity = mv/(mv+md)
+
+ZQVAVE(:,:) = ZQVAVE(:,:) / (1.+ZQVAVE(:,:)) ! Because
+! ZAER = 1e-5*ZAER
+! ZO3AVE = 1e-5*ZO3AVE!
+IF( IDIM <= KRAD_COLNBR ) THEN
+!
+! there is less than KRAD_COLNBR columns to be considered therefore
+! no split of the arrays is performed
+! Note that radiation scheme only takes scalar emissivities so only fist value of the spectral emissivity is taken
+ ALLOCATE(ZTAVE_RAD(SIZE(ZTAVE,1),SIZE(ZTAVE,2)))
+ ALLOCATE(ZPAVE_RAD(SIZE(ZPAVE,1),SIZE(ZPAVE,2)))
+ ZTAVE_RAD = ZTAVE
+ ZPAVE_RAD = ZPAVE
+ IF (CCLOUD == 'LIMA') THEN
+ IF (CRAD == "ECMW") THEN
+ CALL ECMWF_RADIATION_VERS2 ( IDIM ,KFLEV, KRAD_DIAG, KAER, &
+ ZDZ,HEFRADL,HEFRADI,HOPWSW, HOPISW, HOPWLW, HOPILW,PFUDG, &
+ ZRII0, ZAER , ZALBD, ZALBP, ZPRES_HL, ZPAVE_RAD, &
+ PCCO2, ZCFAVE, ZDPRES, ZEMIS(:,1), ZEMIW(:,1), ZLSM, ZRMU0, &
+ ZO3AVE , ZQVAVE, ZQIAVE ,ZQIWC,ZQLAVE,ZQLWC, ZQSAVE, ZQRAVE, ZQRWC, &
+ ZT_HL,ZTAVE_RAD, ZTS, ZCCT_LIMA, ZCRT_LIMA, ZCIT_LIMA, &
+ ZNFLW_CS, ZNFLW, ZNFSW_CS,ZNFSW, &
+ ZDTLW, ZDTSW, ZFLUX_TOP_GND_IRVISNIR, &
+ ZSFSWDIR, ZSFSWDIF, &
+ ZFLUX_SW_DOWN, ZFLUX_SW_UP, ZFLUX_LW , &
+ ZDTLW_CS, ZDTSW_CS, ZFLUX_TOP_GND_IRVISNIR_CS, &
+ ZFLUX_SW_DOWN_CS, ZFLUX_SW_UP_CS, ZFLUX_LW_CS, &
+ ZPLAN_ALB_VIS,ZPLAN_ALB_NIR, ZPLAN_TRA_VIS, ZPLAN_TRA_NIR, &
+ ZPLAN_ABS_VIS, ZPLAN_ABS_NIR,ZEFCL_LWD, ZEFCL_LWU, &
+ ZFLWP, ZFIWP,ZRADLP, ZRADIP,ZEFCL_RRTM, ZCLSW_TOTAL, ZTAU_TOTAL, &
+ ZOMEGA_TOTAL,ZCG_TOTAL, &
+ GAOP, ZPIZA_EQ,ZCGA_EQ,ZTAUREL_EQ )
+
+
+ ELSE IF (CRAD == "ECRA") THEN
+ CALL ECRAD_INTERFACE ( IDIM ,KFLEV, KRAD_DIAG, KAER, &
+ ZDZ,HEFRADL,HEFRADI,HOPWSW, HOPISW, HOPWLW, HOPILW,PFUDG, &
+ ZRII0, ZAER , ZALBD, ZALBP, ZPRES_HL, ZPAVE_RAD, &
+ PCCO2, ZCFAVE, ZDPRES, ZEMIS(:,1), ZEMIW(:,1), ZLSM, ZRMU0, &
+ ZO3AVE , ZQVAVE, ZQIAVE ,ZQIWC,ZQLAVE,ZQLWC, ZQSAVE, ZQRAVE, ZQRWC, &
+ ZT_HL,ZTAVE_RAD, ZTS, ZCCT_LIMA, ZCRT_LIMA, ZCIT_LIMA, &
+ ZNFLW, ZNFSW, ZNFLW_CS, ZNFSW_CS, &
+ ZDTLW, ZDTSW, ZFLUX_TOP_GND_IRVISNIR, &
+ ZSFSWDIR, ZSFSWDIF, &
+ ZFLUX_SW_DOWN, ZFLUX_SW_UP, ZFLUX_LW , &
+ ZDTLW_CS, ZDTSW_CS, ZFLUX_TOP_GND_IRVISNIR_CS, &
+ ZFLUX_SW_DOWN_CS, ZFLUX_SW_UP_CS, ZFLUX_LW_CS, &
+ ZPLAN_ALB_VIS,ZPLAN_ALB_NIR, ZPLAN_TRA_VIS, ZPLAN_TRA_NIR, &
+ ZPLAN_ABS_VIS, ZPLAN_ABS_NIR,ZEFCL_LWD, ZEFCL_LWU, &
+ ZFLWP, ZFIWP,ZRADLP, ZRADIP,ZEFCL_RRTM, ZCLSW_TOTAL, ZTAU_TOTAL, &
+ ZOMEGA_TOTAL,ZCG_TOTAL, &
+ GAOP, ZPIZA_EQ,ZCGA_EQ,ZTAUREL_EQ,ZLAT,ZLON )
+ ENDIF
+
+ ELSE
+ IF (CRAD == "ECMW") THEN
+ CALL ECMWF_RADIATION_VERS2 ( IDIM ,KFLEV, KRAD_DIAG, KAER, &
+ ZDZ,HEFRADL,HEFRADI,HOPWSW, HOPISW, HOPWLW, HOPILW,PFUDG, &
+ ZRII0, ZAER , ZALBD, ZALBP, ZPRES_HL, ZPAVE_RAD, &
+ PCCO2, ZCFAVE, ZDPRES, ZEMIS(:,1), ZEMIW(:,1), ZLSM, ZRMU0, &
+ ZO3AVE , ZQVAVE, ZQIAVE ,ZQIWC,ZQLAVE,ZQLWC, ZQSAVE, ZQRAVE, ZQRWC, &
+ ZT_HL,ZTAVE_RAD, ZTS, ZCCT_C2R2, ZCRT_C2R2, ZCIT_C1R3, &
+ ZNFLW_CS, ZNFLW, ZNFSW_CS,ZNFSW, &
+ ZDTLW, ZDTSW, ZFLUX_TOP_GND_IRVISNIR, &
+ ZSFSWDIR, ZSFSWDIF, &
+ ZFLUX_SW_DOWN, ZFLUX_SW_UP, ZFLUX_LW , &
+ ZDTLW_CS, ZDTSW_CS, ZFLUX_TOP_GND_IRVISNIR_CS, &
+ ZFLUX_SW_DOWN_CS, ZFLUX_SW_UP_CS, ZFLUX_LW_CS, &
+ ZPLAN_ALB_VIS,ZPLAN_ALB_NIR, ZPLAN_TRA_VIS, ZPLAN_TRA_NIR, &
+ ZPLAN_ABS_VIS, ZPLAN_ABS_NIR,ZEFCL_LWD, ZEFCL_LWU, &
+ ZFLWP, ZFIWP,ZRADLP, ZRADIP,ZEFCL_RRTM, ZCLSW_TOTAL, ZTAU_TOTAL, &
+ ZOMEGA_TOTAL,ZCG_TOTAL, &
+ GAOP, ZPIZA_EQ,ZCGA_EQ,ZTAUREL_EQ )
+
+ ELSE IF (CRAD == "ECRA") THEN
+ CALL ECRAD_INTERFACE ( IDIM ,KFLEV, KRAD_DIAG, KAER, &
+ ZDZ,HEFRADL,HEFRADI,HOPWSW, HOPISW, HOPWLW, HOPILW,PFUDG, &
+ ZRII0, ZAER , ZALBD, ZALBP, ZPRES_HL, ZPAVE_RAD, &
+ PCCO2, ZCFAVE, ZDPRES, ZEMIS(:,1), ZEMIW(:,1), ZLSM, ZRMU0, &
+ ZO3AVE , ZQVAVE, ZQIAVE ,ZQIWC,ZQLAVE,ZQLWC, ZQSAVE, ZQRAVE, ZQRWC, &
+ ZT_HL,ZTAVE_RAD, ZTS, ZCCT_C2R2, ZCRT_C2R2, ZCIT_C1R3, &
+ ZNFLW, ZNFSW, ZNFLW_CS, ZNFSW_CS, &
+ ZDTLW, ZDTSW, ZFLUX_TOP_GND_IRVISNIR, &
+ ZSFSWDIR, ZSFSWDIF, &
+ ZFLUX_SW_DOWN, ZFLUX_SW_UP, ZFLUX_LW , &
+ ZDTLW_CS, ZDTSW_CS, ZFLUX_TOP_GND_IRVISNIR_CS, &
+ ZFLUX_SW_DOWN_CS, ZFLUX_SW_UP_CS, ZFLUX_LW_CS, &
+ ZPLAN_ALB_VIS,ZPLAN_ALB_NIR, ZPLAN_TRA_VIS, ZPLAN_TRA_NIR, &
+ ZPLAN_ABS_VIS, ZPLAN_ABS_NIR,ZEFCL_LWD, ZEFCL_LWU, &
+ ZFLWP, ZFIWP,ZRADLP, ZRADIP,ZEFCL_RRTM, ZCLSW_TOTAL, ZTAU_TOTAL, &
+ ZOMEGA_TOTAL,ZCG_TOTAL, &
+ GAOP, ZPIZA_EQ,ZCGA_EQ,ZTAUREL_EQ ,ZLAT,ZLON )
+ END IF
+
+
+ END IF
+ DEALLOCATE(ZTAVE_RAD,ZPAVE_RAD)
+!
+ELSE
+!
+! the splitting of the arrays will be performed
+!
+ INUM_CALL = CEILING( REAL( IDIM ) / REAL( KRAD_COLNBR ) )
+ IDIM_RESIDUE = IDIM
+!
+ DO JI_SPLIT = 1 , INUM_CALL
+ IDIM_EFF = MIN( IDIM_RESIDUE,KRAD_COLNBR )
+ !
+ IF( JI_SPLIT == 1 .OR. JI_SPLIT == INUM_CALL ) THEN
+ ALLOCATE( ZALBP_SPLIT(IDIM_EFF,KSWB_MNH))
+ ALLOCATE( ZALBD_SPLIT(IDIM_EFF,KSWB_MNH))
+ ALLOCATE( ZEMIS_SPLIT(IDIM_EFF))
+ ALLOCATE( ZEMIW_SPLIT(IDIM_EFF))
+ ALLOCATE( ZRMU0_SPLIT(IDIM_EFF))
+ ALLOCATE( ZLAT_SPLIT(IDIM_EFF))
+ ALLOCATE( ZLON_SPLIT(IDIM_EFF))
+ ALLOCATE( ZCFAVE_SPLIT(IDIM_EFF,KFLEV))
+ ALLOCATE( ZO3AVE_SPLIT(IDIM_EFF,KFLEV))
+ ALLOCATE( ZT_HL_SPLIT(IDIM_EFF,KFLEV+1))
+ ALLOCATE( ZPRES_HL_SPLIT(IDIM_EFF,KFLEV+1))
+ ALLOCATE( ZDZ_SPLIT(IDIM_EFF,KFLEV))
+ ALLOCATE( ZQLAVE_SPLIT(IDIM_EFF,KFLEV))
+ ALLOCATE( ZQIAVE_SPLIT(IDIM_EFF,KFLEV))
+ ALLOCATE( ZQRAVE_SPLIT(IDIM_EFF,KFLEV))
+ ALLOCATE( ZQLWC_SPLIT(IDIM_EFF,KFLEV))
+ ALLOCATE( ZQIWC_SPLIT(IDIM_EFF,KFLEV))
+ ALLOCATE( ZQRWC_SPLIT(IDIM_EFF,KFLEV))
+ ALLOCATE( ZQVAVE_SPLIT(IDIM_EFF,KFLEV))
+ ALLOCATE( ZTAVE_SPLIT(IDIM_EFF,KFLEV))
+ ALLOCATE( ZPAVE_SPLIT(IDIM_EFF,KFLEV))
+ ALLOCATE( ZAER_SPLIT( IDIM_EFF,KFLEV,KAER))
+ ALLOCATE( ZPIZA_EQ_SPLIT(IDIM_EFF,KFLEV,KSWB_OLD))
+ ALLOCATE( ZCGA_EQ_SPLIT(IDIM_EFF,KFLEV,KSWB_OLD))
+ ALLOCATE( ZTAUREL_EQ_SPLIT(IDIM_EFF,KFLEV,KSWB_OLD))
+ ALLOCATE( ZDPRES_SPLIT(IDIM_EFF,KFLEV))
+ ALLOCATE( ZLSM_SPLIT(IDIM_EFF))
+ ALLOCATE( ZQSAVE_SPLIT(IDIM_EFF,KFLEV))
+ ALLOCATE( ZTS_SPLIT(IDIM_EFF))
+ ! output pronostic
+ ALLOCATE( ZDTLW_SPLIT(IDIM_EFF,KFLEV))
+ ALLOCATE( ZDTSW_SPLIT(IDIM_EFF,KFLEV))
+ ALLOCATE( ZFLUX_TOP_GND_IRVISNIR_SPLIT(IDIM_EFF,KFLUX))
+ ALLOCATE( ZSFSWDIR_SPLIT(IDIM_EFF,ISWB))
+ ALLOCATE( ZSFSWDIF_SPLIT(IDIM_EFF,ISWB))
+ ALLOCATE( ZDTLW_CS_SPLIT(IDIM_EFF,KFLEV))
+ ALLOCATE( ZDTSW_CS_SPLIT(IDIM_EFF,KFLEV))
+ ALLOCATE( ZFLUX_TOP_GND_IRVISNIR_CS_SPLIT(IDIM_EFF,KFLUX))
+!
+ ALLOCATE( ZFLUX_LW_SPLIT(IDIM_EFF,2,KFLEV+1))
+ ALLOCATE( ZFLUX_SW_DOWN_SPLIT(IDIM_EFF,KFLEV+1))
+ ALLOCATE( ZFLUX_SW_UP_SPLIT(IDIM_EFF,KFLEV+1))
+ ALLOCATE( ZRADLP_SPLIT(IDIM_EFF,KFLEV))
+ IF(KRAD_DIAG >=1) THEN
+ ALLOCATE( ZNFSW_SPLIT(IDIM_EFF,KFLEV+1))
+ ALLOCATE( ZNFLW_SPLIT(IDIM_EFF,KFLEV+1))
+ ELSE
+ ALLOCATE( ZNFSW_SPLIT(0,0))
+ ALLOCATE( ZNFLW_SPLIT(0,0))
+ END IF
+!
+ IF( KRAD_DIAG >= 2) THEN
+ ALLOCATE( ZFLUX_SW_DOWN_CS_SPLIT(IDIM_EFF,KFLEV+1))
+ ALLOCATE( ZFLUX_SW_UP_CS_SPLIT(IDIM_EFF,KFLEV+1))
+ ALLOCATE( ZFLUX_LW_CS_SPLIT(IDIM_EFF,2,KFLEV+1))
+ ALLOCATE( ZNFSW_CS_SPLIT(IDIM_EFF,KFLEV+1))
+ ALLOCATE( ZNFLW_CS_SPLIT(IDIM_EFF,KFLEV+1))
+ ELSE
+ ALLOCATE( ZFLUX_SW_DOWN_CS_SPLIT(0,0))
+ ALLOCATE( ZFLUX_SW_UP_CS_SPLIT(0,0))
+ ALLOCATE( ZFLUX_LW_CS_SPLIT(0,0,0))
+ ALLOCATE( ZNFSW_CS_SPLIT(0,0))
+ ALLOCATE( ZNFLW_CS_SPLIT(0,0))
+ END IF
+!
+ IF( KRAD_DIAG >= 3) THEN
+ ALLOCATE( ZPLAN_ALB_VIS_SPLIT(IDIM_EFF))
+ ALLOCATE( ZPLAN_ALB_NIR_SPLIT(IDIM_EFF))
+ ALLOCATE( ZPLAN_TRA_VIS_SPLIT(IDIM_EFF))
+ ALLOCATE( ZPLAN_TRA_NIR_SPLIT(IDIM_EFF))
+ ALLOCATE( ZPLAN_ABS_VIS_SPLIT(IDIM_EFF))
+ ALLOCATE( ZPLAN_ABS_NIR_SPLIT(IDIM_EFF))
+ ELSE
+ ALLOCATE( ZPLAN_ALB_VIS_SPLIT(0))
+ ALLOCATE( ZPLAN_ALB_NIR_SPLIT(0))
+ ALLOCATE( ZPLAN_TRA_VIS_SPLIT(0))
+ ALLOCATE( ZPLAN_TRA_NIR_SPLIT(0))
+ ALLOCATE( ZPLAN_ABS_VIS_SPLIT(0))
+ ALLOCATE( ZPLAN_ABS_NIR_SPLIT(0))
+ END IF
+!
+ IF( KRAD_DIAG >= 4) THEN
+ ALLOCATE( ZEFCL_RRTM_SPLIT(IDIM_EFF,KFLEV))
+ ALLOCATE( ZCLSW_TOTAL_SPLIT(IDIM_EFF,KFLEV))
+ ALLOCATE( ZTAU_TOTAL_SPLIT(IDIM_EFF,KSWB_OLD,KFLEV))
+ ALLOCATE( ZOMEGA_TOTAL_SPLIT(IDIM_EFF,KSWB_OLD,KFLEV))
+ ALLOCATE( ZCG_TOTAL_SPLIT(IDIM_EFF,KSWB_OLD,KFLEV))
+ ALLOCATE( ZEFCL_LWD_SPLIT(IDIM_EFF,KFLEV))
+ ALLOCATE( ZEFCL_LWU_SPLIT(IDIM_EFF,KFLEV))
+ ALLOCATE( ZFLWP_SPLIT(IDIM_EFF,KFLEV))
+ ALLOCATE( ZFIWP_SPLIT(IDIM_EFF,KFLEV))
+ ALLOCATE( ZRADIP_SPLIT(IDIM_EFF,KFLEV))
+ ELSE
+ ALLOCATE( ZEFCL_RRTM_SPLIT(0,0))
+ ALLOCATE( ZCLSW_TOTAL_SPLIT(0,0))
+ ALLOCATE( ZTAU_TOTAL_SPLIT(0,0,0))
+ ALLOCATE( ZOMEGA_TOTAL_SPLIT(0,0,0))
+ ALLOCATE( ZCG_TOTAL_SPLIT(0,0,0))
+ ALLOCATE( ZEFCL_LWD_SPLIT(0,0))
+ ALLOCATE( ZEFCL_LWU_SPLIT(0,0))
+ ALLOCATE( ZFLWP_SPLIT(0,0))
+ ALLOCATE( ZFIWP_SPLIT(0,0))
+ ALLOCATE( ZRADIP_SPLIT(0,0))
+ END IF
+!
+! C2R2 coupling
+!
+ IF (SIZE (ZCCT_C2R2) > 0) THEN
+ ALLOCATE (ZCCT_C2R2_SPLIT(IDIM_EFF,KFLEV))
+ ELSE
+ ALLOCATE (ZCCT_C2R2_SPLIT(0,0))
+ END IF
+!
+ IF (SIZE (ZCRT_C2R2) > 0) THEN
+ ALLOCATE (ZCRT_C2R2_SPLIT(IDIM_EFF,KFLEV))
+ ELSE
+ ALLOCATE (ZCRT_C2R2_SPLIT(0,0))
+ END IF
+!
+ IF (SIZE (ZCIT_C1R3) > 0) THEN
+ ALLOCATE (ZCIT_C1R3_SPLIT(IDIM_EFF,KFLEV))
+ ELSE
+ ALLOCATE (ZCIT_C1R3_SPLIT(0,0))
+ END IF
+!
+! LIMA coupling
+!
+ IF( CCLOUD == 'LIMA' ) THEN
+ ALLOCATE (ZCCT_LIMA_SPLIT(IDIM_EFF,KFLEV))
+ ALLOCATE (ZCRT_LIMA_SPLIT(IDIM_EFF,KFLEV))
+ ALLOCATE (ZCIT_LIMA_SPLIT(IDIM_EFF,KFLEV))
+ END IF
+ END IF
+!
+! fill the split arrays with their values taken from the full arrays
+!
+ IBEG = IDIM-IDIM_RESIDUE+1
+ IEND = IBEG+IDIM_EFF-1
+!
+ ZALBP_SPLIT(:,:) = ZALBP( IBEG:IEND ,:)
+ ZALBD_SPLIT(:,:) = ZALBD( IBEG:IEND ,:)
+ ZEMIS_SPLIT(:) = ZEMIS ( IBEG:IEND,1 )
+ ZEMIW_SPLIT(:) = ZEMIW ( IBEG:IEND,1 )
+ ZRMU0_SPLIT(:) = ZRMU0 ( IBEG:IEND )
+ ZLAT_SPLIT(:) = ZLAT ( IBEG:IEND )
+ ZLON_SPLIT(:) = ZLON ( IBEG:IEND )
+ ZCFAVE_SPLIT(:,:) = ZCFAVE( IBEG:IEND ,:)
+ ZO3AVE_SPLIT(:,:) = ZO3AVE( IBEG:IEND ,:)
+ ZT_HL_SPLIT(:,:) = ZT_HL( IBEG:IEND ,:)
+ ZPRES_HL_SPLIT(:,:) = ZPRES_HL( IBEG:IEND ,:)
+ ZQLAVE_SPLIT(:,:) = ZQLAVE( IBEG:IEND , :)
+ ZDZ_SPLIT(:,:) = ZDZ( IBEG:IEND , :)
+ ZQIAVE_SPLIT(:,:) = ZQIAVE( IBEG:IEND ,:)
+ ZQRAVE_SPLIT (:,:) = ZQRAVE (IBEG:IEND ,:)
+ ZQLWC_SPLIT(:,:) = ZQLWC( IBEG:IEND , :)
+ ZQIWC_SPLIT(:,:) = ZQIWC( IBEG:IEND ,:)
+ ZQRWC_SPLIT(:,:) = ZQRWC (IBEG:IEND ,:)
+ ZQVAVE_SPLIT(:,:) = ZQVAVE( IBEG:IEND ,:)
+ ZTAVE_SPLIT(:,:) = ZTAVE ( IBEG:IEND ,:)
+ ZPAVE_SPLIT(:,:) = ZPAVE ( IBEG:IEND ,:)
+ ZAER_SPLIT (:,:,:) = ZAER ( IBEG:IEND ,:,:)
+ IF(CAOP=='EXPL')THEN
+ ZPIZA_EQ_SPLIT(:,:,:)=ZPIZA_EQ(IBEG:IEND,:,:)
+ ZCGA_EQ_SPLIT(:,:,:)=ZCGA_EQ(IBEG:IEND,:,:)
+ ZTAUREL_EQ_SPLIT(:,:,:)=ZTAUREL_EQ(IBEG:IEND,:,:)
+ ENDIF
+ ZDPRES_SPLIT(:,:) = ZDPRES (IBEG:IEND ,:)
+ ZLSM_SPLIT (:) = ZLSM (IBEG:IEND)
+ ZQSAVE_SPLIT (:,:) = ZQSAVE (IBEG:IEND ,:)
+ ZTS_SPLIT (:) = ZTS (IBEG:IEND)
+!
+! CALL the ECMWF radiation with the split array
+!
+ IF (CCLOUD == 'LIMA') THEN
+! LIMA concentrations
+ ZCCT_LIMA_SPLIT(:,:) = ZCCT_LIMA (IBEG:IEND ,:)
+ ZCRT_LIMA_SPLIT(:,:) = ZCRT_LIMA (IBEG:IEND ,:)
+ ZCIT_LIMA_SPLIT(:,:) = ZCIT_LIMA (IBEG:IEND ,:)
+
+ IF (CRAD == "ECMW") THEN
+!
+ CALL ECMWF_RADIATION_VERS2 ( IDIM_EFF , KFLEV, KRAD_DIAG, KAER, &
+ ZDZ_SPLIT,HEFRADL,HEFRADI,HOPWSW, HOPISW, HOPWLW, HOPILW,PFUDG, &
+ ZRII0, ZAER_SPLIT , ZALBD_SPLIT, ZALBP_SPLIT, ZPRES_HL_SPLIT, &
+ ZPAVE_SPLIT,PCCO2, ZCFAVE_SPLIT, ZDPRES_SPLIT, ZEMIS_SPLIT, ZEMIW_SPLIT, &
+ ZLSM_SPLIT, ZRMU0_SPLIT,ZO3AVE_SPLIT , ZQVAVE_SPLIT, ZQIAVE_SPLIT ,ZQIWC_SPLIT, &
+ ZQLAVE_SPLIT,ZQLWC_SPLIT,ZQSAVE_SPLIT, ZQRAVE_SPLIT,ZQRWC_SPLIT, ZT_HL_SPLIT, &
+ ZTAVE_SPLIT, ZTS_SPLIT, ZCCT_LIMA_SPLIT,ZCRT_LIMA_SPLIT,ZCIT_LIMA_SPLIT, &
+ ZNFLW_CS_SPLIT, ZNFLW_SPLIT, ZNFSW_CS_SPLIT,ZNFSW_SPLIT, &
+ ZDTLW_SPLIT, ZDTSW_SPLIT, ZFLUX_TOP_GND_IRVISNIR_SPLIT, &
+ ZSFSWDIR_SPLIT, ZSFSWDIF_SPLIT, &
+ ZFLUX_SW_DOWN_SPLIT, ZFLUX_SW_UP_SPLIT, ZFLUX_LW_SPLIT , &
+ ZDTLW_CS_SPLIT, ZDTSW_CS_SPLIT, ZFLUX_TOP_GND_IRVISNIR_CS_SPLIT, &
+ ZFLUX_SW_DOWN_CS_SPLIT, ZFLUX_SW_UP_CS_SPLIT, ZFLUX_LW_CS_SPLIT, &
+ ZPLAN_ALB_VIS_SPLIT,ZPLAN_ALB_NIR_SPLIT, ZPLAN_TRA_VIS_SPLIT, &
+ ZPLAN_TRA_NIR_SPLIT, ZPLAN_ABS_VIS_SPLIT, ZPLAN_ABS_NIR_SPLIT, &
+ ZEFCL_LWD_SPLIT, ZEFCL_LWU_SPLIT, ZFLWP_SPLIT,ZFIWP_SPLIT, &
+ ZRADLP_SPLIT,ZRADIP_SPLIT,ZEFCL_RRTM_SPLIT, ZCLSW_TOTAL_SPLIT, &
+ ZTAU_TOTAL_SPLIT,ZOMEGA_TOTAL_SPLIT, ZCG_TOTAL_SPLIT, &
+ GAOP,ZPIZA_EQ_SPLIT,ZCGA_EQ_SPLIT,ZTAUREL_EQ_SPLIT )
+
+ ELSE IF (CRAD == "ECRA") THEN
+ CALL ECRAD_INTERFACE ( IDIM_EFF ,KFLEV, KRAD_DIAG, KAER, &
+ ZDZ,HEFRADL,HEFRADI,HOPWSW, HOPISW, HOPWLW, HOPILW,PFUDG, &
+ ZRII0, ZAER_SPLIT , ZALBD_SPLIT, ZALBP_SPLIT, ZPRES_HL_SPLIT, ZPAVE_SPLIT, &
+ PCCO2, ZCFAVE_SPLIT, ZDPRES_SPLIT, ZEMIS_SPLIT, ZEMIW_SPLIT, ZLSM_SPLIT, ZRMU0_SPLIT, &
+ ZO3AVE_SPLIT , ZQVAVE_SPLIT, ZQIAVE_SPLIT ,ZQIWC_SPLIT,ZQLAVE_SPLIT,ZQLWC_SPLIT, &
+ ZQSAVE_SPLIT, ZQRAVE_SPLIT, ZQRWC_SPLIT, &
+ ZT_HL_SPLIT,ZTAVE_SPLIT, ZTS_SPLIT, ZCCT_LIMA_SPLIT, &
+ ZCRT_LIMA_SPLIT, ZCIT_LIMA_SPLIT, &
+ ZNFLW_SPLIT, ZNFSW_SPLIT, ZNFLW_CS_SPLIT, ZNFSW_CS_SPLIT, &
+ ZDTLW_SPLIT, ZDTSW_SPLIT, ZFLUX_TOP_GND_IRVISNIR_SPLIT, &
+ ZSFSWDIR_SPLIT, ZSFSWDIF_SPLIT, &
+ ZFLUX_SW_DOWN_SPLIT, ZFLUX_SW_UP_SPLIT, ZFLUX_LW_SPLIT , &
+ ZDTLW_CS_SPLIT, ZDTSW_CS_SPLIT, ZFLUX_TOP_GND_IRVISNIR_CS_SPLIT, &
+ ZFLUX_SW_DOWN_CS_SPLIT, ZFLUX_SW_UP_CS_SPLIT, ZFLUX_LW_CS_SPLIT, &
+ ZPLAN_ALB_VIS_SPLIT,ZPLAN_ALB_NIR_SPLIT, ZPLAN_TRA_VIS_SPLIT, ZPLAN_TRA_NIR_SPLIT, &
+ ZPLAN_ABS_VIS_SPLIT, ZPLAN_ABS_NIR_SPLIT,ZEFCL_LWD_SPLIT, ZEFCL_LWU_SPLIT, &
+ ZFLWP_SPLIT, ZFIWP_SPLIT,ZRADLP_SPLIT, ZRADIP_SPLIT, &
+ ZEFCL_RRTM_SPLIT, ZCLSW_TOTAL_SPLIT, ZTAU_TOTAL_SPLIT, &
+ ZOMEGA_TOTAL_SPLIT,ZCG_TOTAL_SPLIT, &
+ GAOP, ZPIZA_EQ_SPLIT,ZCGA_EQ_SPLIT,ZTAUREL_EQ_SPLIT,ZLAT_SPLIT,ZLON_SPLIT )
+ END IF
+ ELSE
+! C2R2 concentrations
+ IF (SIZE (ZCCT_C2R2) > 0) ZCCT_C2R2_SPLIT(:,:) = ZCCT_C2R2 (IBEG:IEND ,:)
+ IF (SIZE (ZCRT_C2R2) > 0) ZCRT_C2R2_SPLIT(:,:) = ZCRT_C2R2 (IBEG:IEND ,:)
+ IF (SIZE (ZCIT_C1R3) > 0) ZCIT_C1R3_SPLIT(:,:) = ZCIT_C1R3 (IBEG:IEND ,:)
+ IF (CRAD == "ECMW") THEN
+ CALL ECMWF_RADIATION_VERS2 ( IDIM_EFF , KFLEV, KRAD_DIAG, KAER, &
+ ZDZ_SPLIT,HEFRADL,HEFRADI,HOPWSW, HOPISW, HOPWLW, HOPILW,PFUDG, &
+ ZRII0, ZAER_SPLIT , ZALBD_SPLIT, ZALBP_SPLIT, ZPRES_HL_SPLIT, &
+ ZPAVE_SPLIT,PCCO2, ZCFAVE_SPLIT, ZDPRES_SPLIT, ZEMIS_SPLIT, ZEMIW_SPLIT, &
+ ZLSM_SPLIT, ZRMU0_SPLIT,ZO3AVE_SPLIT , ZQVAVE_SPLIT, ZQIAVE_SPLIT ,ZQIWC_SPLIT, &
+ ZQLAVE_SPLIT,ZQLWC_SPLIT,ZQSAVE_SPLIT, ZQRAVE_SPLIT,ZQRWC_SPLIT, ZT_HL_SPLIT, &
+ ZTAVE_SPLIT, ZTS_SPLIT, ZCCT_C2R2_SPLIT,ZCRT_C2R2_SPLIT,ZCIT_C1R3_SPLIT, &
+ ZNFLW_CS_SPLIT, ZNFLW_SPLIT, ZNFSW_CS_SPLIT,ZNFSW_SPLIT, &
+ ZDTLW_SPLIT, ZDTSW_SPLIT, ZFLUX_TOP_GND_IRVISNIR_SPLIT, &
+ ZSFSWDIR_SPLIT, ZSFSWDIF_SPLIT, &
+ ZFLUX_SW_DOWN_SPLIT, ZFLUX_SW_UP_SPLIT, ZFLUX_LW_SPLIT , &
+ ZDTLW_CS_SPLIT, ZDTSW_CS_SPLIT, ZFLUX_TOP_GND_IRVISNIR_CS_SPLIT, &
+ ZFLUX_SW_DOWN_CS_SPLIT, ZFLUX_SW_UP_CS_SPLIT, ZFLUX_LW_CS_SPLIT, &
+ ZPLAN_ALB_VIS_SPLIT,ZPLAN_ALB_NIR_SPLIT, ZPLAN_TRA_VIS_SPLIT, &
+ ZPLAN_TRA_NIR_SPLIT, ZPLAN_ABS_VIS_SPLIT, ZPLAN_ABS_NIR_SPLIT, &
+ ZEFCL_LWD_SPLIT, ZEFCL_LWU_SPLIT, ZFLWP_SPLIT,ZFIWP_SPLIT, &
+ ZRADLP_SPLIT,ZRADIP_SPLIT,ZEFCL_RRTM_SPLIT, ZCLSW_TOTAL_SPLIT, &
+ ZTAU_TOTAL_SPLIT,ZOMEGA_TOTAL_SPLIT, ZCG_TOTAL_SPLIT, &
+ GAOP,ZPIZA_EQ_SPLIT,ZCGA_EQ_SPLIT,ZTAUREL_EQ_SPLIT )
+
+ ELSE IF (CRAD == "ECRA") THEN
+ CALL ECRAD_INTERFACE ( IDIM_EFF ,KFLEV, KRAD_DIAG, KAER, &
+ ZDZ_SPLIT,HEFRADL,HEFRADI,HOPWSW, HOPISW, HOPWLW, HOPILW,PFUDG, &
+ ZRII0, ZAER_SPLIT , ZALBD_SPLIT, ZALBP_SPLIT, ZPRES_HL_SPLIT, ZPAVE_SPLIT, &
+ PCCO2, ZCFAVE_SPLIT, ZDPRES_SPLIT, ZEMIS_SPLIT, ZEMIW_SPLIT, ZLSM_SPLIT, ZRMU0_SPLIT, &
+ ZO3AVE_SPLIT , ZQVAVE_SPLIT, ZQIAVE_SPLIT ,ZQIWC_SPLIT,ZQLAVE_SPLIT,ZQLWC_SPLIT, &
+ ZQSAVE_SPLIT, ZQRAVE_SPLIT, ZQRWC_SPLIT, &
+ ZT_HL_SPLIT,ZTAVE_SPLIT, ZTS_SPLIT, ZCCT_C2R2_SPLIT, &
+ ZCRT_C2R2_SPLIT, ZCIT_C1R3_SPLIT, &
+ ZNFLW_SPLIT, ZNFSW_SPLIT, ZNFLW_CS_SPLIT, ZNFSW_CS_SPLIT, &
+ ZDTLW_SPLIT, ZDTSW_SPLIT, ZFLUX_TOP_GND_IRVISNIR_SPLIT, &
+ ZSFSWDIR_SPLIT, ZSFSWDIF_SPLIT, &
+ ZFLUX_SW_DOWN_SPLIT, ZFLUX_SW_UP_SPLIT, ZFLUX_LW_SPLIT , &
+ ZDTLW_CS_SPLIT, ZDTSW_CS_SPLIT, ZFLUX_TOP_GND_IRVISNIR_CS_SPLIT, &
+ ZFLUX_SW_DOWN_CS_SPLIT, ZFLUX_SW_UP_CS_SPLIT, ZFLUX_LW_CS_SPLIT, &
+ ZPLAN_ALB_VIS_SPLIT,ZPLAN_ALB_NIR_SPLIT, ZPLAN_TRA_VIS_SPLIT, ZPLAN_TRA_NIR_SPLIT, &
+ ZPLAN_ABS_VIS_SPLIT, ZPLAN_ABS_NIR_SPLIT,ZEFCL_LWD_SPLIT, ZEFCL_LWU_SPLIT, &
+ ZFLWP_SPLIT, ZFIWP_SPLIT,ZRADLP_SPLIT, ZRADIP_SPLIT, &
+ ZEFCL_RRTM_SPLIT, ZCLSW_TOTAL_SPLIT, ZTAU_TOTAL_SPLIT, &
+ ZOMEGA_TOTAL_SPLIT,ZCG_TOTAL_SPLIT, &
+ GAOP, ZPIZA_EQ_SPLIT,ZCGA_EQ_SPLIT,ZTAUREL_EQ_SPLIT,ZLAT_SPLIT,ZLON_SPLIT )
+ END IF
+ END IF
+!
+! fill the full output arrays with the split arrays
+!
+ ZDTLW( IBEG:IEND ,:) = ZDTLW_SPLIT(:,:)
+ ZDTSW( IBEG:IEND ,:) = ZDTSW_SPLIT(:,:)
+ ZFLUX_TOP_GND_IRVISNIR( IBEG:IEND ,:)= ZFLUX_TOP_GND_IRVISNIR_SPLIT(:,:)
+ ZSFSWDIR (IBEG:IEND,:) = ZSFSWDIR_SPLIT(:,:)
+ ZSFSWDIF (IBEG:IEND,:) = ZSFSWDIF_SPLIT(:,:)
+!
+ ZDTLW_CS( IBEG:IEND ,:) = ZDTLW_CS_SPLIT(:,:)
+ ZDTSW_CS( IBEG:IEND ,:) = ZDTSW_CS_SPLIT(:,:)
+ ZFLUX_TOP_GND_IRVISNIR_CS( IBEG:IEND ,:) = &
+ ZFLUX_TOP_GND_IRVISNIR_CS_SPLIT(:,:)
+ ZFLUX_LW( IBEG:IEND ,:,:) = ZFLUX_LW_SPLIT(:,:,:)
+ ZFLUX_SW_DOWN( IBEG:IEND ,:) = ZFLUX_SW_DOWN_SPLIT(:,:)
+ ZFLUX_SW_UP( IBEG:IEND ,:) = ZFLUX_SW_UP_SPLIT(:,:)
+ ZRADLP( IBEG:IEND ,:) = ZRADLP_SPLIT(:,:)
+ IF ( tpfile%lopened ) THEN
+ IF( KRAD_DIAG >= 1) THEN
+ ZNFLW(IBEG:IEND ,:)= ZNFLW_SPLIT(:,:)
+ ZNFSW(IBEG:IEND ,:)= ZNFSW_SPLIT(:,:)
+ IF( KRAD_DIAG >= 2) THEN
+ ZFLUX_SW_DOWN_CS( IBEG:IEND ,:) = ZFLUX_SW_DOWN_CS_SPLIT(:,:)
+ ZFLUX_SW_UP_CS( IBEG:IEND ,:) = ZFLUX_SW_UP_CS_SPLIT(:,:)
+ ZFLUX_LW_CS( IBEG:IEND ,:,:) = ZFLUX_LW_CS_SPLIT(:,:,:)
+ ZNFLW_CS(IBEG:IEND ,:)= ZNFLW_CS_SPLIT(:,:)
+ ZNFSW_CS(IBEG:IEND ,:)= ZNFSW_CS_SPLIT(:,:)
+ IF( KRAD_DIAG >= 3) THEN
+ ZPLAN_ALB_VIS( IBEG:IEND ) = ZPLAN_ALB_VIS_SPLIT(:)
+ ZPLAN_ALB_NIR( IBEG:IEND ) = ZPLAN_ALB_NIR_SPLIT(:)
+ ZPLAN_TRA_VIS( IBEG:IEND ) = ZPLAN_TRA_VIS_SPLIT(:)
+ ZPLAN_TRA_NIR( IBEG:IEND ) = ZPLAN_TRA_NIR_SPLIT(:)
+ ZPLAN_ABS_VIS( IBEG:IEND ) = ZPLAN_ABS_VIS_SPLIT(:)
+ ZPLAN_ABS_NIR( IBEG:IEND ) = ZPLAN_ABS_NIR_SPLIT(:)
+ IF( KRAD_DIAG >= 4) THEN
+ ZEFCL_LWD( IBEG:IEND ,:) = ZEFCL_LWD_SPLIT(:,:)
+ ZEFCL_LWU( IBEG:IEND ,:) = ZEFCL_LWU_SPLIT(:,:)
+ ZFLWP( IBEG:IEND ,:) = ZFLWP_SPLIT(:,:)
+ ZFIWP( IBEG:IEND ,:) = ZFIWP_SPLIT(:,:)
+ ZRADIP( IBEG:IEND ,:) = ZRADIP_SPLIT(:,:)
+ ZEFCL_RRTM( IBEG:IEND ,:) = ZEFCL_RRTM_SPLIT(:,:)
+ ZCLSW_TOTAL( IBEG:IEND ,:) = ZCLSW_TOTAL_SPLIT(:,:)
+ ZTAU_TOTAL( IBEG:IEND ,:,:) = ZTAU_TOTAL_SPLIT(:,:,:)
+ ZOMEGA_TOTAL( IBEG:IEND ,:,:)= ZOMEGA_TOTAL_SPLIT(:,:,:)
+ ZCG_TOTAL( IBEG:IEND ,:,:) = ZCG_TOTAL_SPLIT(:,:,:)
+ END IF
+ END IF
+ END IF
+ END IF
+ END IF
+!
+ IDIM_RESIDUE = IDIM_RESIDUE - IDIM_EFF
+!
+! desallocation of the split arrays
+!
+ IF( JI_SPLIT >= INUM_CALL-1 ) THEN
+ DEALLOCATE( ZALBP_SPLIT )
+ DEALLOCATE( ZALBD_SPLIT )
+ DEALLOCATE( ZEMIS_SPLIT )
+ DEALLOCATE( ZEMIW_SPLIT )
+ DEALLOCATE( ZLAT_SPLIT )
+ DEALLOCATE( ZLON_SPLIT )
+ DEALLOCATE( ZRMU0_SPLIT )
+ DEALLOCATE( ZCFAVE_SPLIT )
+ DEALLOCATE( ZO3AVE_SPLIT )
+ DEALLOCATE( ZT_HL_SPLIT )
+ DEALLOCATE( ZPRES_HL_SPLIT )
+ DEALLOCATE( ZDZ_SPLIT )
+ DEALLOCATE( ZQLAVE_SPLIT )
+ DEALLOCATE( ZQIAVE_SPLIT )
+ DEALLOCATE( ZQVAVE_SPLIT )
+ DEALLOCATE( ZTAVE_SPLIT )
+ DEALLOCATE( ZPAVE_SPLIT )
+ DEALLOCATE( ZAER_SPLIT )
+ DEALLOCATE( ZDPRES_SPLIT )
+ DEALLOCATE( ZLSM_SPLIT )
+ DEALLOCATE( ZQSAVE_SPLIT )
+ DEALLOCATE( ZQRAVE_SPLIT )
+ DEALLOCATE( ZQLWC_SPLIT )
+ DEALLOCATE( ZQRWC_SPLIT )
+ DEALLOCATE( ZQIWC_SPLIT )
+ IF ( ALLOCATED( ZCCT_C2R2_SPLIT ) ) DEALLOCATE( ZCCT_C2R2_SPLIT )
+ IF ( ALLOCATED( ZCRT_C2R2_SPLIT ) ) DEALLOCATE( ZCRT_C2R2_SPLIT )
+ IF ( ALLOCATED( ZCIT_C1R3_SPLIT ) ) DEALLOCATE( ZCIT_C1R3_SPLIT )
+ IF ( ALLOCATED( ZCCT_LIMA_SPLIT ) ) DEALLOCATE( ZCCT_LIMA_SPLIT )
+ IF ( ALLOCATED( ZCRT_LIMA_SPLIT ) ) DEALLOCATE( ZCRT_LIMA_SPLIT )
+ IF ( ALLOCATED( ZCIT_LIMA_SPLIT ) ) DEALLOCATE( ZCIT_LIMA_SPLIT )
+ DEALLOCATE( ZTS_SPLIT )
+ DEALLOCATE( ZNFLW_CS_SPLIT)
+ DEALLOCATE( ZNFLW_SPLIT)
+ DEALLOCATE( ZNFSW_CS_SPLIT)
+ DEALLOCATE( ZNFSW_SPLIT)
+ DEALLOCATE(ZDTLW_SPLIT)
+ DEALLOCATE(ZDTSW_SPLIT)
+ DEALLOCATE(ZFLUX_TOP_GND_IRVISNIR_SPLIT)
+ DEALLOCATE(ZSFSWDIR_SPLIT)
+ DEALLOCATE(ZSFSWDIF_SPLIT)
+ DEALLOCATE(ZFLUX_SW_DOWN_SPLIT)
+ DEALLOCATE(ZFLUX_SW_UP_SPLIT)
+ DEALLOCATE(ZFLUX_LW_SPLIT)
+ DEALLOCATE(ZDTLW_CS_SPLIT)
+ DEALLOCATE(ZDTSW_CS_SPLIT)
+ DEALLOCATE(ZFLUX_TOP_GND_IRVISNIR_CS_SPLIT)
+ DEALLOCATE(ZPLAN_ALB_VIS_SPLIT)
+ DEALLOCATE(ZPLAN_ALB_NIR_SPLIT)
+ DEALLOCATE(ZPLAN_TRA_VIS_SPLIT)
+ DEALLOCATE(ZPLAN_TRA_NIR_SPLIT)
+ DEALLOCATE(ZPLAN_ABS_VIS_SPLIT)
+ DEALLOCATE(ZPLAN_ABS_NIR_SPLIT)
+ DEALLOCATE(ZEFCL_LWD_SPLIT)
+ DEALLOCATE(ZEFCL_LWU_SPLIT)
+ DEALLOCATE(ZFLWP_SPLIT)
+ DEALLOCATE(ZRADLP_SPLIT)
+ DEALLOCATE(ZRADIP_SPLIT)
+ DEALLOCATE(ZFIWP_SPLIT)
+ DEALLOCATE(ZEFCL_RRTM_SPLIT)
+ DEALLOCATE(ZCLSW_TOTAL_SPLIT)
+ DEALLOCATE(ZTAU_TOTAL_SPLIT)
+ DEALLOCATE(ZOMEGA_TOTAL_SPLIT)
+ DEALLOCATE(ZCG_TOTAL_SPLIT)
+ DEALLOCATE(ZFLUX_SW_DOWN_CS_SPLIT)
+ DEALLOCATE(ZFLUX_SW_UP_CS_SPLIT)
+ DEALLOCATE(ZFLUX_LW_CS_SPLIT)
+ DEALLOCATE(ZPIZA_EQ_SPLIT)
+ DEALLOCATE(ZCGA_EQ_SPLIT)
+ DEALLOCATE(ZTAUREL_EQ_SPLIT)
+ END IF
+ END DO
+END IF
+
+!
+DEALLOCATE(ZTAVE)
+DEALLOCATE(ZPAVE)
+DEALLOCATE(ZQVAVE)
+DEALLOCATE(ZQLAVE)
+DEALLOCATE(ZDZ)
+DEALLOCATE(ZQIAVE)
+DEALLOCATE(ZCFAVE)
+DEALLOCATE(ZPRES_HL)
+DEALLOCATE(ZT_HL)
+DEALLOCATE(ZRMU0)
+DEALLOCATE(ZLSM)
+DEALLOCATE(ZQSAVE)
+DEALLOCATE(ZAER)
+DEALLOCATE(ZPIZA_EQ)
+DEALLOCATE(ZCGA_EQ)
+DEALLOCATE(ZTAUREL_EQ)
+DEALLOCATE(ZDPRES)
+DEALLOCATE(ZCCT_C2R2)
+DEALLOCATE(ZCRT_C2R2)
+DEALLOCATE(ZCIT_C1R3)
+DEALLOCATE(ZLAT)
+DEALLOCATE(ZLON)
+IF (CCLOUD == 'LIMA') THEN
+ DEALLOCATE(ZCCT_LIMA)
+ DEALLOCATE(ZCRT_LIMA)
+ DEALLOCATE(ZCIT_LIMA)
+END IF
+!
+DEALLOCATE(ZTS)
+DEALLOCATE(ZALBP)
+DEALLOCATE(ZALBD)
+DEALLOCATE(ZEMIS)
+DEALLOCATE(ZEMIW)
+DEALLOCATE(ZQRAVE)
+DEALLOCATE(ZQLWC)
+DEALLOCATE(ZQIWC)
+DEALLOCATE(ZQRWC)
+DEALLOCATE(ICLEAR_2D_TM1)
+!
+!* 5.6 UNCOMPRESSES THE OUTPUT FIELD IN CASE OF
+! CLEAR-SKY APPROXIMATION
+!
+IF(OCLEAR_SKY .OR. OCLOUD_ONLY) THEN
+ ALLOCATE(ZWORK1(ICLOUD))
+ ALLOCATE(ZWORK2(ICLOUD+KFLEV)) ! allocation for the KFLEV levels of
+ ALLOCATE(ZWORK4(KFLEV,KDLON))
+ ZWORK2(:) = PACK( TRANSPOSE(ZDTLW(:,:)),MASK=.TRUE. )
+!
+ DO JK=1,KFLEV
+ ZWORK4(JK,:) = ZWORK2(ICLOUD+JK)
+ END DO
+ ZWORK1(1:ICLOUD) = ZWORK2(1:ICLOUD)
+ ZZDTLW(:,:) = TRANSPOSE( UNPACK( ZWORK1(:),MASK=GCLOUDT(:,:) &
+ ,FIELD=ZWORK4(:,:) ) )
+ !
+ ZWORK2(:) = PACK( TRANSPOSE(ZDTSW(:,:)),MASK=.TRUE. )
+ DO JK=1,KFLEV
+ ZWORK4(JK,:) = ZWORK2(ICLOUD+JK)
+ END DO
+ ZWORK1(1:ICLOUD) = ZWORK2(1:ICLOUD)
+ ZZDTSW(:,:) = TRANSPOSE( UNPACK( ZWORK1(:),MASK=GCLOUDT(:,:) &
+ ,FIELD=ZWORK4(:,:) ) )
+ !
+ DEALLOCATE(ZWORK1)
+ DEALLOCATE(ZWORK2)
+ DEALLOCATE(ZWORK4)
+ !
+ ZZTGVISC = ZFLUX_TOP_GND_IRVISNIR(ICLOUD_COL+1,5)
+ !
+ ZZTGVIS(:) = UNPACK( ZFLUX_TOP_GND_IRVISNIR(:,5),MASK=.NOT.GCLEAR_2D(:), &
+ FIELD=ZZTGVISC )
+ ZZTGNIRC = ZFLUX_TOP_GND_IRVISNIR(ICLOUD_COL+1,6)
+ !
+ ZZTGNIR(:) = UNPACK( ZFLUX_TOP_GND_IRVISNIR(:,6),MASK=.NOT.GCLEAR_2D(:), &
+ FIELD=ZZTGNIRC )
+ ZZTGIRC = ZFLUX_TOP_GND_IRVISNIR(ICLOUD_COL+1,4)
+ !
+ ZZTGIR (:) = UNPACK( ZFLUX_TOP_GND_IRVISNIR(:,4),MASK=.NOT.GCLEAR_2D(:), &
+ FIELD=ZZTGIRC )
+ !
+ DO JSWB=1,ISWB
+ ZZSFSWDIRC(JSWB) = ZSFSWDIR (ICLOUD_COL+1,JSWB)
+ !
+ ZZSFSWDIR(:,JSWB) = UNPACK(ZSFSWDIR (:,JSWB),MASK=.NOT.GCLEAR_2D(:), &
+ FIELD= ZZSFSWDIRC(JSWB) )
+ !
+ ZZSFSWDIFC(JSWB) = ZSFSWDIF (ICLOUD_COL+1,JSWB)
+ !
+ ZZSFSWDIF(:,JSWB) = UNPACK(ZSFSWDIF (:,JSWB),MASK=.NOT.GCLEAR_2D(:), &
+ FIELD= ZZSFSWDIFC(JSWB) )
+ END DO
+!
+! No cloud case
+!
+ IF( GNOCL ) THEN
+ IF (SIZE(ZZDTLW,1)>1) THEN
+ ZZDTLW(1,:)= ZZDTLW(2,:)
+ ENDIF
+ IF (SIZE(ZZDTSW,1)>1) THEN
+ ZZDTSW(1,:)= ZZDTSW(2,:)
+ ENDIF
+ ZZTGVIS(1) = ZZTGVISC
+ ZZTGNIR(1) = ZZTGNIRC
+ ZZTGIR(1) = ZZTGIRC
+ ZZSFSWDIR(1,:) = ZZSFSWDIRC(:)
+ ZZSFSWDIF(1,:) = ZZSFSWDIFC(:)
+ END IF
+ELSE
+ ZZDTLW(:,:) = ZDTLW(:,:)
+ ZZDTSW(:,:) = ZDTSW(:,:)
+ ZZTGVIS(:) = ZFLUX_TOP_GND_IRVISNIR(:,5)
+ ZZTGNIR(:) = ZFLUX_TOP_GND_IRVISNIR(:,6)
+ ZZTGIR(:) = ZFLUX_TOP_GND_IRVISNIR(:,4)
+ ZZSFSWDIR(:,:) = ZSFSWDIR(:,:)
+ ZZSFSWDIF(:,:) = ZSFSWDIF(:,:)
+END IF
+!
+DEALLOCATE(ZDTLW)
+DEALLOCATE(ZDTSW)
+DEALLOCATE(ZSFSWDIR)
+DEALLOCATE(ZSFSWDIF)
+!
+!--------------------------------------------------------------------------------------------
+!
+!* 6. COMPUTES THE RADIATIVE SOURCES AND THE DOWNWARD SURFACE FLUXES in 2D horizontal
+! ------------------------------------------------------------------------------
+!
+! Computes the SW and LW radiative tendencies
+! note : tendencies in K/s for MNH (from K/day)
+!
+ZDTRAD_LW(:,:,:)=0.0
+ZDTRAD_SW(:,:,:)=0.0
+DO JK=IKB,IKE
+ JKRAD= JK-JPVEXT
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZDTRAD_LW(JI,JJ,JK) = ZZDTLW(IIJ,JKRAD)/XDAY ! XDAY from modd_cst (day duration in s)
+ ZDTRAD_SW(JI,JJ,JK) = ZZDTSW(IIJ,JKRAD)/XDAY
+ END DO
+ END DO
+END DO
+!
+! Computes the downward SW and LW surface fluxes + diffuse and direct contribution
+!
+ZLWD(:,:)=0.
+ZSWDDIR(:,:,:)=0.
+ZSWDDIF(:,:,:)=0.
+!
+DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZLWD(JI,JJ) = ZZTGIR(IIJ)
+ ZSWDDIR(JI,JJ,:) = ZZSFSWDIR (IIJ,:)
+ ZSWDDIF(JI,JJ,:) = ZZSFSWDIF (IIJ,:)
+ END DO
+END DO
+!
+!final THETA_radiative tendency and surface fluxes
+!
+IF(OCLOUD_ONLY) THEN
+
+ GCLOUD_SURF(:,:) = .FALSE.
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ GCLOUD_SURF(JI,JJ) = GCLOUD(IIJ,1)
+ END DO
+ END DO
+
+ ZWORKL(:,:) = GCLOUD_SURF(:,:)
+
+ DO JK = IKB,IKE
+ WHERE( ZWORKL(:,:) )
+ PDTHRAD(:,:,JK) = (ZDTRAD_LW(:,:,JK)+ZDTRAD_SW(:,:,JK))/ZEXNT(:,:,JK)
+ ENDWHERE
+ END DO
+ !
+ WHERE( ZWORKL(:,:) )
+ PSRFLWD(:,:) = ZLWD(:,:)
+ ENDWHERE
+ DO JSWB=1,ISWB
+ WHERE( ZWORKL(:,:) )
+ PSRFSWD_DIR (:,:,JSWB) = ZSWDDIR(:,:,JSWB)
+ PSRFSWD_DIF (:,:,JSWB) = ZSWDDIF(:,:,JSWB)
+ END WHERE
+ END DO
+ELSE
+ PDTHRAD(:,:,:) = (ZDTRAD_LW(:,:,:)+ZDTRAD_SW(:,:,:))/ZEXNT(:,:,:) ! tendency in potential temperature
+ PDTHRADSW(:,:,:) = ZDTRAD_SW(:,:,:)/ZEXNT(:,:,:)
+ PDTHRADLW(:,:,:) = ZDTRAD_LW(:,:,:)/ZEXNT(:,:,:)
+ PSRFLWD(:,:) = ZLWD(:,:)
+ DO JSWB=1,ISWB
+ PSRFSWD_DIR (:,:,JSWB) = ZSWDDIR(:,:,JSWB)
+ PSRFSWD_DIF (:,:,JSWB) = ZSWDDIF(:,:,JSWB)
+ END DO
+!
+!sw and lw fluxes
+!
+ DO JK=IKB,IKE
+ JKRAD = JK - JPVEXT
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ PSWU(JI,JJ,JK) = ZFLUX_SW_UP(IIJ,JKRAD)
+ PSWD(JI,JJ,JK) = ZFLUX_SW_DOWN(IIJ,JKRAD)
+ PLWU(JI,JJ,JK) = ZFLUX_LW(IIJ,1,JKRAD)
+ PLWD(JI,JJ,JK) = -ZFLUX_LW(IIJ,2,JKRAD) ! in ECMWF all fluxes are upward
+ END DO
+ END DO
+ END DO
+!!!effective radius
+ DO JK=IKB,IKE
+ JKRAD = JK - JPVEXT
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ PRADEFF(JI,JJ,JK) = ZRADLP(IIJ,JKRAD)
+ END DO
+ END DO
+ END DO
+END IF
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 7. STORE SOME ADDITIONNAL RADIATIVE FIELDS
+! ---------------------------------------
+!
+IF( tpfile%lopened .AND. (KRAD_DIAG >= 1) ) THEN
+ ZSTORE_3D(:,:,:) = 0.0
+ ZSTORE_3D2(:,:,:) = 0.0
+ ZSTORE_2D(:,:) = 0.0
+ !
+ TZFIELD2D = TFIELDMETADATA( &
+ CMNHNAME = 'generic 2D for radiations', & !Temporary name to ease identification
+ CSTDNAME = '', &
+ CDIR = 'XY', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 2, &
+ LTIMEDEP = .TRUE. )
+
+ TZFIELD3D = TFIELDMETADATA( &
+ CMNHNAME = 'generic 3D for radiations', & !Temporary name to ease identification
+ CSTDNAME = '', &
+ CDIR = 'XY', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+
+ IF( KRAD_DIAG >= 1) THEN
+ !
+ ILUOUT = TLUOUT%NLU
+ WRITE(UNIT=ILUOUT,FMT='(/," STORE ADDITIONNAL RADIATIVE FIELDS:", &
+ & " KRAD_DIAG=",I1,/)') KRAD_DIAG
+ DO JK=IKB,IKE
+ JKRAD = JK - JPVEXT
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZSTORE_3D(JI,JJ,JK) = ZFLUX_SW_DOWN(IIJ,JKRAD)
+ END DO
+ END DO
+ END DO
+ TZFIELD3D%CMNHNAME = 'SWF_DOWN'
+ TZFIELD3D%CLONGNAME = 'SWF_DOWN'
+ TZFIELD3D%CUNITS = 'W m-2'
+ TZFIELD3D%CCOMMENT = 'X_Y_Z_SWF_DOWN'
+ CALL IO_Field_write(TPFILE,TZFIELD3D,ZSTORE_3D)
+!
+ DO JK=IKB,IKE
+ JKRAD = JK - JPVEXT
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZSTORE_3D(JI,JJ,JK) = ZFLUX_SW_UP(IIJ,JKRAD)
+ END DO
+ END DO
+ END DO
+ TZFIELD3D%CMNHNAME = 'SWF_UP'
+ TZFIELD3D%CLONGNAME = 'SWF_UP'
+ TZFIELD3D%CUNITS = 'W m-2'
+ TZFIELD3D%CCOMMENT = 'X_Y_Z_SWF_UP'
+ CALL IO_Field_write(TPFILE,TZFIELD3D,ZSTORE_3D)
+!
+ DO JK=IKB,IKE
+ JKRAD = JK - JPVEXT
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZSTORE_3D(JI,JJ,JK) = -ZFLUX_LW(IIJ,2,JKRAD)
+ END DO
+ END DO
+ END DO
+ TZFIELD3D%CMNHNAME = 'LWF_DOWN'
+ TZFIELD3D%CLONGNAME = 'LWF_DOWN'
+ TZFIELD3D%CUNITS = 'W m-2'
+ TZFIELD3D%CCOMMENT = 'X_Y_Z_LWF_DOWN'
+ CALL IO_Field_write(TPFILE,TZFIELD3D,ZSTORE_3D)
+!
+ DO JK=IKB,IKE
+ JKRAD = JK - JPVEXT
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZSTORE_3D(JI,JJ,JK) = ZFLUX_LW(IIJ,1,JKRAD)
+ END DO
+ END DO
+ END DO
+ TZFIELD3D%CMNHNAME = 'LWF_UP'
+ TZFIELD3D%CLONGNAME = 'LWF_UP'
+ TZFIELD3D%CUNITS = 'W m-2'
+ TZFIELD3D%CCOMMENT = 'X_Y_Z_LWF_UP'
+ CALL IO_Field_write(TPFILE,TZFIELD3D,ZSTORE_3D)
+!
+ DO JK=IKB,IKE
+ JKRAD = JK - JPVEXT
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZSTORE_3D(JI,JJ,JK) = ZNFLW(IIJ,JKRAD)
+ END DO
+ END DO
+ END DO
+ TZFIELD3D%CMNHNAME = 'LWF_NET'
+ TZFIELD3D%CLONGNAME = 'LWF_NET'
+ TZFIELD3D%CUNITS = 'W m-2'
+ TZFIELD3D%CCOMMENT = 'X_Y_Z_LWF_NET'
+ CALL IO_Field_write(TPFILE,TZFIELD3D,ZSTORE_3D)
+!
+ DO JK=IKB,IKE
+ JKRAD = JK - JPVEXT
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZSTORE_3D(JI,JJ,JK) = ZNFSW(IIJ,JKRAD)
+ END DO
+ END DO
+ END DO
+ TZFIELD3D%CMNHNAME = 'SWF_NET'
+ TZFIELD3D%CLONGNAME = 'SWF_NET'
+ TZFIELD3D%CUNITS = 'W m-2'
+ TZFIELD3D%CCOMMENT = 'X_Y_Z_SWF_NET'
+ CALL IO_Field_write(TPFILE,TZFIELD3D,ZSTORE_3D)
+!
+ DO JK=IKB,IKE
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ ZSTORE_3D(JI,JJ,JK) = ZDTRAD_LW (JI,JJ,JK)*XDAY
+ END DO
+ END DO
+ END DO
+ TZFIELD3D%CMNHNAME = 'DTRAD_LW'
+ TZFIELD3D%CLONGNAME = 'DTRAD_LW'
+ TZFIELD3D%CUNITS = 'K day-1'
+ TZFIELD3D%CCOMMENT = 'X_Y_Z_DTRAD_LW'
+ CALL IO_Field_write(TPFILE,TZFIELD3D,ZSTORE_3D)
+!
+ DO JK=IKB,IKE
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ ZSTORE_3D(JI,JJ,JK) = ZDTRAD_SW (JI,JJ,JK)*XDAY
+ END DO
+ END DO
+ END DO
+ TZFIELD3D%CMNHNAME = 'DTRAD_SW'
+ TZFIELD3D%CLONGNAME = 'DTRAD_SW'
+ TZFIELD3D%CUNITS = 'K day-1'
+ TZFIELD3D%CCOMMENT = 'X_Y_Z_DTRAD_SW'
+ CALL IO_Field_write(TPFILE,TZFIELD3D,ZSTORE_3D)
+!
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZSTORE_2D(JI,JJ) = ZFLUX_TOP_GND_IRVISNIR(IIJ,5)
+ END DO
+ END DO
+ TZFIELD2D%CMNHNAME = 'RADSWD_VIS'
+ TZFIELD2D%CLONGNAME = 'RADSWD_VIS'
+ TZFIELD2D%CUNITS = ''
+ TZFIELD2D%CCOMMENT = 'X_Y_RADSWD_VIS'
+ CALL IO_Field_write(TPFILE,TZFIELD2D,ZSTORE_2D)
+!
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZSTORE_2D(JI,JJ) = ZFLUX_TOP_GND_IRVISNIR(IIJ,6)
+ END DO
+ END DO
+ TZFIELD2D%CMNHNAME = 'RADSWD_NIR'
+ TZFIELD2D%CLONGNAME = 'RADSWD_NIR'
+ TZFIELD2D%CUNITS = ''
+ TZFIELD2D%CCOMMENT = 'X_Y_RADSWD_NIR'
+ CALL IO_Field_write(TPFILE,TZFIELD2D,ZSTORE_2D)
+ !
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZSTORE_2D(JI,JJ) = ZFLUX_TOP_GND_IRVISNIR(IIJ,4)
+ END DO
+ END DO
+ TZFIELD2D%CMNHNAME = 'RADLWD'
+ TZFIELD2D%CLONGNAME = 'RADLWD'
+ TZFIELD2D%CUNITS = ''
+ TZFIELD2D%CCOMMENT = 'X_Y_RADLWD'
+ CALL IO_Field_write(TPFILE,TZFIELD2D,ZSTORE_2D)
+ END IF
+ !
+ !
+ IF( KRAD_DIAG >= 2) THEN
+ DO JK=IKB,IKE
+ JKRAD = JK - JPVEXT
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZSTORE_3D(JI,JJ,JK) = ZFLUX_SW_DOWN_CS(IIJ,JKRAD)
+ END DO
+ END DO
+ END DO
+ TZFIELD3D%CMNHNAME = 'SWF_DOWN_CS'
+ TZFIELD3D%CLONGNAME = 'SWF_DOWN_CS'
+ TZFIELD3D%CUNITS = 'W m-2'
+ TZFIELD3D%CCOMMENT = 'X_Y_Z_SWF_DOWN_CS'
+ CALL IO_Field_write(TPFILE,TZFIELD3D,ZSTORE_3D)
+ !
+ DO JK=IKB,IKE
+ JKRAD = JK - JPVEXT
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZSTORE_3D(JI,JJ,JK) = ZFLUX_SW_UP_CS(IIJ,JKRAD)
+ END DO
+ END DO
+ END DO
+ TZFIELD3D%CMNHNAME = 'SWF_UP_CS'
+ TZFIELD3D%CLONGNAME = 'SWF_UP_CS'
+ TZFIELD3D%CUNITS = 'W m-2'
+ TZFIELD3D%CCOMMENT = 'X_Y_Z_SWF_UP_CS'
+ CALL IO_Field_write(TPFILE,TZFIELD3D,ZSTORE_3D)
+ !
+ DO JK=IKB,IKE
+ JKRAD = JK - JPVEXT
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZSTORE_3D(JI,JJ,JK) = -ZFLUX_LW_CS(IIJ,2,JKRAD)
+ END DO
+ END DO
+ END DO
+ TZFIELD3D%CMNHNAME = 'LWF_DOWN_CS'
+ TZFIELD3D%CLONGNAME = 'LWF_DOWN_CS'
+ TZFIELD3D%CUNITS = 'W m-2'
+ TZFIELD3D%CCOMMENT = 'X_Y_Z_LWF_DOWN_CS'
+ CALL IO_Field_write(TPFILE,TZFIELD3D,ZSTORE_3D)
+ !
+ DO JK=IKB,IKE
+ JKRAD = JK - JPVEXT
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZSTORE_3D(JI,JJ,JK) = ZFLUX_LW_CS(IIJ,1,JKRAD)
+ END DO
+ END DO
+ END DO
+ TZFIELD3D%CMNHNAME = 'LWF_UP_CS'
+ TZFIELD3D%CLONGNAME = 'LWF_UP_CS'
+ TZFIELD3D%CUNITS = 'W m-2'
+ TZFIELD3D%CCOMMENT = 'X_Y_Z_LWF_UP_CS'
+ CALL IO_Field_write(TPFILE,TZFIELD3D,ZSTORE_3D)
+ !
+ DO JK=IKB,IKE
+ JKRAD = JK - JPVEXT
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZSTORE_3D(JI,JJ,JK) = ZNFLW_CS(IIJ,JKRAD)
+ END DO
+ END DO
+ END DO
+ TZFIELD3D%CMNHNAME = 'LWF_NET_CS'
+ TZFIELD3D%CLONGNAME = 'LWF_NET_CS'
+ TZFIELD3D%CUNITS = 'W m-2'
+ TZFIELD3D%CCOMMENT = 'X_Y_Z_LWF_NET_CS'
+ CALL IO_Field_write(TPFILE,TZFIELD3D,ZSTORE_3D)
+ !
+ DO JK=IKB,IKE
+ JKRAD = JK - JPVEXT
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZSTORE_3D(JI,JJ,JK) = ZNFSW_CS(IIJ,JKRAD)
+ END DO
+ END DO
+ END DO
+ TZFIELD3D%CMNHNAME = 'SWF_NET_CS'
+ TZFIELD3D%CLONGNAME = 'SWF_NET_CS'
+ TZFIELD3D%CUNITS = 'W m-2'
+ TZFIELD3D%CCOMMENT = 'X_Y_Z_SWF_NET_CS'
+ CALL IO_Field_write(TPFILE,TZFIELD3D,ZSTORE_3D)
+ !
+ DO JK=IKB,IKE
+ JKRAD = JK-JPVEXT
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZSTORE_3D(JI,JJ,JK) = ZDTSW_CS(IIJ,JKRAD)
+ END DO
+ END DO
+ END DO
+ TZFIELD3D%CMNHNAME = 'DTRAD_SW_CS'
+ TZFIELD3D%CLONGNAME = 'DTRAD_SW_CS'
+ TZFIELD3D%CUNITS = 'K day-1'
+ TZFIELD3D%CCOMMENT = 'X_Y_Z_DTRAD_SW_CS'
+ CALL IO_Field_write(TPFILE,TZFIELD3D,ZSTORE_3D)
+ !
+ DO JK=IKB,IKE
+ JKRAD = JK-JPVEXT
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZSTORE_3D(JI,JJ,JK) = ZDTLW_CS(IIJ,JKRAD)
+ END DO
+ END DO
+ END DO
+ TZFIELD3D%CMNHNAME = 'DTRAD_LW_CS'
+ TZFIELD3D%CLONGNAME = 'DTRAD_LW_CS'
+ TZFIELD3D%CUNITS = 'K day-1'
+ TZFIELD3D%CCOMMENT = 'X_Y_Z_DTRAD_LW_CS'
+ CALL IO_Field_write(TPFILE,TZFIELD3D,ZSTORE_3D)
+ !
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZSTORE_2D(JI,JJ) = ZFLUX_TOP_GND_IRVISNIR_CS(IIJ,5)
+ END DO
+ END DO
+ TZFIELD2D%CMNHNAME = 'RADSWD_VIS_CS'
+ TZFIELD2D%CLONGNAME = 'RADSWD_VIS_CS'
+ TZFIELD2D%CUNITS = ''
+ TZFIELD2D%CCOMMENT = 'X_Y_RADSWD_VIS_CS'
+ CALL IO_Field_write(TPFILE,TZFIELD2D,ZSTORE_2D)
+ !
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZSTORE_2D(JI,JJ) = ZFLUX_TOP_GND_IRVISNIR_CS(IIJ,6)
+ END DO
+ END DO
+ TZFIELD2D%CMNHNAME = 'RADSWD_NIR_CS'
+ TZFIELD2D%CLONGNAME = 'RADSWD_NIR_CS'
+ TZFIELD2D%CUNITS = ''
+ TZFIELD2D%CCOMMENT = 'X_Y_RADSWD_NIR_CS'
+ CALL IO_Field_write(TPFILE,TZFIELD2D,ZSTORE_2D)
+ !
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZSTORE_2D(JI,JJ) = ZFLUX_TOP_GND_IRVISNIR_CS(IIJ,4)
+ END DO
+ END DO
+ TZFIELD2D%CMNHNAME = 'RADLWD_CS'
+ TZFIELD2D%CLONGNAME = 'RADLWD_CS'
+ TZFIELD2D%CUNITS = ''
+ TZFIELD2D%CCOMMENT = 'X_Y_RADLWD_CS'
+ CALL IO_Field_write(TPFILE,TZFIELD2D,ZSTORE_2D)
+ END IF
+ !
+ !
+ IF( KRAD_DIAG >= 3) THEN
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZSTORE_2D(JI,JJ) = ZPLAN_ALB_VIS(IIJ)
+ END DO
+ END DO
+ TZFIELD2D%CMNHNAME = 'PLAN_ALB_VIS'
+ TZFIELD2D%CLONGNAME = 'PLAN_ALB_VIS'
+ TZFIELD2D%CUNITS = ''
+ TZFIELD2D%CCOMMENT = 'X_Y_PLAN_ALB_VIS'
+ CALL IO_Field_write(TPFILE,TZFIELD2D,ZSTORE_2D)
+ !
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZSTORE_2D(JI,JJ) = ZPLAN_ALB_NIR(IIJ)
+ END DO
+ END DO
+ TZFIELD2D%CMNHNAME = 'PLAN_ALB_NIR'
+ TZFIELD2D%CLONGNAME = 'PLAN_ALB_NIR'
+ TZFIELD2D%CUNITS = ''
+ TZFIELD2D%CCOMMENT = 'X_Y_PLAN_ALB_NIR'
+ CALL IO_Field_write(TPFILE,TZFIELD2D,ZSTORE_2D)
+ !
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZSTORE_2D(JI,JJ) = ZPLAN_TRA_VIS(IIJ)
+ END DO
+ END DO
+ TZFIELD2D%CMNHNAME = 'PLAN_TRA_VIS'
+ TZFIELD2D%CLONGNAME = 'PLAN_TRA_VIS'
+ TZFIELD2D%CUNITS = ''
+ TZFIELD2D%CCOMMENT = 'X_Y_PLAN_TRA_VIS'
+ CALL IO_Field_write(TPFILE,TZFIELD2D,ZSTORE_2D)
+ !
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZSTORE_2D(JI,JJ) = ZPLAN_TRA_NIR(IIJ)
+ END DO
+ END DO
+ TZFIELD2D%CMNHNAME = 'PLAN_TRA_NIR'
+ TZFIELD2D%CLONGNAME = 'PLAN_TRA_NIR'
+ TZFIELD2D%CUNITS = ''
+ TZFIELD2D%CCOMMENT = 'X_Y_PLAN_TRA_NIR'
+ CALL IO_Field_write(TPFILE,TZFIELD2D,ZSTORE_2D)
+ !
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZSTORE_2D(JI,JJ) = ZPLAN_ABS_VIS(IIJ)
+ END DO
+ END DO
+ TZFIELD2D%CMNHNAME = 'PLAN_ABS_VIS'
+ TZFIELD2D%CLONGNAME = 'PLAN_ABS_VIS'
+ TZFIELD2D%CUNITS = ''
+ TZFIELD2D%CCOMMENT = 'X_Y_PLAN_ABS_VIS'
+ CALL IO_Field_write(TPFILE,TZFIELD2D,ZSTORE_2D)
+ !
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZSTORE_2D(JI,JJ) = ZPLAN_ABS_NIR(IIJ)
+ END DO
+ END DO
+ TZFIELD2D%CMNHNAME = 'PLAN_ABS_NIR'
+ TZFIELD2D%CLONGNAME = 'PLAN_ABS_NIR'
+ TZFIELD2D%CUNITS = ''
+ TZFIELD2D%CCOMMENT = 'X_Y_PLAN_ABS_NIR'
+ CALL IO_Field_write(TPFILE,TZFIELD2D,ZSTORE_2D)
+ !
+ !
+ END IF
+!
+!
+ IF( KRAD_DIAG >= 4) THEN
+ DO JK=IKB,IKE
+ JKRAD = JK - JPVEXT
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZSTORE_3D(JI,JJ,JK) = ZEFCL_LWD(IIJ,JKRAD)
+ END DO
+ END DO
+ END DO
+ TZFIELD3D%CMNHNAME = 'EFNEB_DOWN'
+ TZFIELD3D%CLONGNAME = 'EFNEB_DOWN'
+ TZFIELD3D%CUNITS = ''
+ TZFIELD3D%CCOMMENT = 'X_Y_Z_EFNEB_DOWN'
+ CALL IO_Field_write(TPFILE,TZFIELD3D,ZSTORE_3D)
+ !
+ DO JK=IKB,IKE
+ JKRAD = JK - JPVEXT
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZSTORE_3D(JI,JJ,JK) = ZEFCL_LWU(IIJ,JKRAD)
+ END DO
+ END DO
+ END DO
+ TZFIELD3D%CMNHNAME = 'EFNEB_UP'
+ TZFIELD3D%CLONGNAME = 'EFNEB_UP'
+ TZFIELD3D%CUNITS = ''
+ TZFIELD3D%CCOMMENT = 'X_Y_Z_EFNEB_UP'
+ CALL IO_Field_write(TPFILE,TZFIELD3D,ZSTORE_3D)
+ !
+ DO JK=IKB,IKE
+ JKRAD = JK - JPVEXT
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZSTORE_3D(JI,JJ,JK) = ZFLWP(IIJ,JKRAD)
+ END DO
+ END DO
+ END DO
+ TZFIELD3D%CMNHNAME = 'FLWP'
+ TZFIELD3D%CLONGNAME = 'FLWP'
+ TZFIELD3D%CUNITS = ''
+ TZFIELD3D%CCOMMENT = 'X_Y_Z_FLWP'
+ CALL IO_Field_write(TPFILE,TZFIELD3D,ZSTORE_3D)
+ !
+ DO JK=IKB,IKE
+ JKRAD = JK - JPVEXT
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZSTORE_3D(JI,JJ,JK) = ZFIWP(IIJ,JKRAD)
+ END DO
+ END DO
+ END DO
+ TZFIELD3D%CMNHNAME = 'FIWP'
+ TZFIELD3D%CLONGNAME = 'FIWP'
+ TZFIELD3D%CUNITS = ''
+ TZFIELD3D%CCOMMENT = 'X_Y_Z_FIWP'
+ CALL IO_Field_write(TPFILE,TZFIELD3D,ZSTORE_3D)
+ !
+ DO JK=IKB,IKE
+ JKRAD = JK - JPVEXT
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZSTORE_3D(JI,JJ,JK) = ZRADLP(IIJ,JKRAD)
+ END DO
+ END DO
+ END DO
+ TZFIELD3D%CMNHNAME = 'EFRADL'
+ TZFIELD3D%CLONGNAME = 'EFRADL'
+ TZFIELD3D%CUNITS = ''
+ TZFIELD3D%CCOMMENT = 'X_Y_Z_RAD_microm'
+ CALL IO_Field_write(TPFILE,TZFIELD3D,ZSTORE_3D)
+ !
+ DO JK=IKB,IKE
+ JKRAD = JK - JPVEXT
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZSTORE_3D(JI,JJ,JK) = ZRADIP(IIJ,JKRAD)
+ END DO
+ END DO
+ END DO
+ TZFIELD3D%CMNHNAME = 'EFRADI'
+ TZFIELD3D%CLONGNAME = 'EFRADI'
+ TZFIELD3D%CUNITS = ''
+ TZFIELD3D%CCOMMENT = 'X_Y_Z_RAD_microm'
+ CALL IO_Field_write(TPFILE,TZFIELD3D,ZSTORE_3D)
+ !
+ DO JK=IKB,IKE
+ JKRAD = JK - JPVEXT
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZSTORE_3D(JI,JJ,JK) = ZCLSW_TOTAL(IIJ,JKRAD)
+ END DO
+ END DO
+ END DO
+ TZFIELD3D%CMNHNAME = 'SW_NEB'
+ TZFIELD3D%CLONGNAME = 'SW_NEB'
+ TZFIELD3D%CUNITS = ''
+ TZFIELD3D%CCOMMENT = 'X_Y_Z_SW_NEB'
+ CALL IO_Field_write(TPFILE,TZFIELD3D,ZSTORE_3D)
+ !
+ DO JK=IKB,IKE
+ JKRAD = JK - JPVEXT
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZSTORE_3D(JI,JJ,JK) = ZEFCL_RRTM(IIJ,JKRAD)
+ END DO
+ END DO
+ END DO
+ TZFIELD3D%CMNHNAME = 'RRTM_LW_NEB'
+ TZFIELD3D%CLONGNAME = 'RRTM_LW_NEB'
+ TZFIELD3D%CUNITS = ''
+ TZFIELD3D%CCOMMENT = 'X_Y_Z_LW_NEB'
+ CALL IO_Field_write(TPFILE,TZFIELD3D,ZSTORE_3D)
+ !
+ ! spectral bands
+ IF (KSWB_OLD==6) THEN
+ INIR = 4
+ ELSE
+ INIR = 2
+ END IF
+
+ DO JBAND=1,INIR-1
+ WRITE(YBAND_NAME(JBAND),'(A3,I1)') 'VIS', JBAND
+ END DO
+ DO JBAND= INIR, KSWB_OLD
+ WRITE(YBAND_NAME(JBAND),'(A3,I1)') 'NIR', JBAND
+ END DO
+!
+ DO JBAND=1,KSWB_OLD
+ TZFIELD3D%CMNHNAME = 'ODAER_'//YBAND_NAME(JBAND)
+ TZFIELD3D%CLONGNAME = 'ODAER_'//YBAND_NAME(JBAND)
+ TZFIELD3D%CUNITS = ''
+ TZFIELD3D%CCOMMENT = 'X_Y_Z_OD_'//YBAND_NAME(JBAND)
+ CALL IO_Field_write(TPFILE,TZFIELD3D,ZTAUAZ(:,:,:,JBAND))
+ !
+ TZFIELD3D%CMNHNAME = 'SSAAER_'//YBAND_NAME(JBAND)
+ TZFIELD3D%CLONGNAME = 'SSAAER_'//YBAND_NAME(JBAND)
+ TZFIELD3D%CUNITS = ''
+ TZFIELD3D%CCOMMENT = 'X_Y_Z_SSA_'//YBAND_NAME(JBAND)
+ CALL IO_Field_write(TPFILE,TZFIELD3D,ZPIZAZ(:,:,:,JBAND))
+ !
+ TZFIELD3D%CMNHNAME = 'GAER_'//YBAND_NAME(JBAND)
+ TZFIELD3D%CLONGNAME = 'GAER_'//YBAND_NAME(JBAND)
+ TZFIELD3D%CUNITS = ''
+ TZFIELD3D%CCOMMENT = 'X_Y_Z_G_'//YBAND_NAME(JBAND)
+ CALL IO_Field_write(TPFILE,TZFIELD3D,ZCGAZ(:,:,:,JBAND))
+ ENDDO
+
+ DO JBAND=1,KSWB_OLD
+ DO JK=IKB,IKE
+ JKRAD = JK - JPVEXT
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZSTORE_3D(JI,JJ,JK) = ZTAU_TOTAL(IIJ,JBAND,JKRAD)
+ END DO
+ END DO
+ END DO
+ TZFIELD3D%CMNHNAME = 'OTH_'//YBAND_NAME(JBAND)
+ TZFIELD3D%CLONGNAME = 'OTH_'//YBAND_NAME(JBAND)
+ TZFIELD3D%CUNITS = ''
+ TZFIELD3D%CCOMMENT = 'X_Y_Z_OTH_'//YBAND_NAME(JBAND)
+ CALL IO_Field_write(TPFILE,TZFIELD3D,ZSTORE_3D)
+ !
+ DO JK=IKB,IKE
+ JKRAD = JK - JPVEXT
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZSTORE_3D(JI,JJ,JK) = ZOMEGA_TOTAL(IIJ,JBAND,JKRAD)
+ END DO
+ END DO
+ END DO
+ TZFIELD3D%CMNHNAME = 'SSA_'//YBAND_NAME(JBAND)
+ TZFIELD3D%CLONGNAME = 'SSA_'//YBAND_NAME(JBAND)
+ TZFIELD3D%CUNITS = ''
+ TZFIELD3D%CCOMMENT = 'X_Y_Z_SSA_'//YBAND_NAME(JBAND)
+ CALL IO_Field_write(TPFILE,TZFIELD3D,ZSTORE_3D)
+ !
+ DO JK=IKB,IKE
+ JKRAD = JK - JPVEXT
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZSTORE_3D(JI,JJ,JK) = ZCG_TOTAL(IIJ,JBAND,JKRAD)
+ END DO
+ END DO
+ END DO
+ TZFIELD3D%CMNHNAME = 'ASF_'//YBAND_NAME(JBAND)
+ TZFIELD3D%CLONGNAME = 'ASF_'//YBAND_NAME(JBAND)
+ TZFIELD3D%CUNITS = ''
+ TZFIELD3D%CCOMMENT = 'X_Y_Z_ASF_'//YBAND_NAME(JBAND)
+ CALL IO_Field_write(TPFILE,TZFIELD3D,ZSTORE_3D)
+ END DO
+ END IF
+ !
+ !
+ IF (KRAD_DIAG >= 5) THEN
+!
+! OZONE and AER optical thickness climato entering the ecmwf_radiation_vers2
+! note the vertical grid is re-inversed for graphic !
+ DO JK=IKB,IKE
+ JKRAD = KFLEV+1 - JK + JPVEXT
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZSTORE_3D(JI,JJ,JK) = ZO3AVE(IIJ, JKRAD)
+ END DO
+ END DO
+ END DO
+ TZFIELD3D%CMNHNAME = 'O3CLIM'
+ TZFIELD3D%CLONGNAME = 'O3CLIM'
+ TZFIELD3D%CUNITS = 'Pa Pa-1'
+ TZFIELD3D%CCOMMENT = 'X_Y_Z_O3'
+ CALL IO_Field_write(TPFILE,TZFIELD3D,ZSTORE_3D)
+!
+!cumulated optical thickness of aerosols
+!cumul begin from the top of the domain, not from the TOA !
+!
+!land
+ DO JK=IKB,IKE
+ JKRAD = JK - JPVEXT
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ ZSTORE_3D(JI,JJ,JK) = PAER(JI,JJ,JKRAD,1)
+ END DO
+ END DO
+ END DO
+!
+ ZSTORE_2D (:,:) = 0.
+ DO JK=IKB,IKE
+ JK1=IKE-JK+IKB
+ ZSTORE_2D(:,:) = ZSTORE_2D(:,:) + ZSTORE_3D(:,:,JK1)
+ ZSTORE_3D2(:,:,JK1) = ZSTORE_2D(:,:)
+ END DO
+ TZFIELD3D%CMNHNAME = 'CUM_AER_LAND'
+ TZFIELD3D%CLONGNAME = 'CUM_AER_LAND'
+ TZFIELD3D%CUNITS = ''
+ TZFIELD3D%CCOMMENT = 'X_Y_Z_CUM_AER_OPT'
+ CALL IO_Field_write(TPFILE,TZFIELD3D,ZSTORE_3D2)
+!
+! sea
+ DO JK=IKB,IKE
+ JKRAD = JK - JPVEXT
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ ZSTORE_3D(JI,JJ,JK) = PAER(JI,JJ,JKRAD,2)
+ END DO
+ END DO
+ END DO
+!sum
+ ZSTORE_2D (:,:) = 0.
+ DO JK=IKB,IKE
+ JK1=IKE-JK+IKB
+ ZSTORE_2D(:,:) = ZSTORE_2D(:,:) + ZSTORE_3D(:,:,JK1)
+ ZSTORE_3D2(:,:,JK1) = ZSTORE_2D(:,:)
+ END DO
+!
+ TZFIELD3D%CMNHNAME = 'CUM_AER_SEA'
+ TZFIELD3D%CLONGNAME = 'CUM_AER_SEA'
+ TZFIELD3D%CUNITS = ''
+ TZFIELD3D%CCOMMENT = 'X_Y_Z_CUM_AER_OPT'
+ CALL IO_Field_write(TPFILE,TZFIELD3D,ZSTORE_3D2)
+!
+! desert
+ DO JK=IKB,IKE
+ JKRAD = JK - JPVEXT
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ ZSTORE_3D(JI,JJ,JK) = PAER(JI,JJ,JKRAD,3)
+ END DO
+ END DO
+ END DO
+!sum
+ ZSTORE_2D (:,:) = 0.
+ DO JK=IKB,IKE
+ JK1=IKE-JK+IKB
+ ZSTORE_2D(:,:) = ZSTORE_2D(:,:) + ZSTORE_3D(:,:,JK1)
+ ZSTORE_3D2(:,:,JK1) = ZSTORE_2D(:,:)
+ END DO
+!
+ TZFIELD3D%CMNHNAME = 'CUM_AER_DES'
+ TZFIELD3D%CLONGNAME = 'CUM_AER_DES'
+ TZFIELD3D%CUNITS = ''
+ TZFIELD3D%CCOMMENT = 'X_Y_Z_CUM_AER_OPT'
+ CALL IO_Field_write(TPFILE,TZFIELD3D,ZSTORE_3D2)
+!
+! urban
+ DO JK=IKB,IKE
+ JKRAD = JK - JPVEXT
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ ZSTORE_3D(JI,JJ,JK) = PAER(JI,JJ,JKRAD,4)
+ END DO
+ END DO
+ END DO
+!sum
+ ZSTORE_2D (:,:) = 0.
+ DO JK=IKB,IKE
+ JK1=IKE-JK+IKB
+ ZSTORE_2D(:,:) = ZSTORE_2D(:,:) + ZSTORE_3D(:,:,JK1)
+ ZSTORE_3D2(:,:,JK1) = ZSTORE_2D(:,:)
+ END DO
+!
+ TZFIELD3D%CMNHNAME = 'CUM_AER_URB'
+ TZFIELD3D%CLONGNAME = 'CUM_AER_URB'
+ TZFIELD3D%CUNITS = ''
+ TZFIELD3D%CCOMMENT = 'X_Y_Z_CUM_AER_OPT'
+ CALL IO_Field_write(TPFILE,TZFIELD3D,ZSTORE_3D2)
+!
+! Volcanoes
+ DO JK=IKB,IKE
+ JKRAD = JK - JPVEXT
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ ZSTORE_3D(JI,JJ,JK) = PAER(JI,JJ,JKRAD,5)
+ END DO
+ END DO
+ END DO
+!sum
+ ZSTORE_2D (:,:) = 0.
+ DO JK=IKB,IKE
+ JK1=IKE-JK+IKB
+ ZSTORE_2D(:,:) = ZSTORE_2D(:,:) + ZSTORE_3D(:,:,JK1)
+ ZSTORE_3D2(:,:,JK1) = ZSTORE_2D(:,:)
+ END DO
+!
+ TZFIELD3D%CMNHNAME = 'CUM_AER_VOL'
+ TZFIELD3D%CLONGNAME = 'CUM_AER_VOL'
+ TZFIELD3D%CUNITS = ''
+ TZFIELD3D%CCOMMENT = 'X_Y_Z_CUM_AER_OPT'
+ CALL IO_Field_write(TPFILE,TZFIELD3D,ZSTORE_3D2)
+!
+! stratospheric background
+ DO JK=IKB,IKE
+ JKRAD = JK - JPVEXT
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ ZSTORE_3D(JI,JJ,JK) = PAER(JI,JJ,JKRAD,6)
+ END DO
+ END DO
+ END DO
+!sum
+ ZSTORE_2D (:,:) = 0.
+ DO JK=IKB,IKE
+ JK1=IKE-JK+IKB
+ ZSTORE_2D(:,:) = ZSTORE_2D(:,:) + ZSTORE_3D(:,:,JK1)
+ ZSTORE_3D2(:,:,JK1) = ZSTORE_2D(:,:)
+ END DO
+!
+ TZFIELD3D%CMNHNAME = 'CUM_AER_STRB'
+ TZFIELD3D%CLONGNAME = 'CUM_AER_STRB'
+ TZFIELD3D%CUNITS = ''
+ TZFIELD3D%CCOMMENT = 'X_Y_Z_CUM_AER_OPT'
+ CALL IO_Field_write(TPFILE,TZFIELD3D,ZSTORE_3D2)
+ ENDIF
+END IF
+!
+DEALLOCATE(ZNFLW_CS)
+DEALLOCATE(ZNFLW)
+DEALLOCATE(ZNFSW_CS)
+DEALLOCATE(ZNFSW)
+DEALLOCATE(ZFLUX_TOP_GND_IRVISNIR)
+DEALLOCATE(ZFLUX_SW_DOWN)
+DEALLOCATE(ZFLUX_SW_UP)
+DEALLOCATE(ZFLUX_LW)
+DEALLOCATE(ZDTLW_CS)
+DEALLOCATE(ZDTSW_CS)
+DEALLOCATE(ZFLUX_TOP_GND_IRVISNIR_CS)
+DEALLOCATE(ZPLAN_ALB_VIS)
+DEALLOCATE(ZPLAN_ALB_NIR)
+DEALLOCATE(ZPLAN_TRA_VIS)
+DEALLOCATE(ZPLAN_TRA_NIR)
+DEALLOCATE(ZPLAN_ABS_VIS)
+DEALLOCATE(ZPLAN_ABS_NIR)
+DEALLOCATE(ZEFCL_LWD)
+DEALLOCATE(ZEFCL_LWU)
+DEALLOCATE(ZFLWP)
+DEALLOCATE(ZFIWP)
+DEALLOCATE(ZRADLP)
+DEALLOCATE(ZRADIP)
+DEALLOCATE(ZEFCL_RRTM)
+DEALLOCATE(ZCLSW_TOTAL)
+DEALLOCATE(ZTAU_TOTAL)
+DEALLOCATE(ZOMEGA_TOTAL)
+DEALLOCATE(ZCG_TOTAL)
+DEALLOCATE(ZFLUX_SW_DOWN_CS)
+DEALLOCATE(ZFLUX_SW_UP_CS)
+DEALLOCATE(ZFLUX_LW_CS)
+DEALLOCATE(ZO3AVE)
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE RADIATIONS
+!
+END MODULE MODI_RADIATIONS
diff --git a/src/PHYEX/ext/read_exsegn.f90 b/src/PHYEX/ext/read_exsegn.f90
new file mode 100644
index 0000000000000000000000000000000000000000..70d8d7e98e669b1f0dd856a2789a64ff9491e676
--- /dev/null
+++ b/src/PHYEX/ext/read_exsegn.f90
@@ -0,0 +1,3075 @@
+!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.
+!-----------------------------------------------------------------
+! ######################
+ MODULE MODI_READ_EXSEG_n
+! ######################
+!
+INTERFACE
+!
+ SUBROUTINE READ_EXSEG_n(KMI,TPEXSEGFILE,HCONF,OFLAT,OUSERV, &
+ OUSERC,OUSERR,OUSERI,OUSECI,OUSERS,OUSERG,OUSERH, &
+ OUSECHEM,OUSECHAQ,OUSECHIC,OCH_PH,OCH_CONV_LINOX,OSALT, &
+ ODEPOS_SLT, ODUST,ODEPOS_DST, OCHTRANS, &
+ OORILAM,ODEPOS_AER, OLG,OPASPOL, OFIRE, &
+#ifdef MNH_FOREFIRE
+ OFOREFIRE, &
+#endif
+ OLNOX_EXPLICIT, &
+ OCONDSAMP,OBLOWSNOW, &
+ KRIMX,KRIMY, KSV_USER, &
+ HTURB,HTOM,ORMC01,HRAD,HDCONV,HSCONV,HCLOUD,HELEC, &
+ HEQNSYS,PTSTEP_ALL,HINIFILEPGD )
+!
+USE MODD_IO, ONLY: TFILEDATA
+!
+INTEGER, INTENT(IN) :: KMI ! Model index
+TYPE(TFILEDATA), INTENT(IN) :: TPEXSEGFILE ! EXSEG file
+! The following variables are read by READ_DESFM in DESFM descriptor :
+CHARACTER (LEN=*), INTENT(IN) :: HCONF ! configuration var. linked to FMfile
+LOGICAL, INTENT(IN) :: OFLAT ! Logical for zero orography
+LOGICAL, INTENT(IN) :: OUSERV,OUSERC,OUSERR,OUSERI,OUSERS, &
+ OUSERG,OUSERH ! kind of moist variables in
+ ! FMfile
+LOGICAL, INTENT(IN) :: OUSECI ! ice concentration in
+ ! FMfile
+LOGICAL, INTENT(IN) :: OUSECHEM ! Chemical FLAG in FMFILE
+LOGICAL, INTENT(IN) :: OUSECHAQ ! Aqueous chemical FLAG in FMFILE
+LOGICAL, INTENT(IN) :: OUSECHIC ! Ice chemical FLAG in FMFILE
+LOGICAL, INTENT(IN) :: OCH_PH ! pH FLAG in FMFILE
+LOGICAL, INTENT(IN) :: OCH_CONV_LINOX ! LiNOx FLAG in FMFILE
+LOGICAL, INTENT(IN) :: ODUST ! Dust FLAG in FMFILE
+LOGICAL,DIMENSION(:), INTENT(IN) :: ODEPOS_DST ! Dust wet deposition FLAG in FMFILE
+LOGICAL,DIMENSION(:), INTENT(IN) :: ODEPOS_SLT ! Sea Salt wet deposition FLAG in FMFILE
+LOGICAL,DIMENSION(:), INTENT(IN) :: ODEPOS_AER ! Orilam wet deposition FLAG in FMFILE
+LOGICAL, INTENT(IN) :: OSALT ! Sea Salt FLAG in FMFILE
+LOGICAL, INTENT(IN) :: OORILAM ! Orilam FLAG in FMFILE
+LOGICAL, INTENT(IN) :: OPASPOL ! Passive pollutant FLAG in FMFILE
+LOGICAL, INTENT(IN) :: OFIRE ! Blaze FLAG in FMFILE
+#ifdef MNH_FOREFIRE
+LOGICAL, INTENT(IN) :: OFOREFIRE ! ForeFire FLAG in FMFILE
+#endif
+LOGICAL, INTENT(IN) :: OLNOX_EXPLICIT ! explicit LNOx FLAG in FMFILE
+LOGICAL, INTENT(IN) :: OCONDSAMP ! Conditional sampling FLAG in FMFILE
+LOGICAL, INTENT(IN) :: OBLOWSNOW ! Blowing snow FLAG in FMFILE
+LOGICAL, INTENT(IN) :: OCHTRANS ! LCHTRANS FLAG in FMFILE
+
+LOGICAL, INTENT(IN) :: OLG ! lagrangian FLAG in FMFILE
+INTEGER, INTENT(IN) :: KRIMX, KRIMY ! number of points for the
+ ! horizontal relaxation for the outermost verticals
+INTEGER, INTENT(IN) :: KSV_USER ! number of additional scalar
+ ! variables in FMfile
+CHARACTER (LEN=*), INTENT(IN) :: HTURB ! Kind of turbulence parameterization
+ ! used to produce FMFILE
+CHARACTER (LEN=*), INTENT(IN) :: HTOM ! Kind of third order moment
+LOGICAL, INTENT(IN) :: ORMC01 ! flag for RMC01 SBL computations
+CHARACTER (LEN=*), INTENT(IN) :: HRAD ! Kind of radiation scheme
+CHARACTER (LEN=4), INTENT(IN) :: HDCONV ! Kind of deep convection scheme
+CHARACTER (LEN=4), INTENT(IN) :: HSCONV ! Kind of shallow convection scheme
+CHARACTER (LEN=4), INTENT(IN) :: HCLOUD ! Kind of microphysical scheme
+CHARACTER (LEN=4), INTENT(IN) :: HELEC ! Kind of electrical scheme
+CHARACTER (LEN=*), INTENT(IN) :: HEQNSYS! type of equations' system
+REAL,DIMENSION(:), INTENT(INOUT):: PTSTEP_ALL ! Time STEP of ALL models
+CHARACTER (LEN=*), INTENT(IN) :: HINIFILEPGD ! name of PGD file
+!
+END SUBROUTINE READ_EXSEG_n
+!
+END INTERFACE
+!
+END MODULE MODI_READ_EXSEG_n
+!
+!
+! #########################################################################
+ SUBROUTINE READ_EXSEG_n(KMI,TPEXSEGFILE,HCONF,OFLAT,OUSERV, &
+ OUSERC,OUSERR,OUSERI,OUSECI,OUSERS,OUSERG,OUSERH, &
+ OUSECHEM,OUSECHAQ,OUSECHIC,OCH_PH,OCH_CONV_LINOX,OSALT, &
+ ODEPOS_SLT, ODUST,ODEPOS_DST, OCHTRANS, &
+ OORILAM,ODEPOS_AER, OLG,OPASPOL, OFIRE, &
+#ifdef MNH_FOREFIRE
+ OFOREFIRE, &
+#endif
+ OLNOX_EXPLICIT, &
+ OCONDSAMP, OBLOWSNOW, &
+ KRIMX,KRIMY, KSV_USER, &
+ HTURB,HTOM,ORMC01,HRAD,HDCONV,HSCONV,HCLOUD,HELEC, &
+ HEQNSYS,PTSTEP_ALL,HINIFILEPGD )
+! #########################################################################
+!
+!!**** *READ_EXSEG_n * - routine to read the descriptor file EXSEG
+!!
+!! PURPOSE
+!! -------
+! The purpose of this routine is to read the descriptor file called
+! EXSEG and to control the coherence with FMfile data .
+!
+!!
+!!** METHOD
+!! ------
+!! The descriptor file is read. Namelists (NAMXXXn) which contain
+!! variables linked to one nested model are at the beginning of the file.
+!! Namelists (NAMXXX) which contain variables common to all models
+!! are at the end of the file. When the model index is different from 1,
+!! the end of the file (namelists NAMXXX) is not read.
+!!
+!! Coherence between the initial file (description read in DESFM file)
+!! and the segment to perform (description read in EXSEG file)
+!! is checked for segment achievement configurations
+!! or postprocessing configuration. The get indicators are set according
+!! to the following check :
+!!
+!! - segment achievement and preinit configurations :
+!!
+!! * if there is no turbulence kinetic energy in initial
+!! file (HTURB='NONE'), and the segment to perform requires a turbulence
+!! parameterization (CTURB /= 'NONE'), the get indicators for turbulence
+!! kinetic energy variables are set to 'INIT'; i.e. these variables will be
+!! set equal to zero by READ_FIELD according to the get indicators.
+!! * The same procedure is applied to the dissipation of TKE.
+!! * if there is no moist variables RRn in initial file (OUSERn=.FALSE.)
+!! and the segment to perform requires moist variables RRn
+!! (LUSERn=.TRUE.), the get indicators for moist variables RRn are set
+!! equal to 'INIT'; i.e. these variables will be set equal to zero by
+!! READ_FIELD according to the get indicators.
+!! * if there are KSV_USER additional scalar variables in initial file and the
+!! segment to perform needs more than KSV_USER additional variables, the get
+!! indicators for these (NSV_USER-KSV_USER) additional scalar variables are set
+!! equal to 'INIT'; i.e. these variables will be set equal to zero by
+!! READ_FIELD according to the get indicators. If the segment to perform
+!! needs less additional scalar variables than there are in initial file,
+!! the get indicators for these (KSV_USER - NSV_USER) additional scalar variables are
+!! set equal to 'SKIP'.
+!! * warning messages are printed if the fields in initial file are the
+!! same at time t and t-dt (HCONF='START') and a leap-frog advance
+!! at first time step will be used for the segment to perform
+!! (CCONF='RESTA'); It is likewise when HCONF='RESTA' and CCONF='START'.
+!! * A warning message is printed if the orography in initial file is zero
+!! (OFLAT=.TRUE.) and the segment to perform considers no-zero orography
+!! (LFLAT=.FALSE.). It is likewise for LFLAT=.TRUE. and OFLAT=.FALSE..
+!! If the segment to perform requires zero orography (LFLAT=.TRUE.), the
+!! orography (XZS) will not read in initial file but set equal to zero
+!! by SET_GRID.
+!! * check of the depths of the Lateral Damping Layer in x and y
+!! direction is performed
+!! * If some coupling files are specified, LSTEADYLS is set to T
+!! * If no coupling files are specified, LSTEADYLS is set to F
+!!
+!!
+!! EXTERNAL
+!! --------
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODN_CONF : CCONF,LTHINSHELL,LFLAT,NMODEL,NVERB
+!!
+!! Module MODN_DYN : LCORIO, LZDIFFU
+!!
+!! Module MODN_NESTING : NDAD(m),NDTRATIO(m),XWAY(m)
+!!
+!! Module MODN_BUDGET : CBUTYPE,XBULEN
+!!
+!! Module MODN_CONF1 : LUSERV,LUSERC,LUSERR,LUSERI,LUSERS,LUSERG,LUSERH,CSEG
+!!
+!! Module MODN_DYN1 : XTSTEP,CPRESOPT,NITR,XRELAX
+!!
+!! Module MODD_ADV1 : CMET_ADV_SCHEME,CSV_ADV_SCHEME,CUVW_ADV_SCHEME,NLITER
+!!
+!! Module MODN_PARAM1 : CTURB,CRAD,CDCONV,CSCONV
+!!
+!! Module MODN_LUNIT1 :
+!! Module MODN_LBC1 : CLBCX,CLBCY,NLBLX,NLBLY,XCPHASE,XPOND
+!!
+!! Module MODN_TURB_n : CTURBLEN,CTURBDIM
+!!
+!! Module MODD_GET1:
+!! CGETTKEM,CGETTKET,
+!! CGETRVM,CGETRCM,CGETRRM,CGETRIM,CGETRSM,CGETRGM,CGETRHM
+!! CGETRVT,CGETRCT,CGETRRT,CGETRIT,CGETRST,CGETRGT,CGETRHT,CGETSVM
+!! CGETSVT,CGETSIGS,CGETSRCM,CGETSRCT
+!! NCPL_NBR,NCPL_TIMES,NCPL_CUR
+!! Module MODN_LES : contains declaration of the control parameters
+!! for Large Eddy Simulations' storages
+!! for the forcing
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of the documentation (routine READ_EXSEG_n)
+!!
+!!
+!! AUTHOR
+!! ------
+!! V. Ducrocq * Meteo France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 07/06/94
+!! Modification 26/10/94 (Stein) remove NAM_GET from the Namelists
+!! present in DESFM + change the namelist names
+!! Modification 22/11/94 (Stein) add GET indicator for phi
+!! Modification 21/12/94 (Stein) add GET indicator for LS fields
+!! Modification 06/01/95 (Stein) bug in the test for Scalar Var.
+!! Modifications 09/01/95 (Stein) add the turbulence scheme
+!! Modifications 09/01/95 (Stein) add the 1D switch
+!! Modifications 10/03/95 (Mallet) add coherence in coupling case
+!! Modifications 16/03/95 (Stein) remove R from the historical variables
+!! Modifications 01/03/95 (Hereil) add the budget namelists
+!! Modifications 16/06/95 (Stein) coherence control for the
+!! microphysical scheme + remove the wrong messge for RESTA conf
+!! Modifications 30/06/95 (Stein) conditionnal reading of the fields
+!! used by the moist turbulence scheme
+!! Modifications 12/09/95 (Pinty) add the radiation scheme
+!! Modification 06/02/96 (J.Vila) implement scalar advection schemes
+!! Modifications 24/02/96 (Stein) change the default value for CCPLFILE
+!! Modifications 02/05/96 (Stein Jabouille) change the Z0SEA activation
+!! Modifications 24/05/96 (Stein) change the SRC SIGS control
+!! Modifications 08/09/96 (Masson) the coupling file names are reset to
+!! default value " " before reading in EXSEG1.nam
+!! to avoid extra non-existant coupling files
+!!
+!! Modifications 25/04/95 (K.Suhre)add namelist NAM_BLANK
+!! add read for LFORCING
+!! 25/04/95 (K.Suhre)add namelist NAM_FRC
+!! and switch checking
+!! 06/08/96 (K.Suhre)add namelist NAM_CH_MNHCn
+!! and NAM_CH_SOLVER
+!! Modifications 10/10/96 (Stein) change SRC into SRCM and SRCT
+!! Modifications 11/04/96 (Pinty) add the rain-ice microphysical scheme
+!! Modifications 11/01/97 (Pinty) add the deep convection scheme
+!! Modifications 22/05/97 (Lafore) gridnesting implementation
+!! Modifications 22/06/97 (Stein) add the absolute pressure + cleaning
+!! Modifications 25/08/97 (Masson) add tests on surface schemes
+!! 22/10/97 (Stein) remove the RIMX /= 0 control
+!! + new namelist + cleaning
+!! Modifications 17/04/98 (Masson) add tests on character variables
+!! Modification 15/03/99 (Masson) add tests on PROGRAM
+!! Modification 04/01/00 (Masson) removes TSZ0 case
+!! Modification 04/06/00 (Pinty) add C2R2 scheme
+!! 11/12/00 (Tomasini) add CSEA_FLUX to MODD_PARAMn
+!! delete the test on SST_FRC only in 1D
+!! Modification 22/01/01 (Gazen) change NSV,KSV to NSV_USER,KSV_USER and add
+!! NSV_* variables initialization
+!! Modification 15/10/01 (Mallet) allow namelists in different orders
+!! Modification 18/03/02 (Solmon) new radiation scheme test
+!! Modification 29/11/02 (JP Pinty) add C3R5, ICE2, ICE4, ELEC
+!! Modification 06/11/02 (Masson) new LES BL height diagnostic
+!! Modification 06/11/02 (Jabouille) remove LTHINSHELL LFORCING test
+!! Modification 01/12/03 (Gazen) change Chemical scheme interface
+!! Modification 01/2004 (Masson) removes surface (externalization)
+!! Modification 01/2005 (Masson) removes 1D and 2D switches
+!! Modification 04/2005 (Tulet) add dust, orilam
+!! Modification 03/2006 (O.Geoffroy) Add KHKO scheme
+!! Modification 04/2006 (Maric) include 4th order advection scheme
+!! Modification 05/2006 (Masson) add nudging
+!! Modification 05/2006 Remove KEPS
+!! Modification 04/2006 (Maric) include PPM advection scheme
+!! Modification 04/2006 (J.Escobar) Bug dollarn add CALL UPDATE_NAM_CONFN
+!! Modifications 01/2007 (Malardel,Pergaud) add the MF shallow
+!! convection scheme MODN_PARAM_MFSHALL_n
+!! Modification 09/2009 (J.Escobar) add more info on relaxation problems
+!! Modification 09/2011 (J.Escobar) re-add 'ZRESI' choose
+!! Modification 12/2011 (C.Lac) Adaptation to FIT temporal scheme
+!! Modification 12/2012 (S.Bielli) add NAM_NCOUT for netcdf output (removed 08/07/2016)
+!! Modification 02/2012 (Pialat/Tulet) add ForeFire
+!! Modification 02/2012 (T.Lunet) add of new Runge-Kutta methods
+!! Modification 01/2015 (C. Barthe) add explicit LNOx
+!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
+!! M.Leriche 18/12/2015 : bug chimie glace dans prep_real_case
+!! Modification 01/2016 (JP Pinty) Add LIMA
+!! Modification 02/2016 (M.Leriche) treat gas and aq. chemicals separately
+!! P.Wautelet 08/07/2016 : removed MNH_NCWRIT define
+!! Modification 10/2016 (C.LAC) Add OSPLIT_WENO + Add droplet
+!! deposition + Add max values
+!! Modification 11/2016 (Ph. Wautelet) Allocate/initialise some output/backup structures
+!! Modification 03/2017 (JP Chaboureau) Fix the initialization of
+!! LUSERx-type variables for LIMA
+!! M.Leriche 06/2017 for spawn and prep_real avoid abort if wet dep for
+!! aerosol and no cloud scheme defined
+!! Q.Libois 02/2018 ECRAD
+!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+!! Modification 07/2017 (V. Vionnet) add blowing snow scheme
+!! Modification 01/2019 (Q. Rodier) define XCEDIS depending on BL89 or RM17 mixing length
+!! Modification 01/2019 (P. Wautelet) bugs correction: incorrect writes
+!! Modification 01/2019 (R. Honnert) remove SURF in CMF_UPDRAFT
+!! Bielli S. 02/2019 Sea salt : significant sea wave height influences salt emission; 5 salt modes
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
+! C. Lac 11/2019: correction in the drag formula and application to building in addition to tree
+! Q. Rodier 03/2020: add abort if use of any LHORELAX and cyclic conditions
+! F.Auguste 02/2021: add IBM
+! T.Nagel 02/2021: add turbulence recycling
+! E.Jezequel 02/2021: add stations read from CSV file
+! P. Wautelet 09/03/2021: simplify allocation of scalar variable names
+! 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
+! A. Costes 12/2021: add Blaze fire model
+! 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
+!------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+USE MODD_AIRCRAFT_BALLOON, ONLY: NAIRCRAFTS, NBALLOONS
+USE MODD_BLOWSNOW
+USE MODD_BUDGET
+USE MODD_CH_AEROSOL
+USE MODD_CH_M9_n, ONLY : NEQ
+USE MODD_CONDSAMP
+USE MODD_CONF
+USE MODD_CONFZ
+! USE MODD_DRAG_n
+USE MODD_DUST
+USE MODD_DYN
+USE MODD_DYN_n, ONLY : LHORELAX_SVLIMA, LHORELAX_SVFIRE
+#ifdef MNH_FOREFIRE
+USE MODD_FOREFIRE
+#endif
+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_PARAMETERS
+USE MODD_PASPOL
+USE MODD_SALT
+USE MODD_VAR_ll, ONLY: NPROC
+USE MODD_VISCOSITY
+
+USE MODE_MSG
+USE MODE_POS
+
+USE MODI_INI_NSV
+USE MODI_TEST_NAM_VAR
+
+USE MODN_2D_FRC
+USE MODN_ADV_n ! The final filling of these modules for the model n is
+USE MODN_AIRCRAFTS, ONLY: AIRCRAFTS_NML_ALLOCATE, NAM_AIRCRAFTS
+USE MODN_BACKUP
+USE MODN_BALLOONS, ONLY: BALLOONS_NML_ALLOCATE, NAM_BALLOONS
+USE MODN_BLANK_n
+USE MODN_BLOWSNOW
+USE MODN_BLOWSNOW_n
+USE MODN_BUDGET
+USE MODN_CH_MNHC_n
+USE MODN_CH_ORILAM
+USE MODN_CH_SOLVER_n
+USE MODN_CONDSAMP
+USE MODN_CONF
+USE MODN_CONF_n
+USE MODN_CONFZ
+USE MODN_DRAGBLDG_n
+USE MODN_DRAG_n
+USE MODN_DRAGTREE_n
+USE MODN_DUST
+USE MODN_DYN
+USE MODN_DYN_n ! to avoid the duplication of this routine for each model.
+USE MODN_ELEC
+USE MODN_EOL
+USE MODN_EOL_ADNR
+USE MODN_EOL_ALM
+USE MODN_FIRE_n
+USE MODN_FLYERS
+#ifdef MNH_FOREFIRE
+USE MODN_FOREFIRE
+#endif
+USE MODN_FRC
+USE MODN_IBM_PARAM_n
+USE MODN_LATZ_EDFLX
+USE MODN_LBC_n ! routine is used for each nested model. This has been done
+USE MODN_LES
+USE MODN_LUNIT_n
+USE MODN_MEAN
+USE MODN_NESTING
+USE MODN_NUDGING_n
+USE MODN_OUTPUT
+USE MODN_PARAM_C1R3, ONLY : NAM_PARAM_C1R3, CPRISTINE_ICE_C1R3, &
+ CHEVRIMED_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 MODN_PARAM_ICE
+USE MODN_PARAM_KAFR_n
+USE MODN_PARAM_LIMA, ONLY : FINI_CCN=>HINI_CCN,NAM_PARAM_LIMA,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 MODN_PARAM_MFSHALL_n
+USE MODN_PARAM_n ! realized in subroutine ini_model n
+USE MODN_PARAM_RAD_n
+USE MODN_PASPOL
+USE MODN_PROFILER_n
+USE MODN_RECYCL_PARAM_n
+USE MODN_SALT
+USE MODN_SERIES
+USE MODN_SERIES_n
+USE MODN_STATION_n
+USE MODN_TURB
+USE MODN_TURB_CLOUD
+USE MODN_TURB_n
+USE MODN_VISCOSITY
+!
+IMPLICIT NONE
+!
+!* 0.1 declarations of arguments
+!
+!
+!
+INTEGER, INTENT(IN) :: KMI ! Model index
+TYPE(TFILEDATA), INTENT(IN) :: TPEXSEGFILE ! EXSEG file
+! The following variables are read by READ_DESFM in DESFM descriptor :
+CHARACTER (LEN=*), INTENT(IN) :: HCONF ! configuration var. linked to FMfile
+LOGICAL, INTENT(IN) :: OFLAT ! Logical for zero orography
+LOGICAL, INTENT(IN) :: OUSERV,OUSERC,OUSERR,OUSERI,OUSERS, &
+ OUSERG,OUSERH ! kind of moist variables in
+ ! FMfile
+LOGICAL, INTENT(IN) :: OUSECI ! ice concentration in
+ ! FMfile
+LOGICAL, INTENT(IN) :: OUSECHEM ! Chemical FLAG in FMFILE
+LOGICAL, INTENT(IN) :: OUSECHAQ ! Aqueous chemical FLAG in FMFILE
+LOGICAL, INTENT(IN) :: OUSECHIC ! Ice chemical FLAG in FMFILE
+LOGICAL, INTENT(IN) :: OCH_PH ! pH FLAG in FMFILE
+LOGICAL, INTENT(IN) :: OCH_CONV_LINOX ! LiNOx FLAG in FMFILE
+LOGICAL, INTENT(IN) :: ODUST ! Dust FLAG in FMFILE
+LOGICAL,DIMENSION(:), INTENT(IN) :: ODEPOS_DST ! Dust Deposition FLAG in FMFILE
+LOGICAL,DIMENSION(:), INTENT(IN) :: ODEPOS_SLT ! Sea Salt wet deposition FLAG in FMFILE
+LOGICAL,DIMENSION(:), INTENT(IN) :: ODEPOS_AER ! Orilam wet deposition FLAG in FMFILE
+LOGICAL, INTENT(IN) :: OSALT ! Sea Salt FLAG in FMFILE
+LOGICAL, INTENT(IN) :: OORILAM ! Orilam FLAG in FMFILE
+LOGICAL, INTENT(IN) :: OPASPOL ! Passive pollutant FLAG in FMFILE
+LOGICAL, INTENT(IN) :: OFIRE ! Blaze FLAG in FMFILE
+#ifdef MNH_FOREFIRE
+LOGICAL, INTENT(IN) :: OFOREFIRE ! ForeFire FLAG in FMFILE
+#endif
+LOGICAL, INTENT(IN) :: OLNOX_EXPLICIT ! explicit LNOx FLAG in FMFILE
+LOGICAL, INTENT(IN) :: OCONDSAMP ! Conditional sampling FLAG in FMFILE
+LOGICAL, INTENT(IN) :: OCHTRANS ! LCHTRANS FLAG in FMFILE
+LOGICAL, INTENT(IN) :: OBLOWSNOW ! Blowing snow FLAG in FMFILE
+
+LOGICAL, INTENT(IN) :: OLG ! lagrangian FLAG in FMFILE
+INTEGER, INTENT(IN) :: KRIMX, KRIMY ! number of points for the
+ ! horizontal relaxation for the outermost verticals
+INTEGER, INTENT(IN) :: KSV_USER ! number of additional scalar
+ ! variables in FMfile
+CHARACTER (LEN=*), INTENT(IN) :: HTURB ! Kind of turbulence parameterization
+ ! used to produce FMFILE
+CHARACTER (LEN=*), INTENT(IN) :: HTOM ! Kind of third order moment
+LOGICAL, INTENT(IN) :: ORMC01 ! flag for RMC01 SBL computations
+CHARACTER (LEN=*), INTENT(IN) :: HRAD ! Kind of radiation scheme
+CHARACTER (LEN=4), INTENT(IN) :: HDCONV ! Kind of deep convection scheme
+CHARACTER (LEN=4), INTENT(IN) :: HSCONV ! Kind of shallow convection scheme
+CHARACTER (LEN=4), INTENT(IN) :: HCLOUD ! Kind of microphysical scheme
+CHARACTER (LEN=4), INTENT(IN) :: HELEC ! Kind of electrical scheme
+CHARACTER (LEN=*), INTENT(IN) :: HEQNSYS! type of equations' system
+REAL,DIMENSION(:), INTENT(INOUT):: PTSTEP_ALL ! Time STEP of ALL models
+CHARACTER (LEN=*), INTENT(IN) :: HINIFILEPGD ! name of PGD file
+!
+!* 0.2 declarations of local variables
+!
+CHARACTER(LEN=3) :: YMODEL
+INTEGER :: ILUSEG,ILUOUT ! logical unit numbers of EXSEG file and outputlisting
+INTEGER :: JS,JCI,JI,JSV ! Loop indexes
+LOGICAL :: GRELAX
+LOGICAL :: GFOUND ! Return code when searching namelist
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. READ EXSEG FILE
+! ---------------
+!
+CALL PRINT_MSG(NVERB_DEBUG,'IO','READ_EXSEG_n','called for '//TRIM(TPEXSEGFILE%CNAME))
+!
+ILUSEG = TPEXSEGFILE%NLU
+ILUOUT = TLUOUT%NLU
+!
+CALL INIT_NAM_LUNITN
+CCPLFILE(:)=" "
+CALL INIT_NAM_CONFN
+CALL INIT_NAM_DYNN
+CALL INIT_NAM_ADVN
+CALL INIT_NAM_DRAGTREEN
+CALL INIT_NAM_DRAGBLDGN
+CALL INIT_NAM_PARAMN
+CALL INIT_NAM_PARAM_RADN
+#ifdef MNH_ECRAD
+CALL INIT_NAM_PARAM_ECRADN
+#endif
+CALL INIT_NAM_PARAM_KAFRN
+CALL INIT_NAM_PARAM_MFSHALLN
+CALL INIT_NAM_LBCN
+CALL INIT_NAM_NUDGINGN
+CALL INIT_NAM_TURBN
+CALL INIT_NAM_BLANKN
+CALL INIT_NAM_DRAGN
+CALL INIT_NAM_IBM_PARAMN
+CALL INIT_NAM_RECYCL_PARAMN
+CALL INIT_NAM_CH_MNHCN
+CALL INIT_NAM_CH_SOLVERN
+CALL INIT_NAM_SERIESN
+CALL INIT_NAM_BLOWSNOWN
+CALL INIT_NAM_PROFILERn
+CALL INIT_NAM_STATIONn
+CALL INIT_NAM_FIREn
+!
+WRITE(UNIT=ILUOUT,FMT="(/,'READING THE EXSEG.NAM FILE')")
+CALL POSNAM(ILUSEG,'NAM_LUNITN',GFOUND,ILUOUT)
+IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_LUNITn)
+CALL POSNAM(ILUSEG,'NAM_CONFN',GFOUND,ILUOUT)
+IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_CONFn)
+CALL POSNAM(ILUSEG,'NAM_DYNN',GFOUND,ILUOUT)
+IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_DYNn)
+CALL POSNAM(ILUSEG,'NAM_ADVN',GFOUND,ILUOUT)
+IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_ADVn)
+CALL POSNAM(ILUSEG,'NAM_PARAMN',GFOUND,ILUOUT)
+IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_PARAMn)
+CALL POSNAM(ILUSEG,'NAM_PARAM_RADN',GFOUND,ILUOUT)
+IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_PARAM_RADn)
+#ifdef MNH_ECRAD
+CALL POSNAM(ILUSEG,'NAM_PARAM_ECRADN',GFOUND,ILUOUT)
+IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_PARAM_ECRADn)
+#endif
+CALL POSNAM(ILUSEG,'NAM_PARAM_KAFRN',GFOUND,ILUOUT)
+IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_PARAM_KAFRn)
+CALL POSNAM(ILUSEG,'NAM_PARAM_MFSHALLN',GFOUND,ILUOUT)
+IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_PARAM_MFSHALLn)
+CALL POSNAM(ILUSEG,'NAM_LBCN',GFOUND,ILUOUT)
+IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_LBCn)
+CALL POSNAM(ILUSEG,'NAM_NUDGINGN',GFOUND,ILUOUT)
+IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_NUDGINGn)
+CALL POSNAM(ILUSEG,'NAM_TURBN',GFOUND,ILUOUT)
+IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_TURBn)
+CALL POSNAM(ILUSEG,'NAM_DRAGN',GFOUND,ILUOUT)
+IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_DRAGn)
+CALL POSNAM(ILUSEG,'NAM_IBM_PARAMN',GFOUND,ILUOUT)
+IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_IBM_PARAMn)
+CALL POSNAM(ILUSEG,'NAM_RECYCL_PARAMN',GFOUND,ILUOUT)
+IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_RECYCL_PARAMn)
+CALL POSNAM(ILUSEG,'NAM_CH_MNHCN',GFOUND,ILUOUT)
+IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_CH_MNHCn)
+CALL POSNAM(ILUSEG,'NAM_CH_SOLVERN',GFOUND,ILUOUT)
+IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_CH_SOLVERn)
+CALL POSNAM(ILUSEG,'NAM_SERIESN',GFOUND,ILUOUT)
+IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_SERIESn)
+CALL POSNAM(ILUSEG,'NAM_BLANKN',GFOUND,ILUOUT)
+IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_BLANKn)
+CALL POSNAM(ILUSEG,'NAM_BLOWSNOWN',GFOUND,ILUOUT)
+IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_BLOWSNOWn)
+CALL POSNAM(ILUSEG,'NAM_DRAGTREEN',GFOUND,ILUOUT)
+IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_DRAGTREEn)
+CALL POSNAM(ILUSEG,'NAM_DRAGBLDGN',GFOUND,ILUOUT)
+IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_DRAGBLDGn)
+CALL POSNAM(ILUSEG,'NAM_EOL',GFOUND,ILUOUT)
+IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_EOL)
+CALL POSNAM(ILUSEG,'NAM_EOL_ADNR',GFOUND,ILUOUT)
+IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_EOL_ADNR)
+CALL POSNAM(ILUSEG,'NAM_EOL_ALM',GFOUND,ILUOUT)
+IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_EOL_ALM)
+CALL POSNAM(ILUSEG,'NAM_PROFILERN',GFOUND,ILUOUT)
+IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_PROFILERn)
+CALL POSNAM(ILUSEG,'NAM_STATIONN',GFOUND,ILUOUT)
+IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_STATIONn)
+CALL POSNAM(ILUSEG,'NAM_FIREN',GFOUND,ILUOUT)
+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)
+ IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_CONF)
+ CALL POSNAM(ILUSEG,'NAM_CONFZ',GFOUND,ILUOUT)
+ IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_CONFZ)
+ CALL POSNAM(ILUSEG,'NAM_DYN',GFOUND,ILUOUT)
+ IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_DYN)
+ CALL POSNAM(ILUSEG,'NAM_NESTING',GFOUND,ILUOUT)
+ IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_NESTING)
+ CALL POSNAM(ILUSEG,'NAM_BACKUP',GFOUND,ILUOUT)
+ IF (GFOUND) THEN
+ !Should have been allocated before in READ_DESFM_n
+ IF (.NOT.ALLOCATED(XBAK_TIME)) THEN
+ ALLOCATE(XBAK_TIME(NMODEL,JPOUTMAX))
+ XBAK_TIME(:,:) = XNEGUNDEF
+ END IF
+ IF (.NOT.ALLOCATED(XOUT_TIME)) THEN
+ ALLOCATE(XOUT_TIME(NMODEL,JPOUTMAX)) !Allocate *OUT* variables to prevent
+ XOUT_TIME(:,:) = XNEGUNDEF
+ END IF
+ IF (.NOT.ALLOCATED(NBAK_STEP)) THEN
+ ALLOCATE(NBAK_STEP(NMODEL,JPOUTMAX))
+ NBAK_STEP(:,:) = NNEGUNDEF
+ END IF
+ IF (.NOT.ALLOCATED(NOUT_STEP)) THEN
+ ALLOCATE(NOUT_STEP(NMODEL,JPOUTMAX)) !problems if NAM_OUTPUT does not exist
+ NOUT_STEP(:,:) = NNEGUNDEF
+ END IF
+ IF (.NOT.ALLOCATED(COUT_VAR)) THEN
+ ALLOCATE(COUT_VAR (NMODEL,JPOUTVARMAX))
+ COUT_VAR(:,:) = ''
+ END IF
+ READ(UNIT=ILUSEG,NML=NAM_BACKUP)
+ ELSE
+ CALL POSNAM(ILUSEG,'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)
+ IF (GFOUND) THEN
+ !Should have been allocated before in READ_DESFM_n
+ IF (.NOT.ALLOCATED(XBAK_TIME)) THEN
+ ALLOCATE(XBAK_TIME(NMODEL,JPOUTMAX)) !Allocate *BAK* variables to prevent
+ XBAK_TIME(:,:) = XNEGUNDEF
+ END IF
+ IF (.NOT.ALLOCATED(XOUT_TIME)) THEN
+ ALLOCATE(XOUT_TIME(NMODEL,JPOUTMAX))
+ XOUT_TIME(:,:) = XNEGUNDEF
+ END IF
+ IF (.NOT.ALLOCATED(NBAK_STEP)) THEN
+ ALLOCATE(NBAK_STEP(NMODEL,JPOUTMAX)) !problems if NAM_BACKUP does not exist
+ NBAK_STEP(:,:) = NNEGUNDEF
+ END IF
+ IF (.NOT.ALLOCATED(NOUT_STEP)) THEN
+ ALLOCATE(NOUT_STEP(NMODEL,JPOUTMAX))
+ NOUT_STEP(:,:) = NNEGUNDEF
+ END IF
+ IF (.NOT.ALLOCATED(COUT_VAR)) THEN
+ ALLOCATE(COUT_VAR (NMODEL,JPOUTVARMAX))
+ COUT_VAR(:,:) = ''
+ END IF
+ READ(UNIT=ILUSEG,NML=NAM_OUTPUT)
+ END IF
+ CALL POSNAM(ILUSEG,'NAM_BUDGET',GFOUND,ILUOUT)
+ IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_BUDGET)
+
+ CALL POSNAM(ILUSEG,'NAM_BU_RU',GFOUND,ILUOUT)
+ IF (GFOUND) THEN
+ IF ( ALLOCATED( CBULIST_RU ) ) THEN
+ CALL Print_msg( NVERB_WARNING, 'IO', 'READ_EXSEG_n', 'unexpected: CBULIST_RU was already allocated' )
+ DEALLOCATE( CBULIST_RU )
+ END IF
+ ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RU(NBULISTMAXLINES) )
+ CBULIST_RU(:) = ''
+ READ(UNIT=ILUSEG,NML=NAM_BU_RU)
+ ELSE
+ ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RU(0) )
+ END IF
+
+ CALL POSNAM(ILUSEG,'NAM_BU_RV',GFOUND,ILUOUT)
+ IF (GFOUND) THEN
+ IF ( ALLOCATED( CBULIST_RV ) ) THEN
+ CALL Print_msg( NVERB_WARNING, 'IO', 'READ_EXSEG_n', 'unexpected: CBULIST_RV was already allocated' )
+ DEALLOCATE( CBULIST_RV )
+ END IF
+ ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RV(NBULISTMAXLINES) )
+ CBULIST_RV(:) = ''
+ READ(UNIT=ILUSEG,NML=NAM_BU_RV)
+ ELSE
+ ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RV(0) )
+ END IF
+
+ CALL POSNAM(ILUSEG,'NAM_BU_RW',GFOUND,ILUOUT)
+ IF (GFOUND) THEN
+ IF ( ALLOCATED( CBULIST_RW ) ) THEN
+ CALL Print_msg( NVERB_WARNING, 'IO', 'READ_EXSEG_n', 'unexpected: CBULIST_RW was already allocated' )
+ DEALLOCATE( CBULIST_RW )
+ END IF
+ ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RW(NBULISTMAXLINES) )
+ CBULIST_RW(:) = ''
+ READ(UNIT=ILUSEG,NML=NAM_BU_RW)
+ ELSE
+ ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RW(0) )
+ END IF
+
+ CALL POSNAM(ILUSEG,'NAM_BU_RTH',GFOUND,ILUOUT)
+ IF (GFOUND) THEN
+ IF ( ALLOCATED( CBULIST_RTH ) ) THEN
+ CALL Print_msg( NVERB_WARNING, 'IO', 'READ_EXSEG_n', 'unexpected: CBULIST_RTH was already allocated' )
+ DEALLOCATE( CBULIST_RTH )
+ END IF
+ ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RTH(NBULISTMAXLINES) )
+ CBULIST_RTH(:) = ''
+ READ(UNIT=ILUSEG,NML=NAM_BU_RTH)
+ ELSE
+ ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RTH(0) )
+ END IF
+
+ CALL POSNAM(ILUSEG,'NAM_BU_RTKE',GFOUND,ILUOUT)
+ IF (GFOUND) THEN
+ IF ( ALLOCATED( CBULIST_RTKE ) ) THEN
+ CALL Print_msg( NVERB_WARNING, 'IO', 'READ_EXSEG_n', 'unexpected: CBULIST_RTKE was already allocated' )
+ DEALLOCATE( CBULIST_RTKE )
+ END IF
+ ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RTKE(NBULISTMAXLINES) )
+ CBULIST_RTKE(:) = ''
+ READ(UNIT=ILUSEG,NML=NAM_BU_RTKE)
+ ELSE
+ ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RTKE(0) )
+ END IF
+
+ CALL POSNAM(ILUSEG,'NAM_BU_RRV',GFOUND,ILUOUT)
+ IF (GFOUND) THEN
+ IF ( ALLOCATED( CBULIST_RRV ) ) THEN
+ CALL Print_msg( NVERB_WARNING, 'IO', 'READ_EXSEG_n', 'unexpected: CBULIST_RRV was already allocated' )
+ DEALLOCATE( CBULIST_RRV )
+ END IF
+ ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RRV(NBULISTMAXLINES) )
+ CBULIST_RRV(:) = ''
+ READ(UNIT=ILUSEG,NML=NAM_BU_RRV)
+ ELSE
+ ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RRV(0) )
+ END IF
+
+ CALL POSNAM(ILUSEG,'NAM_BU_RRC',GFOUND,ILUOUT)
+ IF (GFOUND) THEN
+ IF ( ALLOCATED( CBULIST_RRC ) ) THEN
+ CALL Print_msg( NVERB_WARNING, 'IO', 'READ_EXSEG_n', 'unexpected: CBULIST_RRC was already allocated' )
+ DEALLOCATE( CBULIST_RRC )
+ END IF
+ ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RRC(NBULISTMAXLINES) )
+ CBULIST_RRC(:) = ''
+ READ(UNIT=ILUSEG,NML=NAM_BU_RRC)
+ ELSE
+ ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RRC(0) )
+ END IF
+
+ CALL POSNAM(ILUSEG,'NAM_BU_RRR',GFOUND,ILUOUT)
+ IF (GFOUND) THEN
+ IF ( ALLOCATED( CBULIST_RRR ) ) THEN
+ CALL Print_msg( NVERB_WARNING, 'IO', 'READ_EXSEG_n', 'unexpected: CBULIST_RRR was already allocated' )
+ DEALLOCATE( CBULIST_RRR )
+ END IF
+ ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RRR(NBULISTMAXLINES) )
+ CBULIST_RRR(:) = ''
+ READ(UNIT=ILUSEG,NML=NAM_BU_RRR)
+ ELSE
+ ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RRR(0) )
+ END IF
+
+ CALL POSNAM(ILUSEG,'NAM_BU_RRI',GFOUND,ILUOUT)
+ IF (GFOUND) THEN
+ IF ( ALLOCATED( CBULIST_RRI ) ) THEN
+ CALL Print_msg( NVERB_WARNING, 'IO', 'READ_EXSEG_n', 'unexpected: CBULIST_RRI was already allocated' )
+ DEALLOCATE( CBULIST_RRI )
+ END IF
+ ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RRI(NBULISTMAXLINES) )
+ CBULIST_RRI(:) = ''
+ READ(UNIT=ILUSEG,NML=NAM_BU_RRI)
+ ELSE
+ ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RRI(0) )
+ END IF
+
+ CALL POSNAM(ILUSEG,'NAM_BU_RRS',GFOUND,ILUOUT)
+ IF (GFOUND) THEN
+ IF ( ALLOCATED( CBULIST_RRS ) ) THEN
+ CALL Print_msg( NVERB_WARNING, 'IO', 'READ_EXSEG_n', 'unexpected: CBULIST_RRS was already allocated' )
+ DEALLOCATE( CBULIST_RRS )
+ END IF
+ ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RRS(NBULISTMAXLINES) )
+ CBULIST_RRS(:) = ''
+ READ(UNIT=ILUSEG,NML=NAM_BU_RRS)
+ ELSE
+ ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RRS(0) )
+ END IF
+
+ CALL POSNAM(ILUSEG,'NAM_BU_RRG',GFOUND,ILUOUT)
+ IF (GFOUND) THEN
+ IF ( ALLOCATED( CBULIST_RRG ) ) THEN
+ CALL Print_msg( NVERB_WARNING, 'IO', 'READ_EXSEG_n', 'unexpected: CBULIST_RRG was already allocated' )
+ DEALLOCATE( CBULIST_RRG )
+ END IF
+ ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RRG(NBULISTMAXLINES) )
+ CBULIST_RRG(:) = ''
+ READ(UNIT=ILUSEG,NML=NAM_BU_RRG)
+ ELSE
+ ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RRG(0) )
+ END IF
+
+ CALL POSNAM(ILUSEG,'NAM_BU_RRH',GFOUND,ILUOUT)
+ IF (GFOUND) THEN
+ IF ( ALLOCATED( CBULIST_RRH ) ) THEN
+ CALL Print_msg( NVERB_WARNING, 'IO', 'READ_EXSEG_n', 'unexpected: CBULIST_RRH was already allocated' )
+ DEALLOCATE( CBULIST_RRH )
+ END IF
+ ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RRH(NBULISTMAXLINES) )
+ CBULIST_RRH(:) = ''
+ READ(UNIT=ILUSEG,NML=NAM_BU_RRH)
+ ELSE
+ ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RRH(0) )
+ END IF
+
+ CALL POSNAM(ILUSEG,'NAM_BU_RSV',GFOUND,ILUOUT)
+ IF (GFOUND) THEN
+ IF ( ALLOCATED( CBULIST_RSV ) ) THEN
+ CALL Print_msg( NVERB_WARNING, 'IO', 'READ_EXSEG_n', 'unexpected: CBULIST_RSV was already allocated' )
+ DEALLOCATE( CBULIST_RSV )
+ END IF
+ ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RSV(NBULISTMAXLINES) )
+ CBULIST_RSV(:) = ''
+ READ(UNIT=ILUSEG,NML=NAM_BU_RSV)
+ ELSE
+ ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RSV(0) )
+ END IF
+
+ CALL POSNAM(ILUSEG,'NAM_LES',GFOUND,ILUOUT)
+ IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_LES)
+ CALL POSNAM(ILUSEG,'NAM_MEAN',GFOUND,ILUOUT)
+ IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_MEAN)
+ CALL POSNAM(ILUSEG,'NAM_PDF',GFOUND,ILUOUT)
+ IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_PDF)
+ CALL POSNAM(ILUSEG,'NAM_FRC',GFOUND,ILUOUT)
+ IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_FRC)
+ CALL POSNAM(ILUSEG,'NAM_PARAM_ICE',GFOUND,ILUOUT)
+ IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_PARAM_ICE)
+ CALL POSNAM(ILUSEG,'NAM_PARAM_C2R2',GFOUND,ILUOUT)
+ IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_PARAM_C2R2)
+ CALL POSNAM(ILUSEG,'NAM_PARAM_C1R3',GFOUND,ILUOUT)
+ IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_PARAM_C1R3)
+ CALL POSNAM(ILUSEG,'NAM_PARAM_LIMA',GFOUND,ILUOUT)
+ IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_PARAM_LIMA)
+ CALL POSNAM(ILUSEG,'NAM_ELEC',GFOUND,ILUOUT)
+ IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_ELEC)
+ CALL POSNAM(ILUSEG,'NAM_SERIES',GFOUND,ILUOUT)
+ IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_SERIES)
+ CALL POSNAM(ILUSEG,'NAM_TURB_CLOUD',GFOUND,ILUOUT)
+ IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_TURB_CLOUD)
+ CALL POSNAM(ILUSEG,'NAM_TURB',GFOUND,ILUOUT)
+ IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_TURB)
+ CALL POSNAM(ILUSEG,'NAM_CH_ORILAM',GFOUND,ILUOUT)
+ IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_CH_ORILAM)
+ CALL POSNAM(ILUSEG,'NAM_DUST',GFOUND,ILUOUT)
+ IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_DUST)
+ CALL POSNAM(ILUSEG,'NAM_SALT',GFOUND,ILUOUT)
+ IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_SALT)
+ CALL POSNAM(ILUSEG,'NAM_PASPOL',GFOUND,ILUOUT)
+ IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_PASPOL)
+#ifdef MNH_FOREFIRE
+ CALL POSNAM(ILUSEG,'NAM_FOREFIRE',GFOUND,ILUOUT)
+ IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_FOREFIRE)
+#endif
+ CALL POSNAM(ILUSEG,'NAM_CONDSAMP',GFOUND,ILUOUT)
+ IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_CONDSAMP)
+ CALL POSNAM(ILUSEG,'NAM_2D_FRC',GFOUND,ILUOUT)
+ IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_2D_FRC)
+ CALL POSNAM(ILUSEG,'NAM_LATZ_EDFLX',GFOUND)
+ IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_LATZ_EDFLX)
+ CALL POSNAM(ILUSEG,'NAM_BLOWSNOW',GFOUND,ILUOUT)
+ IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_BLOWSNOW)
+ CALL POSNAM(ILUSEG,'NAM_VISC',GFOUND,ILUOUT)
+ IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_VISC)
+
+ CALL POSNAM(ILUSEG,'NAM_FLYERS',GFOUND,ILUOUT)
+ IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_FLYERS)
+
+ IF ( NAIRCRAFTS > 0 ) THEN
+ CALL AIRCRAFTS_NML_ALLOCATE( NAIRCRAFTS )
+ CALL POSNAM(ILUSEG,'NAM_AIRCRAFTS',GFOUND,ILUOUT)
+ 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)
+ IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_BALLOONS)
+ END IF
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+CALL TEST_NAM_VAR(ILUOUT,'CPRESOPT',CPRESOPT,'RICHA','CGRAD','CRESI','ZRESI')
+!
+CALL TEST_NAM_VAR(ILUOUT,'CUVW_ADV_SCHEME',CUVW_ADV_SCHEME, &
+ 'CEN4TH','CEN2ND','WENO_K' )
+CALL TEST_NAM_VAR(ILUOUT,'CMET_ADV_SCHEME',CMET_ADV_SCHEME, &
+ &'PPM_00','PPM_01','PPM_02')
+CALL TEST_NAM_VAR(ILUOUT,'CSV_ADV_SCHEME',CSV_ADV_SCHEME, &
+ &'PPM_00','PPM_01','PPM_02')
+CALL TEST_NAM_VAR(ILUOUT,'CTEMP_SCHEME',CTEMP_SCHEME, &
+ &'RK11','RK21','RK33','RKC4','RK53','RK4B','RK62','RK65','NP32','SP32','LEFR')
+!
+CALL TEST_NAM_VAR(ILUOUT,'CTURB',CTURB,'NONE','TKEL')
+CALL TEST_NAM_VAR(ILUOUT,'CRAD',CRAD,'NONE','FIXE','ECMW',&
+#ifdef MNH_ECRAD
+ 'ECRA',&
+#endif
+ 'TOPA')
+CALL TEST_NAM_VAR(ILUOUT,'CCLOUD',CCLOUD,'NONE','REVE','KESS', &
+ & 'ICE3','ICE4','C2R2','C3R5','KHKO','LIMA')
+CALL TEST_NAM_VAR(ILUOUT,'CDCONV',CDCONV,'NONE','KAFR')
+CALL TEST_NAM_VAR(ILUOUT,'CSCONV',CSCONV,'NONE','KAFR','EDKF')
+CALL TEST_NAM_VAR(ILUOUT,'CELEC',CELEC,'NONE','ELE3','ELE4')
+!
+CALL TEST_NAM_VAR(ILUOUT,'CAER',CAER,'TANR','TEGE','SURF','NONE')
+CALL TEST_NAM_VAR(ILUOUT,'CAOP',CAOP,'CLIM','EXPL')
+CALL TEST_NAM_VAR(ILUOUT,'CLW',CLW,'RRTM','MORC')
+CALL TEST_NAM_VAR(ILUOUT,'CEFRADL',CEFRADL,'PRES','OCLN','MART','C2R2','LIMA')
+CALL TEST_NAM_VAR(ILUOUT,'CEFRADI',CEFRADI,'FX40','LIOU','SURI','C3R5','LIMA')
+CALL TEST_NAM_VAR(ILUOUT,'COPWLW',COPWLW,'SAVI','SMSH','LILI','MALA')
+CALL TEST_NAM_VAR(ILUOUT,'COPILW',COPILW,'FULI','EBCU','SMSH','FU98')
+CALL TEST_NAM_VAR(ILUOUT,'COPWSW',COPWSW,'SLIN','FOUQ','MALA')
+CALL TEST_NAM_VAR(ILUOUT,'COPISW',COPISW,'FULI','EBCU','FU96')
+!
+CALL TEST_NAM_VAR(ILUOUT,'CLBCX(1)',CLBCX(1),'CYCL','WALL','OPEN')
+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 TEST_NAM_VAR(ILUOUT,'CTURBDIM',CTURBDIM,'1DIM','3DIM')
+CALL TEST_NAM_VAR(ILUOUT,'CTURBLEN',CTURBLEN,'DELT','BL89','RM17','DEAR','BLKR','HM21')
+CALL TEST_NAM_VAR(ILUOUT,'CTOM',CTOM,'NONE','TM06')
+CALL TEST_NAM_VAR(ILUOUT,'CSUBG_AUCV',CSUBG_AUCV,'NONE','CLFR','SIGM','PDF','ADJU')
+CALL TEST_NAM_VAR(ILUOUT,'CSUBG_AUCV_RI',CSUBG_AUCV_RI,'NONE','CLFR','ADJU')
+CALL TEST_NAM_VAR(ILUOUT,'CCONDENS',CCONDENS,'CB02','GAUS')
+CALL TEST_NAM_VAR(ILUOUT,'CLAMBDA3',CLAMBDA3,'CB','NONE')
+CALL TEST_NAM_VAR(ILUOUT,'CSUBG_MF_PDF',CSUBG_MF_PDF,'NONE','TRIANGLE')
+!
+CALL TEST_NAM_VAR(ILUOUT,'CCH_TDISCRETIZATION',CCH_TDISCRETIZATION, &
+ 'SPLIT ','CENTER ','LAGGED ')
+!
+CALL TEST_NAM_VAR(ILUOUT,'CCONF',CCONF,'START','RESTA')
+CALL TEST_NAM_VAR(ILUOUT,'CEQNSYS',CEQNSYS,'LHE','DUR','MAE')
+CALL TEST_NAM_VAR(ILUOUT,'CSPLIT',CSPLIT,'BSPLITTING','XSPLITTING','YSPLITTING')
+!
+CALL TEST_NAM_VAR(ILUOUT,'CBUTYPE',CBUTYPE,'NONE','CART','MASK')
+!
+CALL TEST_NAM_VAR(ILUOUT,'CRELAX_HEIGHT_TYPE',CRELAX_HEIGHT_TYPE,'FIXE','THGR')
+!
+CALL TEST_NAM_VAR(ILUOUT,'CLES_NORM_TYPE',CLES_NORM_TYPE,'NONE','CONV','EKMA','MOBU')
+CALL TEST_NAM_VAR(ILUOUT,'CBL_HEIGHT_DEF',CBL_HEIGHT_DEF,'TKE','KE','WTV','FRI','DTH')
+CALL TEST_NAM_VAR(ILUOUT,'CTURBLEN_CLOUD',CTURBLEN_CLOUD,'NONE','DEAR','DELT','BL89')
+!
+! The test on the mass flux scheme for shallow convection
+!
+CALL TEST_NAM_VAR(ILUOUT,'CMF_UPDRAFT',CMF_UPDRAFT,'NONE','EDKF','RHCJ')
+CALL TEST_NAM_VAR(ILUOUT,'CMF_CLOUD',CMF_CLOUD,'NONE','STAT','DIRE')
+!
+! The test on the CSOLVER name is made elsewhere
+!
+CALL TEST_NAM_VAR(ILUOUT,'CPRISTINE_ICE',CPRISTINE_ICE,'PLAT','COLU','BURO')
+CALL TEST_NAM_VAR(ILUOUT,'CSEDIM',CSEDIM,'SPLI','STAT','NONE')
+IF( CCLOUD == 'C3R5' ) THEN
+ CALL TEST_NAM_VAR(ILUOUT,'CPRISTINE_ICE_C1R3',CPRISTINE_ICE_C1R3, &
+ 'PLAT','COLU','BURO')
+ CALL TEST_NAM_VAR(ILUOUT,'CHEVRIMED_ICE_C1R3',CHEVRIMED_ICE_C1R3, &
+ 'GRAU','HAIL')
+END IF
+!
+IF( CCLOUD == 'LIMA' ) THEN
+ CALL TEST_NAM_VAR(ILUOUT,'CPRISTINE_ICE_LIMA',CPRISTINE_ICE_LIMA, &
+ 'PLAT','COLU','BURO')
+ CALL TEST_NAM_VAR(ILUOUT,'CHEVRIMED_ICE_LIMA',CHEVRIMED_ICE_LIMA, &
+ 'GRAU','HAIL')
+END IF
+! Blaze
+CALL UPDATE_NAM_FIREn
+IF (LBLAZE) THEN
+ ! Blaze is only allowed on finer model(s)
+ DO JI = 1, NMODEL
+ IF ( JI /= KMI .AND. NDAD(JI) == KMI ) THEN
+ WRITE( YMODEL, '( I3 )' ) JI
+ CMNHMSG(1) = 'Blaze fire model only allowed on finer model'
+ CMNHMSG(2) = '=> disabled on model ' // YMODEL
+ CALL PRINT_MSG( NVERB_WARNING, 'GEN', 'READ_EXSEG_n' )
+ LBLAZE = .FALSE.
+ END IF
+ END DO
+ CALL TEST_NAM_VAR(ILUOUT,'CPROPAG_MODEL',CPROPAG_MODEL,'SANTONI2011')
+ CALL TEST_NAM_VAR(ILUOUT,'CHEAT_FLUX_MODEL',CHEAT_FLUX_MODEL,'CST','EXP','EXS')
+ CALL TEST_NAM_VAR(ILUOUT,'CLATENT_FLUX_MODEL',CLATENT_FLUX_MODEL,'CST','EXP')
+ CALL TEST_NAM_VAR(ILUOUT,'CFIRE_CPL_MODE',CFIRE_CPL_MODE,'2WAYCPL','FIR2ATM','ATM2FIR')
+ CALL TEST_NAM_VAR(ILUOUT,'CWINDFILTER',CWINDFILTER,'EWAM','WLIM')
+END IF
+!
+IF(LBLOWSNOW) THEN
+ CALL TEST_NAM_VAR(ILUOUT,'CSNOWSEDIM',CSNOWSEDIM,'NONE','MITC','CARR','TABC')
+ IF (XALPHA_SNOW .NE. 3 .AND. CSNOWSEDIM=='TABC') THEN
+ WRITE(ILUOUT,*) '*****************************************'
+ WRITE(ILUOUT,*) '* XALPHA_SNW must be set to 3 when '
+ WRITE(ILUOUT,*) '* CSNOWSEDIM = TABC '
+ WRITE(ILUOUT,*) '* Update the look-up table in BLOWSNOW_SEDIM_LKT1D '
+ WRITE(ILUOUT,*) '* to use TABC with a different value of XEMIALPHA_SNW'
+ WRITE(ILUOUT,*) '*****************************************'
+ !callabortstop
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
+ ENDIF
+END IF
+!
+!-------------------------------------------------------------------------------!
+!* 2. FIRST INITIALIZATIONS
+! ---------------------
+!
+!* 2.1 Time step in gridnesting case
+!
+IF (KMI /= 1 .AND. NDAD(KMI) /= KMI) THEN
+ XTSTEP = PTSTEP_ALL(NDAD(KMI)) / NDTRATIO(KMI)
+END IF
+PTSTEP_ALL(KMI) = XTSTEP
+!
+!* 2.2 Fill the global configuration module
+!
+! Check coherence between the microphysical scheme and water species and
+!initialize the logicals LUSERn
+!
+SELECT CASE ( CCLOUD )
+ CASE ( 'NONE' )
+ IF (.NOT. ( (.NOT. LUSERC) .AND. (.NOT. LUSERR) .AND. (.NOT. LUSERI) .AND. &
+ (.NOT. LUSERS) .AND. (.NOT. LUSERG) .AND. (.NOT. LUSERH) &
+ ) .AND. CPROGRAM=='MESONH' ) THEN
+!
+ LUSERC=.FALSE.
+ LUSERR=.FALSE.; LUSERI=.FALSE.
+ LUSERS=.FALSE.; LUSERG=.FALSE.
+ LUSERH=.FALSE.
+!
+ END IF
+!
+ IF (CSUBG_AUCV == 'SIGM') THEN
+!
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(UNIT=ILUOUT,FMT=*) 'YOU WANT TO USE THE SUBGRID AUTOCONVERSION SCHEME '
+ WRITE(UNIT=ILUOUT,FMT=*) ' WITHOUT MICROPHYSICS'
+ WRITE(UNIT=ILUOUT,FMT=*) ' CSUBG_AUCV IS PUT TO "NONE"'
+!
+ CSUBG_AUCV = 'NONE'
+!
+ END IF
+!
+ CASE ( 'REVE' )
+ IF (.NOT. ( LUSERV .AND. LUSERC .AND. (.NOT. LUSERR) .AND. (.NOT. LUSERI) &
+ .AND. (.NOT. LUSERS) .AND. (.NOT. LUSERG) .AND. (.NOT. LUSERH) &
+ ) ) THEN
+!
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE A REVERSIBLE MICROPHYSICAL " ,&
+ &" SCHEME. YOU WILL ONLY HAVE VAPOR AND CLOUD WATER ",/, &
+ &" LUSERV AND LUSERC ARE TO TRUE AND THE OTHERS TO FALSE ")')
+!
+ LUSERV=.TRUE. ; LUSERC=.TRUE.
+ LUSERR=.FALSE.; LUSERI=.FALSE.
+ LUSERS=.FALSE.; LUSERG=.FALSE.
+ LUSERH=.FALSE.
+ END IF
+!
+ IF (CSUBG_AUCV == 'SIGM') THEN
+!
+ WRITE(UNIT=ILUOUT,FMT=9003) KMI
+ WRITE(UNIT=ILUOUT,FMT=*) 'YOU WANT TO USE BOTH A REVERSIBLE MICROPHYSICAL SCHEME '
+ WRITE(UNIT=ILUOUT,FMT=*) ' AND THE SUBGRID AUTOCONVERSION SCHEME '
+ WRITE(UNIT=ILUOUT,FMT=*) 'BUT YOU DO NOT HAVE RAIN in the "REVE" SCHEME'
+ WRITE(UNIT=ILUOUT,FMT=*) ' CSUBG_AUCV IS PUT TO "NONE"'
+!
+ CSUBG_AUCV = 'NONE'
+!
+ END IF
+!
+ CASE ( 'KESS' )
+ IF (.NOT. ( LUSERV .AND. LUSERC .AND. LUSERR .AND. (.NOT. LUSERI) .AND. &
+ (.NOT. LUSERS) .AND. (.NOT. LUSERG) .AND. (.NOT. LUSERH) &
+ ) ) THEN
+!
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE A KESSLER MICROPHYSICAL " , &
+ &" SCHEME. YOU WILL ONLY HAVE VAPOR, CLOUD WATER AND RAIN ",/, &
+ &" LUSERV, LUSERC AND LUSERR ARE SET TO TRUE AND THE OTHERS TO FALSE ")')
+!
+ LUSERV=.TRUE. ; LUSERC=.TRUE. ; LUSERR=.TRUE.
+ LUSERI=.FALSE.; LUSERS=.FALSE.
+ LUSERG=.FALSE.; LUSERH=.FALSE.
+ END IF
+!
+ IF (CSUBG_AUCV == 'SIGM') THEN
+!
+ WRITE(UNIT=ILUOUT,FMT=9003) KMI
+ WRITE(UNIT=ILUOUT,FMT=*) 'YOU WANT TO USE BOTH A KESSLER MICROPHYSICAL SCHEME '
+ WRITE(UNIT=ILUOUT,FMT=*) ' AND THE SUBGRID AUTOCONVERSION SCHEME USING'
+ WRITE(UNIT=ILUOUT,FMT=*) 'SIGMA_RC.'
+ WRITE(UNIT=ILUOUT,FMT=*) 'THIS IS NOT YET AVAILABLE.'
+ WRITE(UNIT=ILUOUT,FMT=*) 'SET CSUBG_AUCV TO "CLFR" or "NONE" OR CCLOUD TO "ICE3"'
+!
+ !callabortstop
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
+ END IF
+!
+ CASE ( 'ICE3' )
+ IF (.NOT. ( LUSERV .AND. LUSERC .AND. LUSERR .AND. LUSERI .AND. LUSECI &
+ .AND. LUSERS .AND. LUSERG .AND. (.NOT. LUSERH)) &
+ .AND. CPROGRAM=='MESONH' ) THEN
+ !
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(UNIT=ILUOUT,FMT=*) 'YOU WANT TO USE THE ice3 SIMPLE MIXED PHASE'
+ WRITE(UNIT=ILUOUT,FMT=*) 'MICROPHYSICAL SCHEME. YOU WILL ONLY HAVE VAPOR, CLOUD WATER,'
+ WRITE(UNIT=ILUOUT,FMT=*) 'RAIN WATER, CLOUD ICE (MIXING RATIO AND CONCENTRATION)'
+ WRITE(UNIT=ILUOUT,FMT=*) 'SNOW-AGGREGATES AND GRAUPELN.'
+ WRITE(UNIT=ILUOUT,FMT=*) 'LUSERV,LUSERC,LUSERR,LUSERI,LUSECI,LUSERS,LUSERG ARE SET TO TRUE'
+ WRITE(UNIT=ILUOUT,FMT=*) 'AND LUSERH TO FALSE'
+!
+ LUSERV=.TRUE. ; LUSERC=.TRUE. ; LUSERR=.TRUE.
+ LUSERI=.TRUE. ; LUSECI=.TRUE.
+ LUSERS=.TRUE. ; LUSERG=.TRUE.
+ LUSERH=.FALSE.
+ END IF
+!
+ IF (CSUBG_AUCV == 'SIGM' .AND. .NOT. LSUBG_COND) THEN
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(UNIT=ILUOUT,FMT=*) 'YOU WANT TO USE SUBGRID AUTOCONVERSION SCHEME'
+ WRITE(UNIT=ILUOUT,FMT=*) ' WITHOUT THE SUBGRID CONDENSATION SCHEME.'
+ WRITE(UNIT=ILUOUT,FMT=*) 'THIS IS NOT ALLOWED: CSUBG_AUCV is SET to NONE'
+ CSUBG_AUCV='NONE'
+ END IF
+!
+ IF (CSUBG_AUCV == 'CLFR' .AND. CSCONV /= 'EDKF') THEN
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(UNIT=ILUOUT,FMT=*) 'YOU WANT TO USE SUBGRID AUTOCONVERSION SCHEME'
+ WRITE(UNIT=ILUOUT,FMT=*) 'WITH THE CONVECTIVE CLOUD FRACTION WITHOUT EDKF'
+ WRITE(UNIT=ILUOUT,FMT=*) 'THIS IS NOT ALLOWED: CSUBG_AUCV is SET to NONE'
+ CSUBG_AUCV='NONE'
+ END IF
+!
+ CASE ( 'ICE4' )
+ IF (.NOT. ( LUSERV .AND. LUSERC .AND. LUSERR .AND. LUSERI .AND. LUSECI &
+ .AND. LUSERS .AND. LUSERG .AND. LUSERH) &
+ .AND. CPROGRAM=='MESONH' ) THEN
+ !
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(UNIT=ILUOUT,FMT=*) 'YOU WANT TO USE THE ice4 SIMPLE MIXED PHASE'
+ WRITE(UNIT=ILUOUT,FMT=*) 'MICROPHYSICAL SCHEME. YOU WILL ONLY HAVE VAPOR, CLOUD WATER,'
+ WRITE(UNIT=ILUOUT,FMT=*) 'RAIN WATER, CLOUD ICE (MIXING RATIO AND CONCENTRATION)'
+ WRITE(UNIT=ILUOUT,FMT=*) 'SNOW-AGGREGATES, GRAUPELN AND HAILSTONES.'
+ WRITE(UNIT=ILUOUT,FMT=*) 'LUSERV,LUSERC,LUSERR,LUSERI,LUSECI,LUSERS,LUSERG'
+ WRITE(UNIT=ILUOUT,FMT=*) 'AND LUSERH ARE SET TO TRUE'
+!
+ LUSERV=.TRUE. ; LUSERC=.TRUE. ; LUSERR=.TRUE.
+ LUSERI=.TRUE. ; LUSECI=.TRUE.
+ LUSERS=.TRUE. ; LUSERG=.TRUE. ; LUSERH=.TRUE.
+ END IF
+!
+ IF (CSUBG_AUCV /= 'NONE' .AND. .NOT. LSUBG_COND) THEN
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(UNIT=ILUOUT,FMT=*) 'YOU WANT TO USE SUBGRID AUTOCONVERSION SCHEME'
+ WRITE(UNIT=ILUOUT,FMT=*) ' WITHOUT THE SUBGRID CONDENSATION SCHEME.'
+ WRITE(UNIT=ILUOUT,FMT=*) 'THIS IS NOT ALLOWED: CSUBG_AUCV is SET to NONE'
+ CSUBG_AUCV='NONE'
+ END IF
+!
+ CASE ( 'C2R2','C3R5', 'KHKO' )
+ IF (( EPARAM_CCN == 'XXX') .OR. (EINI_CCN == 'XXX')) THEN
+ WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE A 2-MOMENT MICROPHYSICAL ", &
+ &" SCHEME BUT YOU DIDNT FILL CORRECTLY NAM_PARAM_C2R2", &
+ &" YOU HAVE TO FILL HPARAM_CCN and HINI_CCN ")')
+ !callabortstop
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
+ END IF
+ IF (HCLOUD == 'NONE') THEN
+ CGETCLOUD = 'SKIP'
+ ELSE IF (HCLOUD == 'REVE' ) THEN
+ CGETCLOUD = 'INI1'
+ ELSE IF (HCLOUD == 'KESS' ) THEN
+ CGETCLOUD = 'INI2'
+ ELSE IF (HCLOUD == 'ICE3' ) THEN
+ IF (CCLOUD == 'C3R5') THEN
+ CGETCLOUD = 'INI2'
+ ELSE
+ WRITE(UNIT=ILUOUT,FMT=9003) KMI
+ WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE THE WARM MICROPHYSICAL ", &
+ &" SCHEME BUT YOU WERE USING THE ICE3 SCHEME PREVIOUSLY.",/, &
+ &" AS THIS IS A LITTLE BIT STUPID IT IS NOT AUTHORIZED !!!")')
+ !callabortstop
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
+ END IF
+ ELSE
+ CGETCLOUD = 'READ' ! This is automatically done
+ END IF
+!
+ IF ((CCLOUD == 'C2R2' ).OR. (CCLOUD == 'KHKO' )) THEN
+ IF (.NOT. ( LUSERV .AND. LUSERC .AND. LUSERR .AND. (.NOT. LUSERI) .AND. &
+ (.NOT. LUSERS) .AND. (.NOT. LUSERG) .AND. (.NOT. LUSERH) &
+ ) ) THEN
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE THE C2R2 MICROPHYSICAL ", &
+ &" SCHEME. YOU WILL ONLY HAVE VAPOR, CLOUD WATER AND RAIN ",/, &
+ &"LUSERV, LUSERC AND LUSERR ARE SET TO TRUE AND THE OTHERS TO FALSE ")')
+!
+ LUSERV=.TRUE. ; LUSERC=.TRUE. ; LUSERR=.TRUE.
+ LUSERI=.FALSE.; LUSERS=.FALSE.
+ LUSERG=.FALSE.; LUSERH=.FALSE.
+ END IF
+ ELSE IF (CCLOUD == 'C3R5') THEN
+ IF (.NOT. ( LUSERV .AND. LUSERC .AND. LUSERR .AND. LUSERI .AND. &
+ LUSERS .AND. LUSERG .AND. (.NOT. LUSERH) &
+ ) ) THEN
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE THE C3R5 MICROPHYS. SCHEME.",&
+ &" YOU WILL HAVE VAPOR, CLOUD WATER/ICE, RAIN, SNOW AND GRAUPEL ",/, &
+ &"LUSERV, LUSERC, LUSERR, LUSERI, LUSERS, LUSERG ARE SET TO TRUE")' )
+!
+ LUSERV=.TRUE. ; LUSERC=.TRUE. ; LUSERR=.TRUE.
+ LUSERI=.TRUE. ; LUSECI=.TRUE.
+ LUSERS=.TRUE. ; LUSERG=.TRUE.
+ LUSERH=.FALSE.
+ END IF
+ ELSE IF (CCLOUD == 'LIMA') THEN
+ IF (.NOT. ( LUSERV .AND. LUSERC .AND. LUSERR .AND. LUSERI .AND. &
+ LUSERS .AND. LUSERG .AND. (.NOT. LUSERH) &
+ ) ) THEN
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE THE LIMA MICROPHYS. SCHEME.",&
+ &" YOU WILL HAVE VAPOR, CLOUD WATER/ICE, RAIN, SNOW AND GRAUPEL ",/, &
+ &"LUSERV, LUSERC, LUSERR, LUSERI, LUSERS, LUSERG ARE SET TO TRUE")' )
+!
+ LUSERV=.TRUE. ; LUSERC=.TRUE. ; LUSERR=.TRUE.
+ LUSERI=.TRUE. ; LUSECI=.TRUE.
+ LUSERS=.TRUE. ; LUSERG=.TRUE.
+ LUSERH=.FALSE.
+ END IF
+ END IF
+!
+ IF (LSUBG_COND) THEN
+ WRITE(UNIT=ILUOUT,FMT=9003) KMI
+ WRITE(UNIT=ILUOUT,FMT=*) 'YOU WANT TO USE BOTH THE SIMPLE MIXED PHASE'
+ WRITE(UNIT=ILUOUT,FMT=*) 'MICROPHYS. SCHEME AND THE SUBGRID COND. SCHEME.'
+ WRITE(UNIT=ILUOUT,FMT=*) 'THIS IS NOT YET AVAILABLE.'
+ WRITE(UNIT=ILUOUT,FMT=*) 'SET LSUBG_COND TO FALSE OR CCLOUD TO "REVE", "KESS"'
+ !callabortstop
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
+ END IF
+!
+ IF ( CEFRADL /= 'C2R2') THEN
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT=*) ' YOU DID NOT CHOOSE CEFRADL=C2R2 FOR RADIATION'
+ WRITE(UNIT=ILUOUT,FMT=*) ' IT IS ADVISED TO USE CEFRADL=C2R2 '
+ WRITE(UNIT=ILUOUT,FMT=*) ' WITH A 2-MOMENT MICROPHYSICAL SCHEME'
+ END IF
+!
+ IF ( CCLOUD == 'C3R5' .AND. CEFRADI /= 'C3R5') THEN
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT=*) ' YOU DID NOT CHOOSE CEFRADI=C3R5 FOR RADIATION'
+ WRITE(UNIT=ILUOUT,FMT=*) ' IT IS ADVISED TO USE CEFRADI=C3R5 '
+ WRITE(UNIT=ILUOUT,FMT=*) ' WITH A 2-MOMENT MICROPHYSICAL SCHEME'
+ END IF
+!
+ IF ( WALPHAC /= 3.0 .OR. WNUC /= 2.0) THEN
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT=*) 'IT IS ADVISED TO USE XALPHAC=3. and XNUC=2.'
+ WRITE(UNIT=ILUOUT,FMT=*) 'FOR STRATOCUMULUS WITH KHKO SCHEME. '
+ END IF
+!
+ IF ( CEFRADL /= 'C2R2') THEN
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT=*) ' YOU DID NOT CHOOSE CEFRADL=C2R2 FOR RADIATION'
+ WRITE(UNIT=ILUOUT,FMT=*) ' IT IS ADVISED TO USE CEFRADL=C2R2 '
+ WRITE(UNIT=ILUOUT,FMT=*) ' WITH A 2-MOMENT MICROPHYSICAL SCHEME'
+ END IF
+!
+ CASE ( 'LIMA')
+ IF ((LACTI .AND. FINI_CCN == 'XXX')) THEN
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE A 2-MOMENT MICROPHYSICAL ", &
+ &" SCHEME BUT YOU DIDNT FILL CORRECTLY NAM_PARAM_LIMA", &
+ &" YOU HAVE TO FILL FINI_CCN ")')
+ call Print_msg( NVERB_FATAL, 'GEN', 'READ_EXSEG_n', '' )
+ END IF
+!
+ IF(LACTI .AND. NMOD_CCN == 0) THEN
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT='("ACTIVATION OF AEROSOL PARTICLES IS NOT ", &
+ &"POSSIBLE IF NMOD_CCN HAS VALUE ZERO. YOU HAVE TO SET AN UPPER ", &
+ &"VALUE OF NMOD_CCN IN ORDER TO USE LIMA WARM ACTIVATION SCHEME.")')
+ call Print_msg( NVERB_FATAL, 'GEN', 'READ_EXSEG_n', '' )
+ END IF
+!
+ IF(LNUCL .AND. NMOD_IFN == 0 .AND. (.NOT.LMEYERS)) THEN
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT='("NUCLEATION BY DEPOSITION AND CONTACT IS NOT ", &
+ &"POSSIBLE IF NMOD_IFN HAS VALUE ZERO. YOU HAVE TO SET AN UPPER", &
+ &"VALUE OF NMOD_IFN IN ORDER TO USE LIMA COLD NUCLEATION SCHEME.")')
+ END IF
+!
+ IF (HCLOUD == 'NONE') THEN
+ CGETCLOUD = 'SKIP'
+ ELSE IF (HCLOUD == 'REVE' ) THEN
+ CGETCLOUD = 'INI1'
+ ELSE IF (HCLOUD == 'KESS' ) THEN
+ CGETCLOUD = 'INI2'
+ ELSE IF (HCLOUD == 'ICE3' ) THEN
+ CGETCLOUD = 'INI2'
+ ELSE
+ CGETCLOUD = 'READ' ! This is automatically done
+ END IF
+!
+ IF (NMOM_C.GE.1) THEN
+ LUSERV=.TRUE. ; LUSERC=.TRUE. ; LUSERR=.TRUE.
+ LUSERI=.FALSE.; LUSERS=.FALSE. ; LUSERG=.FALSE.; LUSERH=.FALSE.
+ END IF
+!
+ IF (NMOM_I.GE.1) THEN
+ LUSERV=.TRUE. ; LUSERC=.TRUE. ; LUSERR=.TRUE.
+ LUSERI=.TRUE. ; LUSERS=.TRUE. ; LUSERG=.TRUE.
+ LUSERH= NMOM_H.GE.1
+ END IF
+ !
+ IF (LSPRO) LADJ=.FALSE.
+ IF (.NOT.LPTSPLIT) THEN
+ IF (NMOM_C==1) NMOM_C=2
+ IF (NMOM_R==1) NMOM_R=2
+ IF (NMOM_I==1) NMOM_I=2
+ IF (NMOM_S==2 .OR. NMOM_G==2 .OR. NMOM_H==2) THEN
+ NMOM_S=2
+ NMOM_G=2
+ IF (NMOM_H.GE.1) NMOM_H=2
+ END IF
+ END IF
+!
+ IF (LSUBG_COND .AND. (.NOT. LPTSPLIT)) THEN
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT=*) 'YOU MUST USE LPTSPLIT=T with CCLOUD=LIMA'
+ WRITE(UNIT=ILUOUT,FMT=*) 'AND LSUBG_COND '
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','use LPTSPLIT=T with LIMA and LSUBG_COND=T')
+ END IF
+!
+ IF (LSUBG_COND .AND. (.NOT. LADJ)) THEN
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT=*) 'YOU MUST USE LADJ=T with CCLOUD=LIMA'
+ WRITE(UNIT=ILUOUT,FMT=*) 'AND LSUBG_COND '
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','use LADJ=T with LIMA and LSUBG_COND=T')
+ END IF
+!
+ IF ( LKHKO .AND. (XALPHAC /= 3.0 .OR. XNUC /= 2.0) ) THEN
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT=*) 'IT IS ADVISED TO USE XALPHAC=3. and XNUC=2.'
+ WRITE(UNIT=ILUOUT,FMT=*) 'FOR STRATOCUMULUS. '
+ END IF
+!
+ IF ( CEFRADL /= 'LIMA') THEN
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT=*) ' YOU DID NOT CHOOSE CEFRADL=LIMA FOR RADIATION'
+ WRITE(UNIT=ILUOUT,FMT=*) ' IT IS ADVISED TO USE CEFRADL=LIMA '
+ WRITE(UNIT=ILUOUT,FMT=*) ' WITH A 2-MOMENT MICROPHYSICAL SCHEME "LIMA"'
+ END IF
+!
+END SELECT
+!
+LUSERV_G(KMI) = LUSERV
+LUSERC_G(KMI) = LUSERC
+LUSERR_G(KMI) = LUSERR
+LUSERI_G(KMI) = LUSERI
+LUSERS_G(KMI) = LUSERS
+LUSERG_G(KMI) = LUSERG
+LUSERH_G(KMI) = LUSERH
+LUSETKE(KMI) = (CTURB /= 'NONE')
+!
+!-------------------------------------------------------------------------------
+!
+!* 2.3 Chemical and NSV_* variables initializations
+!
+CALL UPDATE_NAM_IBM_PARAMN
+CALL UPDATE_NAM_RECYCL_PARAMN
+CALL UPDATE_NAM_PARAMN
+CALL UPDATE_NAM_DYNN
+CALL UPDATE_NAM_CONFN
+!
+IF (LORILAM .AND. .NOT. LUSECHEM) THEN
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU CANNOT USE ORILAM AEROSOL SCHEME WITHOUT '
+ WRITE(ILUOUT,FMT=*) 'CHEMICAL GASEOUS CHEMISTRY '
+ WRITE(ILUOUT,FMT=*) 'THEREFORE LUSECHEM IS SET TO TRUE '
+ LUSECHEM=.TRUE.
+END IF
+!
+IF (LUSECHAQ.AND.(.NOT.LUSECHEM)) THEN
+ WRITE(UNIT=ILUOUT,FMT=9003) KMI
+ WRITE(UNIT=ILUOUT,FMT=*) 'YOU WANT TO USE AQUEOUS PHASE CHEMISTRY'
+ WRITE(UNIT=ILUOUT,FMT=*) 'BUT THE CHEMISTRY IS NOT ACTIVATED'
+ WRITE(UNIT=ILUOUT,FMT=*) 'SET LUSECHEM TO TRUE IF YOU WANT REALLY USE CHEMISTRY'
+ WRITE(UNIT=ILUOUT,FMT=*) 'OR SET LUSECHAQ TO FALSE IF YOU DO NOT WANT USE IT'
+ !callabortstop
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
+END IF
+IF (LUSECHAQ.AND.(.NOT.LUSERC).AND.CPROGRAM=='MESONH') THEN
+ WRITE(UNIT=ILUOUT,FMT=9003) KMI
+ WRITE(UNIT=ILUOUT,FMT=*) 'YOU WANT TO USE AQUEOUS PHASE CHEMISTRY'
+ WRITE(UNIT=ILUOUT,FMT=*) 'BUT CLOUD MICROPHYSICS IS NOT ACTIVATED'
+ WRITE(UNIT=ILUOUT,FMT=*) 'LUSECHAQ IS SET TO FALSE'
+ LUSECHAQ = .FALSE.
+END IF
+IF (LUSECHAQ.AND.CCLOUD(1:3) == 'ICE'.AND. .NOT. LUSECHIC) THEN
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(UNIT=ILUOUT,FMT=*) 'YOU WANT TO USE AQUEOUS PHASE CHEMISTRY'
+ WRITE(UNIT=ILUOUT,FMT=*) 'WITH MIXED PHASE CLOUD MICROPHYSICS'
+ WRITE(UNIT=ILUOUT,FMT=*) 'SET LUSECHIC TO TRUE IF YOU WANT TO ACTIVATE'
+ WRITE(UNIT=ILUOUT,FMT=*) 'ICE PHASE CHEMICAL SPECIES'
+ IF (LCH_RET_ICE) THEN
+ WRITE(UNIT=ILUOUT,FMT=*) 'LCH_RET_ICE TRUE MEANS ALL SOLUBLE'
+ WRITE(UNIT=ILUOUT,FMT=*) 'GASES ARE RETAINED IN ICE PHASE'
+ WRITE(UNIT=ILUOUT,FMT=*) 'WHEN SUPERCOOLED WATER FREEZES'
+ ELSE
+ WRITE(UNIT=ILUOUT,FMT=*) 'LCH_RET_ICE FALSE MEANS ALL SOLUBLE'
+ WRITE(UNIT=ILUOUT,FMT=*) 'GASES GO BACK TO THE GAS PHASE WHEN'
+ WRITE(UNIT=ILUOUT,FMT=*) 'SUPERCOOLED WATER FREEZES'
+ ENDIF
+ENDIF
+IF (LUSECHIC.AND. .NOT. CCLOUD(1:3) == 'ICE'.AND.CPROGRAM=='MESONH') THEN
+ WRITE(UNIT=ILUOUT,FMT=9003) KMI
+ WRITE(UNIT=ILUOUT,FMT=*) 'YOU WANT TO USE ICE PHASE CHEMISTRY'
+ WRITE(UNIT=ILUOUT,FMT=*) 'BUT MIXED PHASE CLOUD MICROPHYSICS IS NOT ACTIVATED'
+ WRITE(UNIT=ILUOUT,FMT=*) 'LUSECHIC IS SET TO FALSE'
+ LUSECHIC= .FALSE.
+ENDIF
+IF (LCH_PH.AND. (.NOT. LUSECHAQ)) THEN
+ WRITE(UNIT=ILUOUT,FMT=9003) KMI
+ WRITE(UNIT=ILUOUT,FMT=*) 'DIAGNOSTIC PH COMPUTATION IS ACTIVATED'
+ WRITE(UNIT=ILUOUT,FMT=*) 'BUT AQUEOUS PHASE CHEMISTRY IS NOT ACTIVATED'
+ WRITE(UNIT=ILUOUT,FMT=*) 'SET LUSECHAQ TO TRUE IF YOU WANT TO ACTIVATE IT'
+ WRITE(UNIT=ILUOUT,FMT=*) 'LCH_PH IS SET TO FALSE'
+ LCH_PH= .FALSE.
+ENDIF
+IF (LUSECHIC.AND.(.NOT.LUSECHAQ)) THEN
+ WRITE(UNIT=ILUOUT,FMT=9003) KMI
+ WRITE(UNIT=ILUOUT,FMT=*) 'YOU WANT TO USE ICE PHASE CHEMISTRY'
+ WRITE(UNIT=ILUOUT,FMT=*) 'BUT THE AQUEOUS PHASE CHEMISTRY IS NOT ACTIVATED'
+ WRITE(UNIT=ILUOUT,FMT=*) 'SET LUSECHAQ TO TRUE IF YOU WANT REALLY USE CLOUD CHEMISTRY'
+ WRITE(UNIT=ILUOUT,FMT=*) 'OR SET LUSECHIC TO FALSE IF YOU DO NOT WANT USE IT'
+!callabortstop
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
+END IF
+IF ((LUSECHIC).AND.(LCH_RET_ICE)) THEN
+ WRITE(UNIT=ILUOUT,FMT=9003) KMI
+ WRITE(UNIT=ILUOUT,FMT=*) 'YOU WANT TO USE RETENTION OF SOLUBLE GASES IN ICE'
+ WRITE(UNIT=ILUOUT,FMT=*) 'BUT THE ICE PHASE CHEMISTRY IS ACTIVATED'
+ WRITE(UNIT=ILUOUT,FMT=*) 'FLAG LCH_RET_ICE IS ONLY USES WHEN LUSECHIC IS SET'
+ WRITE(UNIT=ILUOUT,FMT=*) 'TO FALSE IE NO CHEMICAL SPECIES IN ICE'
+ENDIF
+!
+CALL UPDATE_NAM_CH_MNHCN
+CALL INI_NSV(KMI)
+!
+! From this point, all NSV* variables contain valid values for model KMI
+!
+DO JSV = 1,NSV
+ LUSESV(JSV,KMI) = .TRUE.
+END DO
+!
+IF ( CAOP=='EXPL' .AND. .NOT.LDUST .AND. .NOT.LORILAM &
+ .AND. .NOT.LSALT .AND. .NOT.(CCLOUD=='LIMA') ) THEN
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT=*) ' YOU WANT TO USE EXPLICIT AEROSOL OPTICAL '
+ WRITE(UNIT=ILUOUT,FMT=*) 'PROPERTIES BUT YOU DONT HAVE DUST OR '
+ WRITE(UNIT=ILUOUT,FMT=*) 'AEROSOL OR SALT THEREFORE CAOP=CLIM'
+ CAOP='CLIM'
+END IF
+!-------------------------------------------------------------------------------
+!
+!* 3. CHECK COHERENCE BETWEEN EXSEG VARIABLES AND FMFILE ATTRIBUTES
+! -------------------------------------------------------------
+!
+!
+!* 3.1 Turbulence variable
+!
+IF ((CTURB /= 'NONE').AND.(HTURB == 'NONE')) THEN
+ CGETTKET ='INIT'
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT=*)'YOU WANT TO USE TURBULENCE KINETIC ENERGY TKE'
+ WRITE(UNIT=ILUOUT,FMT=*)'WHEREAS IT IS NOT IN INITIAL FMFILE'
+ WRITE(UNIT=ILUOUT,FMT=*)'TKE WILL BE INITIALIZED TO ZERO'
+ELSE
+ IF (CTURB /= 'NONE') THEN
+ CGETTKET ='READ'
+ IF ((CCONF=='START') .AND. CPROGRAM /= 'DIAG') CGETTKET='INIT'
+ ELSE
+ CGETTKET ='SKIP'
+ END IF
+END IF
+!
+!
+IF ((CTOM == 'TM06').AND.(HTOM /= 'TM06')) THEN
+ CGETBL_DEPTH ='INIT'
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT=*)'YOU WANT TO USE BL DEPTH FOR THIRD ORDER MOMENTS'
+ WRITE(UNIT=ILUOUT,FMT=*)'WHEREAS IT IS NOT IN INITIAL FMFILE'
+ WRITE(UNIT=ILUOUT,FMT=*)'IT WILL BE INITIALIZED TO ZERO'
+ELSE
+ IF (CTOM == 'TM06') THEN
+ CGETBL_DEPTH ='READ'
+ ELSE
+ CGETBL_DEPTH ='SKIP'
+ END IF
+END IF
+!
+IF (LRMC01 .AND. .NOT. ORMC01) THEN
+ CGETSBL_DEPTH ='INIT'
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT=*)'YOU WANT TO USE SBL DEPTH FOR RMC01'
+ WRITE(UNIT=ILUOUT,FMT=*)'WHEREAS IT IS NOT IN INITIAL FMFILE'
+ WRITE(UNIT=ILUOUT,FMT=*)'IT WILL BE INITIALIZED TO ZERO'
+ELSE
+ IF (LRMC01) THEN
+ CGETSBL_DEPTH ='READ'
+ ELSE
+ CGETSBL_DEPTH ='SKIP'
+ END IF
+END IF
+!
+!
+!* 3.2 Moist variables
+!
+IF (LUSERV.AND. (.NOT.OUSERV)) THEN
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE VAPOR VARIABLE Rv WHEREAS IT ", &
+ & "IS NOT IN INITIAL FMFILE",/, &
+ & "Rv WILL BE INITIALIZED TO ZERO")')
+ CGETRVT='INIT'
+ELSE
+ IF (LUSERV) THEN
+ CGETRVT='READ'
+ ELSE
+ CGETRVT='SKIP'
+ END IF
+END IF
+!
+IF (LUSERC.AND. (.NOT.OUSERC)) THEN
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE CLOUD VARIABLE Rc WHEREAS IT ", &
+ & " IS NOT IN INITIAL FMFILE",/, &
+ & "Rc WILL BE INITIALIZED TO ZERO")')
+ CGETRCT='INIT'
+ELSE
+ IF (LUSERC) THEN
+ CGETRCT='READ'
+! IF(CCONF=='START') CGETRCT='INIT'
+ ELSE
+ CGETRCT='SKIP'
+ END IF
+END IF
+!
+IF (LUSERR.AND. (.NOT.OUSERR)) THEN
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE RAIN VARIABLE Rr WHEREAS IT ", &
+ & "IS NOT IN INITIAL FMFILE",/, &
+ & " Rr WILL BE INITIALIZED TO ZERO")')
+
+ CGETRRT='INIT'
+ELSE
+ IF (LUSERR) THEN
+ CGETRRT='READ'
+! IF( (CCONF=='START').AND. CPROGRAM /= 'DIAG') CGETRRT='INIT'
+ ELSE
+ CGETRRT='SKIP'
+ END IF
+END IF
+!
+IF (LUSERI.AND. (.NOT.OUSERI)) THEN
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE ICE VARIABLE Ri WHEREAS IT ", &
+ & "IS NOT IN INITIAL FMFILE",/, &
+ & " Ri WILL BE INITIALIZED TO ZERO")')
+ CGETRIT='INIT'
+ELSE
+ IF (LUSERI) THEN
+ CGETRIT='READ'
+! IF(CCONF=='START') CGETRIT='INIT'
+ ELSE
+ CGETRIT='SKIP'
+ END IF
+END IF
+!
+IF (LUSECI.AND. (.NOT.OUSECI)) THEN
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE ICE CONC. VARIABLE Ci WHEREAS IT ",&
+ & "IS NOT IN INITIAL FMFILE",/, &
+ & " Ci WILL BE INITIALIZED TO ZERO")')
+ CGETCIT='INIT'
+ELSE
+ IF (LUSECI) THEN
+ CGETCIT='READ'
+ ELSE
+ CGETCIT='SKIP'
+ END IF
+END IF
+!
+IF (LUSERS.AND. (.NOT.OUSERS)) THEN
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE SNOW VARIABLE Rs WHEREAS IT ",&
+ & "IS NOT IN INITIAL FMFILE",/, &
+ & " Rs WILL BE INITIALIZED TO ZERO")')
+ CGETRST='INIT'
+ELSE
+ IF (LUSERS) THEN
+ CGETRST='READ'
+! IF ( (CCONF=='START').AND. CPROGRAM /= 'DIAG') CGETRST='INIT'
+ ELSE
+ CGETRST='SKIP'
+ END IF
+END IF
+!
+IF (LUSERG.AND. (.NOT.OUSERG)) THEN
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE GRAUPEL VARIABLE Rg WHEREAS ",&
+ & " IT IS NOTIN INITIAL FMFILE",/, &
+ & "Rg WILL BE INITIALIZED TO ZERO")')
+ CGETRGT='INIT'
+ELSE
+ IF (LUSERG) THEN
+ CGETRGT='READ'
+! IF ( (CCONF=='START') .AND. CPROGRAM /= 'DIAG') CGETRGT='INIT'
+ ELSE
+ CGETRGT='SKIP'
+ END IF
+END IF
+!
+IF (LUSERH.AND. (.NOT.OUSERH)) THEN
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE HAIL VARIABLE Rh WHEREAS",&
+ & "IT IS NOT IN INITIAL FMFILE",/, &
+ & " Rh WILL BE INITIALIZED TO ZERO")')
+ CGETRHT='INIT'
+ELSE
+ IF (LUSERH) THEN
+ CGETRHT='READ'
+! IF ( (CCONF=='START') .AND. CPROGRAM /= 'DIAG') CGETRHT='INIT'
+ ELSE
+ CGETRHT='SKIP'
+ END IF
+END IF
+!
+IF (LUSERC.AND. (.NOT.OUSERC)) THEN
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT=*) 'THE CLOUD FRACTION WILL BE INITIALIZED ACCORDING'
+ WRITE(UNIT=ILUOUT,FMT=*) 'TO CLOUD MIXING RATIO VALUE OR SET TO 0'
+ CGETCLDFR = 'INIT'
+ELSE
+ IF ( LUSERC ) THEN
+ CGETCLDFR = 'READ'
+ IF ( (CCONF=='START') .AND. CPROGRAM /= 'DIAG') CGETCLDFR='INIT'
+ ELSE
+ CGETCLDFR = 'SKIP'
+ END IF
+END IF
+!
+IF (LUSERI.AND. (.NOT.OUSERI)) THEN
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT=*) 'THE ICE CLOUD FRACTION WILL BE INITIALIZED ACCORDING'
+ WRITE(UNIT=ILUOUT,FMT=*) 'TO CLOUD MIXING RATIO VALUE OR SET TO 0'
+ CGETICEFR = 'INIT'
+ELSE
+ IF ( LUSERI ) THEN
+ CGETICEFR = 'READ'
+ IF ( (CCONF=='START') .AND. CPROGRAM /= 'DIAG') CGETICEFR='INIT'
+ ELSE
+ CGETICEFR = 'SKIP'
+ END IF
+END IF
+!
+IF(CTURBLEN=='RM17' .OR. CTURBLEN=='HM21') THEN
+ XCEDIS=0.34
+ELSE
+ XCEDIS=0.84
+END IF
+!
+!* 3.3 Moist turbulence
+!
+IF ( LUSERC .AND. CTURB /= 'NONE' ) THEN
+ IF ( .NOT. (OUSERC .AND. HTURB /= 'NONE') ) THEN
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE MOIST TURBULENCE WHEREAS IT ",/, &
+ & " WAS NOT THE CASE FOR THE INITIAL FMFILE GENERATION",/, &
+ & "SRC AND SIGS ARE INITIALIZED TO 0")')
+ CGETSRCT ='INIT'
+ CGETSIGS ='INIT'
+ ELSE
+ CGETSRCT ='READ'
+ IF ( (CCONF=='START') .AND. CPROGRAM /= 'DIAG') CGETSRCT ='INIT'
+ CGETSIGS ='READ'
+ END IF
+ELSE
+ CGETSRCT ='SKIP'
+ CGETSIGS ='SKIP'
+END IF
+!
+IF(NMODEL_CLOUD==KMI .AND. CTURBLEN_CLOUD/='NONE') THEN
+ IF (CTURB=='NONE' .OR. .NOT.LUSERC) THEN
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO COMPUTE A MIXING LENGTH FOR CLOUD=", &
+ & A4,/, &
+ & ", WHEREAS YOU DO NOT SPECIFY A TURBULENCE SCHEME OR ", &
+ & "USE OF RC,",/," CTURBLEN_CLOUD IS SET TO NONE")') &
+ CTURBLEN_CLOUD
+ CTURBLEN_CLOUD='NONE'
+ END IF
+ IF( XCEI_MIN > XCEI_MAX ) THEN
+ WRITE(UNIT=ILUOUT,FMT=9003) KMI
+ WRITE(UNIT=ILUOUT,FMT='("PROBLEM OF CEI LIMITS FOR CLOUD MIXING ",/, &
+ & "LENGTH COMPUTATION: XCEI_MIN=",E9.3,", XCEI_MAX=",E9.3)')&
+ XCEI_MIN,XCEI_MAX
+ !callabortstop
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
+ END IF
+END IF
+!
+IF ( LSIGMAS ) THEN
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE SIGMA_S FROM TURBULENCE SCHEME",/, &
+ & " IN ICE SUBGRID CONDENSATION, SO YOUR SIGMA_S"/, &
+ & " MIGHT BE SMALL ABOVE PBL DEPENDING ON LENGTH SCALE")')
+END IF
+!
+IF (LSUBG_COND .AND. CTURB=='NONE' ) THEN
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(UNIT=ILUOUT,FMT=*) 'YOU WANT TO USE SUBGRID CONDENSATION'
+ WRITE(UNIT=ILUOUT,FMT=*) ' WITHOUT TURBULENCE '
+ WRITE(UNIT=ILUOUT,FMT=*) 'THIS IS NOT ALLOWED: LSUBG_COND is SET to FALSE'
+ LSUBG_COND=.FALSE.
+END IF
+!
+IF (L1D .AND. CTURB/='NONE' .AND. CTURBDIM == '3DIM') THEN
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(UNIT=ILUOUT,FMT=*) 'YOU WANT TO USE 3D TURBULENCE IN 1D CONFIGURATION '
+ WRITE(UNIT=ILUOUT,FMT=*) 'THIS IS NOT POSSIBLE: CTURBDIM IS SET TO 1DIM'
+ CTURBDIM = '1DIM'
+END IF
+!
+!* 3.4 Additional scalar variables
+!
+IF (NSV_USER == KSV_USER) THEN
+ DO JS = 1,KSV_USER ! to read all the variables in initial file
+ CGETSVT(JS)='READ' ! and to initialize them
+! IF(CCONF=='START')CGETSVT(JS)='INIT' ! with these values
+ END DO
+ELSEIF (NSV_USER > KSV_USER) THEN
+ IF (KSV_USER == 0) THEN
+ CGETSVT(1:NSV_USER)='INIT'
+ ELSE
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE MORE ADDITIONAL SCALAR " ,&
+ &" VARIABLES THAN THERE ARE IN INITIAL FMFILE",/, &
+ & "THE SUPPLEMENTARY VARIABLES HAVE BEEN INITIALIZED TO ZERO ")')
+ DO JS = 1,KSV_USER ! to read all the variables in initial file
+ CGETSVT(JS)='READ' ! and to initialize them
+! IF(CCONF=='START')CGETSVT(JS)='INIT' ! with these values
+ END DO
+ DO JS = KSV_USER+1, NSV_USER ! to initialize to zero supplementary
+ CGETSVT(JS)='INIT' ! initial file)
+ END DO
+ END IF
+ELSE
+ WRITE(UNIT=ILUOUT,FMT=9000) KMI
+ WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE LESS ADDITIONAL SCALAR " ,&
+ &" VARIABLES THAN THERE ARE IN INITIAL FMFILE")')
+ DO JS = 1,NSV_USER ! to read the first NSV_USER variables in initial file
+ CGETSVT(JS)='READ' ! and to initialize with these values
+! IF(CCONF=='START') CGETSVT(JS)='INIT'
+ END DO
+ DO JS = NSV_USER + 1, KSV_USER ! to skip the last (KSV_USER-NSV_USER) variables
+ CGETSVT(JS)='SKIP'
+ END DO
+END IF
+!
+! C2R2 and KHKO SV case
+!
+IF (CCLOUD == 'C2R2' .OR. CCLOUD == 'C3R5' .OR. CCLOUD == 'KHKO') THEN
+ IF (HCLOUD == 'C2R2' .OR. HCLOUD == 'C3R5' .OR. HCLOUD == 'KHKO') THEN
+ CGETSVT(NSV_C2R2BEG:NSV_C2R2END)='READ'
+! IF(CCONF=='START') CGETSVT(NSV_C2R2BEG:NSV_C2R2END)='INIT'
+ ELSE
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT='("THERE IS NO SCALAR VARIABLES FOR C2R2 &
+ & (or KHKO) SCHEME IN INITIAL FMFILE",/,&
+ & "THE C2R2 (or KHKO) VARIABLES HAVE BEEN INITIALIZED TO ZERO ")')
+ CGETSVT(NSV_C2R2BEG:NSV_C2R2END)='INIT'
+ END IF
+END IF
+!
+! C3R5 SV case
+!
+IF (CCLOUD == 'C3R5') THEN
+ IF (HCLOUD == 'C3R5') THEN
+ CGETSVT(NSV_C1R3BEG:NSV_C1R3END)='READ'
+! IF(CCONF=='START') CGETSVT(NSV_C1R3BEG:NSV_C1R3END)='INIT'
+ ELSE
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT='("THERE IS NO SCALAR VARIABLES FOR C3R5 &
+ &SCHEME IN INITIAL FMFILE",/,&
+ & "THE C1R3 VARIABLES HAVE BEEN INITIALIZED TO ZERO ")')
+ CGETSVT(NSV_C1R3BEG:NSV_C1R3END)='INIT'
+ END IF
+END IF
+!
+! LIMA SV case
+!
+IF (CCLOUD == 'LIMA') THEN
+ IF (HCLOUD == 'LIMA') THEN
+ CGETSVT(NSV_LIMA_BEG:NSV_LIMA_END)='READ'
+ ELSE
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT='("THERE IS NO SCALAR VARIABLES FOR LIMA &
+ & SCHEME IN INITIAL FMFILE",/,&
+ & "THE LIMA VARIABLES HAVE BEEN INITIALIZED TO ZERO ")')
+ CGETSVT(NSV_LIMA_BEG:NSV_LIMA_END)='INIT'
+ END IF
+END IF
+!
+! Electrical SV case
+!
+IF (CELEC /= 'NONE') THEN
+ IF (HELEC /= 'NONE') THEN
+ CGETSVT(NSV_ELECBEG:NSV_ELECEND)='READ'
+! IF(CCONF=='START') CGETSVT(NSV_ELECBEG:NSV_ELECEND)='INIT'
+ ELSE
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT='("THERE IS NO SCALAR VARIABLES FOR ELECTRICAL &
+ &SCHEME IN INITIAL FMFILE",/,&
+ & "THE ELECTRICAL VARIABLES HAVE BEEN INITIALIZED TO ZERO ")')
+ CGETSVT(NSV_ELECBEG:NSV_ELECEND)='INIT'
+ END IF
+END IF
+!
+! (explicit) LINOx SV case
+!
+IF (CELEC /= 'NONE' .AND. LLNOX_EXPLICIT) THEN
+ IF (HELEC /= 'NONE' .AND. OLNOX_EXPLICIT) THEN
+ CGETSVT(NSV_LNOXBEG:NSV_LNOXEND)='READ'
+ ELSE
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT='("THERE IS NO SCALAR VARIABLES FOR LINOX &
+ & IN INITIAL FMFILE",/,&
+ & "THE LINOX VARIABLES HAVE BEEN INITIALIZED TO ZERO ")')
+ CGETSVT(NSV_LNOXBEG:NSV_LNOXEND)='INIT'
+ END IF
+END IF
+!
+! Chemical SV case (excluding aqueous chemical species)
+!
+IF (LUSECHEM) THEN
+ IF (OUSECHEM) THEN
+ CGETSVT(NSV_CHGSBEG:NSV_CHGSEND)='READ'
+ IF(CCONF=='START' .AND. LCH_INIT_FIELD ) CGETSVT(NSV_CHGSBEG:NSV_CHGSEND)='INIT'
+ ELSE
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT='("THERE IS NO SCALAR VARIABLES FOR CHEMICAL &
+ &SCHEME IN INITIAL FMFILE",/,&
+ & "THE CHEMICAL VARIABLES HAVE BEEN INITIALIZED TO ZERO ")')
+ CGETSVT(NSV_CHGSBEG:NSV_CHGSEND)='INIT'
+ END IF
+END IF
+! add aqueous chemical species
+IF (LUSECHAQ) THEN
+ IF (OUSECHAQ) THEN
+ CGETSVT(NSV_CHACBEG:NSV_CHACEND)='READ'
+! IF(CCONF=='START') CGETSVT(NSV_CHACBEG:NSV_CHACEND)='INIT'
+ ELSE
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT='("THERE IS NO SCALAR VARIABLES FOR CHEMICAL &
+ &SCHEME IN AQUEOUS PHASE IN INITIAL FMFILE",/,&
+ & "THE AQUEOUS PHASE CHEMICAL VARIABLES HAVE BEEN INITIALIZED TO ZERO ")')
+ CGETSVT(NSV_CHACBEG:NSV_CHACEND)='INIT'
+ END IF
+END IF
+! add ice phase chemical species
+IF (LUSECHIC) THEN
+ IF (OUSECHIC) THEN
+ CGETSVT(NSV_CHICBEG:NSV_CHICEND)='READ'
+! IF(CCONF=='START') CGETSVT(NSV_CHICBEG:NSV_CHICEND)='INIT'
+ ELSE
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT='("THERE IS NO SCALAR VARIABLES FOR CHEMICAL &
+ &SPECIES IN ICE PHASE IN INITIAL FMFILE",/,&
+ & "THE ICE PHASE CHEMICAL VARIABLES HAVE BEEN INITIALIZED TO ZERO ")')
+ CGETSVT(NSV_CHICBEG:NSV_CHICEND)='INIT'
+ END IF
+END IF
+! pH values = diagnostics
+IF (LCH_PH .AND. .NOT. OCH_PH) THEN
+ CGETPHC ='INIT' !will be initialized to XCH_PHINIT
+ IF (LUSERR) THEN
+ CGETPHR = 'INIT' !idem
+ ELSE
+ CGETPHR = 'SKIP'
+ ENDIF
+ELSE
+ IF (LCH_PH) THEN
+ CGETPHC ='READ'
+ IF (LUSERR) THEN
+ CGETPHR = 'READ'
+ ELSE
+ CGETPHR = 'SKIP'
+ ENDIF
+ ELSE
+ CGETPHC ='SKIP'
+ CGETPHR ='SKIP'
+ END IF
+END IF
+!
+! Dust case
+!
+IF (LDUST) THEN
+ IF (ODUST) THEN
+ CGETSVT(NSV_DSTBEG:NSV_DSTEND)='READ'
+! IF(CCONF=='START') CGETSVT(NSV_DSTBEG:NSV_DSTEND)='INIT'
+ ELSE
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT='("THERE IS NO SCALAR VARIABLES FOR DUST &
+ &SCHEME IN INITIAL FMFILE",/,&
+ & "THE DUST VARIABLES HAVE BEEN INITIALIZED TO ZERO ")')
+ CGETSVT(NSV_DSTBEG:NSV_DSTEND)='INIT'
+ END IF
+ IF (LDEPOS_DST(KMI)) THEN
+
+ !UPG *PT
+ IF((CCLOUD /= 'ICE3').AND.(CCLOUD /= 'ICE4').AND.(CCLOUD /= 'KESS')&
+ .AND.(CCLOUD /= 'KHKO').AND.(CCLOUD /= 'C2R2').AND.(CCLOUD /= 'LIMA').AND. &
+ (CPROGRAM/='SPAWN').AND.(CPROGRAM/='REAL')) THEN
+ WRITE(UNIT=ILUOUT,FMT=9003) KMI
+ WRITE(UNIT=ILUOUT,FMT='("ERROR: WET DEPOSITION OF DUST IS ONLY CODED FOR THE",/,&
+ & "MICROPHYSICAL SCHEME as ICE3, ICE4, KESS, KHKO, LIMA and C2R2")')
+ !UPG *PT
+ !callabortstop
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
+ END IF
+
+ IF (ODEPOS_DST(KMI) ) THEN
+ CGETSVT(NSV_DSTDEPBEG:NSV_DSTDEPEND)='READ'
+! IF(CCONF=='START') CGETSVT(NSV_DSTDEPBEG:NSV_DSTDEPEND)='INIT'
+ ELSE
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT='("THERE IS NO SCALAR VARIABLES FOR RAIN and CLOUD DUST &
+ & SCHEME IN INITIAL FMFILE",/,&
+ & "THE MOIST DUST VARIABLES HAVE BEEN INITIALIZED TO ZERO ")')
+ CGETSVT(NSV_DSTDEPBEG:NSV_DSTDEPEND)='INIT'
+ END IF
+ END IF
+
+ IF(NMODE_DST.GT.3 .OR. NMODE_DST.LT.1) THEN
+ WRITE(UNIT=ILUOUT,FMT=9003) KMI
+ WRITE(UNIT=ILUOUT,FMT='("DUST MODES MUST BE BETWEEN 1 and 3 ")')
+ !callabortstop
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
+ END IF
+END IF
+!
+! Sea Salt case
+!
+IF (LSALT) THEN
+ IF (OSALT) THEN
+ CGETSVT(NSV_SLTBEG:NSV_SLTEND)='READ'
+ CGETZWS='READ'
+! IF(CCONF=='START') CGETSVT(NSV_SLTBEG:NSV_SLTEND)='INIT'
+ ELSE
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT='("THERE IS NO SCALAR VARIABLES FOR SALT &
+ &SCHEME IN INITIAL FMFILE",/,&
+ & "THE SALT VARIABLES HAVE BEEN INITIALIZED TO ZERO ")')
+ CGETSVT(NSV_SLTBEG:NSV_SLTEND)='INIT'
+ CGETZWS='INIT'
+ END IF
+ IF (LDEPOS_SLT(KMI)) THEN
+
+ !UPG*PT
+ IF((CCLOUD /= 'ICE3').AND.(CCLOUD /= 'ICE4').AND.(CCLOUD /= 'KESS')&
+ !.AND.(CCLOUD /= 'KHKO').AND.(CCLOUD /= 'C2R2').AND. &
+ .AND.(CCLOUD /= 'KHKO').AND.(CCLOUD /= 'C2R2').AND.(CCLOUD /= 'LIMA').AND. &
+ (CPROGRAM/='SPAWN').AND.(CPROGRAM/='REAL')) THEN
+ WRITE(UNIT=ILUOUT,FMT=9003) KMI
+ WRITE(UNIT=ILUOUT,FMT='("ERROR: WET DEPOSITION OF SEA SALT AEROSOLS IS ONLY CODED FOR THE",/,&
+ & "MICROPHYSICAL SCHEME as ICE3, ICE4, KESS, KHKO, LIMA and C2R2")')
+ !UPG*PT
+ !callabortstop
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
+ END IF
+
+ IF (ODEPOS_SLT(KMI) ) THEN
+ CGETSVT(NSV_SLTDEPBEG:NSV_SLTDEPEND)='READ'
+! IF(CCONF=='START') CGETSVT(NSV_SLTDEPBEG:NSV_SLTDEPEND)='INIT'
+ ELSE
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT='("THERE IS NO SCALAR VARIABLES FOR RAIN and CLOUD SEA SALT &
+ & SCHEME IN INITIAL FMFILE",/,&
+ & "THE MOIST SEA SALT VARIABLES HAVE BEEN INITIALIZED TO ZERO ")')
+ CGETSVT(NSV_SLTDEPBEG:NSV_SLTDEPEND)='INIT'
+ END IF
+ END IF
+ IF(NMODE_SLT.GT.8 .OR. NMODE_SLT.LT.1) THEN
+ WRITE(UNIT=ILUOUT,FMT=9003) KMI
+ WRITE(UNIT=ILUOUT,FMT='("SALT MODES MUST BE BETWEEN 1 and 8 ")')
+ !callabortstop
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
+ END IF
+END IF
+!
+! Orilam SV case
+!
+IF (LORILAM) THEN
+ IF (OORILAM) THEN
+ CGETSVT(NSV_AERBEG:NSV_AEREND)='READ'
+! IF(CCONF=='START') CGETSVT(NSV_AERBEG:NSV_AEREND)='INIT'
+ ELSE
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT='("THERE IS NO SCALAR VARIABLES FOR AEROSOL &
+ &SCHEME IN INITIAL FMFILE",/,&
+ & "THE AEROSOLS VARIABLES HAVE BEEN INITIALIZED TO ZERO ")')
+ CGETSVT(NSV_AERBEG:NSV_AEREND)='INIT'
+ END IF
+ IF (LDEPOS_AER(KMI)) THEN
+
+ !UPG*PT
+ IF((CCLOUD /= 'ICE3').AND.(CCLOUD /= 'ICE4').AND.(CCLOUD /= 'KESS')&
+ .AND.(CCLOUD /= 'KHKO').AND.(CCLOUD /= 'C2R2').AND.(CCLOUD /= 'LIMA').AND. &
+ !.AND.(CCLOUD /= 'KHKO').AND.(CCLOUD /= 'C2R2').AND. &
+ (CPROGRAM/='SPAWN').AND.(CPROGRAM/='REAL')) THEN
+ WRITE(UNIT=ILUOUT,FMT=9003) KMI
+ WRITE(UNIT=ILUOUT,FMT='("ERROR: WET DEPOSITION OF ORILAM AEROSOLS IS ONLY CODED FOR THE",/,&
+ & "MICROPHYSICAL SCHEME as ICE3, ICE4, KESS, KHKO, LIMA and C2R2")')
+ !UPG*PT
+ !callabortstop
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
+ END IF
+
+ IF (ODEPOS_AER(KMI) ) THEN
+ CGETSVT(NSV_AERDEPBEG:NSV_AERDEPEND)='READ'
+! IF(CCONF=='START') CGETSVT(NSV_AERDEPBEG:NSV_AERDEPEND)='INIT'
+ ELSE
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT='("THERE IS NO SCALAR VARIABLES FOR RAIN and IN CLOUD &
+ & AEROSOL SCHEME IN INITIAL FMFILE",/,&
+ & "THE MOIST AEROSOL VARIABLES HAVE BEEN INITIALIZED TO ZERO ")')
+ CGETSVT(NSV_AERDEPBEG:NSV_AERDEPEND)='INIT'
+ END IF
+ END IF
+END IF
+!
+! Lagrangian variables
+!
+IF (LINIT_LG .AND. .NOT.(LLG)) THEN
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT='("IT IS INCOHERENT TO HAVE LINIT_LG=.T. AND LLG=.F.",/,&
+ & "IF YOU WANT LAGRANGIAN TRACERS CHANGE LLG TO .T. ")')
+ENDIF
+IF (LLG) THEN
+ IF (OLG .AND. .NOT.(LINIT_LG .AND. CPROGRAM=='MESONH')) THEN
+ CGETSVT(NSV_LGBEG:NSV_LGEND)='READ'
+! IF(CCONF=='START') CGETSVT(NSV_LGBEG:NSV_LGEND)='INIT'
+ ELSE
+ IF(.NOT.(LINIT_LG) .AND. CPROGRAM=='MESONH') THEN
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT='("THERE IS NO LAGRANGIAN VARIABLES IN INITIAL FMFILE",/,&
+ & "THE LAGRANGIAN VARIABLES HAVE BEEN REINITIALIZED")')
+ LINIT_LG=.TRUE.
+ ENDIF
+ CGETSVT(NSV_LGBEG:NSV_LGEND)='INIT'
+ END IF
+END IF
+!
+!
+! LINOx SV case
+!
+IF (.NOT.LUSECHEM .AND. LCH_CONV_LINOX) THEN
+ IF (.NOT.OUSECHEM .AND. OCH_CONV_LINOX) THEN
+ CGETSVT(NSV_LNOXBEG:NSV_LNOXEND)='READ'
+ ELSE
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(UNIT=ILUOUT,FMT='("THERE IS NO SCALAR VARIABLES FOR LINOX &
+ &IN INITIAL FMFILE",/,&
+ & "THE LINOX VARIABLES HAVE BEEN INITIALIZED TO ZERO ")')
+ CGETSVT(NSV_LNOXBEG:NSV_LNOXEND)='INIT'
+ END IF
+END IF
+!
+! Passive pollutant case
+!
+IF (LPASPOL) THEN
+ IF (OPASPOL) THEN
+ CGETSVT(NSV_PPBEG:NSV_PPEND)='READ'
+! IF(CCONF=='START') CGETSVT(NSV_PPBEG:NSV_PPEND)='INIT'
+ ELSE
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT='("THERE IS NO PASSIVE SCALAR VARIABLES IN INITIAL FMFILE",/,&
+ & "THE VARIABLES HAVE BEEN INITIALIZED TO ZERO")')
+ CGETSVT(NSV_PPBEG:NSV_PPEND)='INIT'
+ END IF
+END IF
+!
+#ifdef MNH_FOREFIRE
+! ForeFire
+!
+IF (LFOREFIRE) THEN
+ IF (OFOREFIRE) THEN
+ CGETSVT(NSV_FFBEG:NSV_FFEND)='READ'
+ ELSE
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT='("THERE IS NO FOREFIRE SCALAR VARIABLES IN INITIAL FMFILE",/,&
+ & "THE VARIABLES HAVE BEEN INITIALIZED TO ZERO")')
+ CGETSVT(NSV_FFBEG:NSV_FFEND)='INIT'
+ END IF
+END IF
+#endif
+! Blaze smoke
+!
+IF (LBLAZE) THEN
+ IF (OFIRE) THEN
+ CGETSVT(NSV_FIREBEG:NSV_FIREEND)='READ'
+ ELSE
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT='("THERE IS NO BLAZE SCALAR VARIABLES IN INITIAL FMFILE",/,&
+ & "THE VARIABLES HAVE BEEN INITIALIZED TO ZERO")')
+ CGETSVT(NSV_FIREBEG:NSV_FIREEND)='INIT'
+ END IF
+END IF
+!
+! Conditional sampling case
+!
+IF (LCONDSAMP) THEN
+ IF (OCONDSAMP) THEN
+ CGETSVT(NSV_CSBEG:NSV_CSEND)='READ'
+! IF(CCONF=='START') CGETSVT(NSV_CSBEG:NSV_CSEND)='INIT'
+ ELSE
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT='("THERE IS NO PASSIVE SCALAR VARIABLES IN INITIAL FMFILE",/,&
+ & "THE VARIABLES HAVE BEEN INITIALIZED TO ZERO")')
+ CGETSVT(NSV_CSBEG:NSV_CSEND)='INIT'
+ END IF
+END IF
+!
+! Blowing snow scheme
+!
+IF (LBLOWSNOW) THEN
+ IF (OBLOWSNOW) THEN
+ CGETSVT(NSV_SNWBEG:NSV_SNWEND)='READ'
+ ELSE
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT='("THERE IS NO SCALAR VARIABLES FOR BLOWING SNOW &
+ &SCHEME IN INITIAL FMFILE",/,&
+ & "THE BLOWING SNOW VARIABLES HAVE BEEN INITIALIZED TO ZERO ")')
+ CGETSVT(NSV_SNWBEG:NSV_SNWEND)='INIT'
+ END IF
+END IF
+!
+!
+!
+!* 3.5 Check coherence between the radiation control parameters
+!
+IF( CRAD == 'ECMW' .AND. CPROGRAM=='MESONH' ) THEN
+ IF(CLW == 'RRTM' .AND. COPILW == 'SMSH') THEN
+ WRITE(UNIT=ILUOUT,FMT=9003) KMI
+ WRITE(UNIT=ILUOUT,FMT=*) 'the SMSH parametrisation of LW optical properties for cloud ice'
+ WRITE(UNIT=ILUOUT,FMT=*) '(COPILW) can not be used with RRTM radiation scheme'
+ !callabortstop
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
+ ENDIF
+ IF(CLW == 'MORC' .AND. COPWLW == 'LILI') THEN
+ WRITE(UNIT=ILUOUT,FMT=9003) KMI
+ WRITE(UNIT=ILUOUT,FMT=*) 'the LILI parametrisation of LW optical properties for cloud water'
+ WRITE(UNIT=ILUOUT,FMT=*) '(COPWLW) can not be used with MORC radiation scheme'
+ !callabortstop
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
+ ENDIF
+ IF( .NOT. LSUBG_COND) THEN
+ WRITE(UNIT=ILUOUT,FMT=9000) KMI
+ WRITE(UNIT=ILUOUT,FMT=*) 'YOU DO NOT WANT TO USE SUBGRID CONDENSATION'
+ WRITE(UNIT=ILUOUT,FMT=*) 'THE OVERLAP OPTION IS NOVLP=5 IN ini_radconf.f90'
+ ELSE IF (CLW == 'MORC') THEN
+ WRITE(UNIT=ILUOUT,FMT=9000) KMI
+ WRITE(UNIT=ILUOUT,FMT=*) 'YOU WANT TO USE MORCRETTE LW SCHEME'
+ WRITE(UNIT=ILUOUT,FMT=*) 'THE OVERLAP OPTION IS NOVLP=5 IN ini_radconf.f90'
+ ELSE
+ WRITE(UNIT=ILUOUT,FMT=9000) KMI
+ WRITE(UNIT=ILUOUT,FMT=*) 'THE OVERLAP OPTION IS NOVLP=6 IN ini_radconf.f90'
+ ENDIF
+!
+ IF( LCLEAR_SKY .AND. XDTRAD_CLONLY /= XDTRAD) THEN
+ ! Check the validity of the LCLEAR_SKY approximation
+ WRITE(UNIT=ILUOUT,FMT=9003) KMI
+ WRITE(UNIT=ILUOUT,FMT=*) 'YOU WANT TO USE BOTH THE CLEAR-SKY APPROXIMATION'
+ WRITE(UNIT=ILUOUT,FMT=*) '(i.e. AVERAGE THE WHOLE CLOUDFREE VERTICALS BUT KEEP'
+ WRITE(UNIT=ILUOUT,FMT=*) 'ALL THE CLOUDY VERTICALS) AND'
+ WRITE(UNIT=ILUOUT,FMT=*) 'THE CLOUD-ONLY APPROXIMATION (i.e. YOU CALL MORE OFTEN THE'
+ WRITE(UNIT=ILUOUT,FMT=*) 'RADIATIONS FOR THE CLOUDY VERTICALS THAN FOR CLOUDFREE ONES).'
+ WRITE(UNIT=ILUOUT,FMT=*) 'THIS IS NOT POSSIBLE, SO CHOOSE BETWEEN :'
+ WRITE(UNIT=ILUOUT,FMT=*) 'XDTRAD_CLONLY = XDTRAD and LCLEAR_SKY = FALSE'
+!
+ !callabortstop
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
+ END IF
+!
+ IF( XDTRAD_CLONLY > XDTRAD ) THEN
+ WRITE(UNIT=ILUOUT,FMT=9003) KMI
+ WRITE(UNIT=ILUOUT,FMT='("BAD USE OF THE CLOUD-ONLY APPROXIMATION " ,&
+ &" XDTRAD SHOULD BE LARGER THAN XDTRAD_CLONLY ")')
+!
+ !callabortstop
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
+ END IF
+!
+ IF(( XDTRAD < XTSTEP ).OR. ( XDTRAD_CLONLY < XTSTEP )) THEN
+ WRITE(UNIT=ILUOUT,FMT=9003) KMI
+ WRITE(UNIT=ILUOUT,FMT='("THE RADIATION CALL XDTRAD OR XDTRAD_CLONLY " ,&
+ &" IS MORE FREQUENT THAN THE TIME STEP SO ADJUST XDTRAD OR XDTRAD_CLONLY ")')
+!
+ !callabortstop
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
+ END IF
+END IF
+!
+IF ( CRAD /= 'NONE' .AND. CPROGRAM=='MESONH' ) THEN
+ CGETRAD='READ'
+ IF( HRAD == 'NONE' .AND. CCONF=='RESTA') THEN
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT=*) 'YOU ARE PERFORMING A RESTART. FOR THIS SEGMENT, YOU ARE USING A RADIATION'
+ WRITE(UNIT=ILUOUT,FMT=*) 'SCHEME AND NO RADIATION SCHEME WAS USED FOR THE PREVIOUS SEGMENT.'
+ CGETRAD='INIT'
+ END IF
+ IF(CCONF=='START') THEN
+ CGETRAD='INIT'
+ END IF
+ IF(CCONF=='RESTA' .AND. (.NOT. LAERO_FT) .AND. (.NOT. LORILAM) &
+ .AND. (.NOT. LSALT) .AND. (.NOT. LDUST)) THEN
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT=*) '!!! WARNING !!! FOR REPRODUCTIBILITY BETWEEN START and START+RESTART,'
+ WRITE(UNIT=ILUOUT,FMT=*) 'YOU MUST USE LAERO_FT=T WITH CAER=TEGE IF CCONF=RESTA IN ALL SEGMENTS'
+ WRITE(UNIT=ILUOUT,FMT=*) 'TO UPDATE THE OZONE AND AEROSOLS CLIMATOLOGY USED BY THE RADIATION CODE;'
+ END IF
+END IF
+!
+! 3.6 check the initialization of the deep convection scheme
+!
+IF ( (CDCONV /= 'KAFR') .AND. &
+ (CSCONV /= 'KAFR') .AND. LCHTRANS ) THEN
+ WRITE(UNIT=ILUOUT,FMT=9003) KMI
+ WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE THE LCHTRANS OPTION= ",&
+ &"CONVECTIVE TRANSPORT OF TRACERS BUT IT CAN ONLY",&
+ &"BE USED FOR THE KAIN FRITSCH SCHEME ")')
+ !callabortstop
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
+END IF
+!
+SELECT CASE ( CDCONV )
+ CASE( 'KAFR' )
+ IF (.NOT. ( LUSERV ) ) THEN
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE THE KAIN-FRITSCH DEEP CONV. ",&
+ &" SCHEME. YOU MUST HAVE VAPOR ",/,"LUSERV IS SET TO TRUE ")')
+ LUSERV=.TRUE.
+ ELSE IF (.NOT. ( LUSERI ) ) THEN
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE THE KAIN-FRITSCH",&
+ &" DEEP CONV. SCHEME. BUT THE DETRAINED CLOUD ICE WILL BE ADDED TO ",&
+ &" THE CLOUD WATER ")')
+ ELSE IF (.NOT. ( LUSERI.AND.LUSERC ) ) THEN
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE THE KAIN-FRITSCH",&
+ &" DEEP CONV. SCHEME. BUT THE DETRAINED CLOUD WATER AND CLOUD ICE ",&
+ &" WILL BE ADDED TO THE WATER VAPOR FIELD ")')
+ END IF
+ IF ( LCHTRANS .AND. NSV == 0 ) THEN
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE THE LCHTRANS OPTION= ",&
+ &"CONVECTIVE TRANSPORT OF TRACERS BUT YOUR TRACER ",&
+ &"NUMBER NSV IS ZERO ",/,"LCHTRANS IS SET TO FALSE")')
+ LCHTRANS=.FALSE.
+ END IF
+END SELECT
+!
+IF ( CDCONV == 'KAFR' .AND. LCHTRANS .AND. NSV > 0 ) THEN
+ IF( OCHTRANS ) THEN
+ CGETSVCONV='READ'
+ ELSE
+ CGETSVCONV='INIT'
+ END IF
+END IF
+!
+SELECT CASE ( CSCONV )
+ CASE( 'KAFR' )
+ IF (.NOT. ( LUSERV ) ) THEN
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE THE KAIN-FRITSCH SHALLOW CONV. ",&
+ &" SCHEME. YOU MUST HAVE VAPOR ",/,"LUSERV IS SET TO TRUE ")')
+ LUSERV=.TRUE.
+ ELSE IF (.NOT. ( LUSERI ) ) THEN
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE THE KAIN-FRITSCH",&
+ &" SHALLOW CONV. SCHEME. BUT THE DETRAINED CLOUD ICE WILL BE ADDED TO ",&
+ &" THE CLOUD WATER ")')
+ ELSE IF (.NOT. ( LUSERI.AND.LUSERC ) ) THEN
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE THE KAIN-FRITSCH",&
+ &" SHALLOW CONV. SCHEME. BUT THE DETRAINED CLOUD WATER AND CLOUD ICE ",&
+ &" WILL BE ADDED TO THE WATER VAPOR FIELD ")')
+ END IF
+ IF ( LCHTRANS .AND. NSV == 0 ) THEN
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE THE LCHTRANS OPTION= ",&
+ &"CONVECTIVE TRANSPORT OF TRACERS BUT YOUR TRACER ",&
+ &"NUMBER NSV IS ZERO ",/,"LCHTRANS IS SET TO FALSE")')
+ LCHTRANS=.FALSE.
+ END IF
+ CASE( 'EDKF' )
+ IF (CTURB == 'NONE' ) THEN
+ WRITE(UNIT=ILUOUT,FMT=9003) KMI
+ WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE THE EDKF ", &
+ &"SHALLOW CONVECTION WITHOUT TURBULENCE SCHEME : ", &
+ &"IT IS NOT POSSIBLE")')
+!
+ !callabortstop
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
+ END IF
+END SELECT
+!
+!
+CGETCONV = 'SKIP'
+!
+IF ( (CDCONV /= 'NONE' .OR. CSCONV == 'KAFR' ) .AND. CPROGRAM=='MESONH') THEN
+ CGETCONV = 'READ'
+ IF( HDCONV == 'NONE' .AND. CCONF=='RESTA') THEN
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT='(" YOU ARE PERFORMING A RESTART. FOR THIS ",&
+ &" SEGMENT, YOU ARE USING A DEEP CONVECTION SCHEME AND NO DEEP ",&
+ &" CONVECTION SCHEME WAS USED FOR THE PREVIOUS SEGMENT. ")')
+!
+ CGETCONV = 'INIT'
+ END IF
+ IF(CCONF=='START') THEN
+ CGETCONV = 'INIT'
+ END IF
+END IF
+!
+!* 3.7 configuration and model version
+!
+IF (KMI == 1) THEN
+!
+ IF (L1D.AND.(CLBCX(1)/='CYCL'.AND.CLBCX(2)/='CYCL' &
+ .AND.CLBCY(1)/='CYCL'.AND.CLBCY(2)/='CYCL')) THEN
+ WRITE(UNIT=ILUOUT,FMT=9003) KMI
+ WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE A 1D MODEL VERSION WITH NON-CYCL",&
+ & "CLBCX OR CLBCY VALUES")')
+ !callabortstop
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
+ END IF
+ IF (L2D.AND.(CLBCY(1)/='CYCL'.AND.CLBCY(2)/='CYCL')) THEN
+ WRITE(UNIT=ILUOUT,FMT=9003) KMI
+ WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE A 2D MODEL VERSION WITH NON-CYCL",&
+ & " CLBCY VALUES")')
+ !callabortstop
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
+ END IF
+ !
+ IF ( (.NOT. LCARTESIAN) .AND. ( LCORIO) .AND. (.NOT. LGEOST_UV_FRC) ) THEN
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(UNIT=ILUOUT,FMT='("BE CAREFUL YOU COULD HAVE SPURIOUS MOTIONS " ,&
+ & " NEAR THE LBC AS LCORIO=T and LGEOST_UV_FRC=F")')
+ END IF
+ !
+ IF ((.NOT.LFLAT).AND.OFLAT) THEN
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(UNIT=ILUOUT,FMT=*) 'ZERO OROGRAPHY IN INITIAL FILE'
+ WRITE(UNIT=ILUOUT,FMT=*) '***** ALL TERMS HAVE BEEN NEVERTHELESS COMPUTED WITHOUT SIMPLIFICATION*****'
+ WRITE(UNIT=ILUOUT,FMT=*) 'THIS SHOULD LEAD TO ERRORS IN THE PRESSURE COMPUTATION'
+ END IF
+ IF (LFLAT.AND.(.NOT.OFLAT)) THEN
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(UNIT=ILUOUT,FMT='(" OROGRAPHY IS NOT EQUAL TO ZERO ", &
+ & "IN INITIAL FILE" ,/, &
+ & "******* OROGRAPHY HAS BEEN SET TO ZERO *********",/, &
+ & "ACCORDING TO ZERO OROGRAPHY, SIMPLIFICATIONS HAVE ", &
+ & "BEEN MADE IN COMPUTATIONS")')
+ END IF
+END IF
+!
+!* 3.8 System of equations
+!
+IF ( HEQNSYS /= CEQNSYS ) THEN
+ WRITE(UNIT=ILUOUT,FMT=9003) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU HAVE CHANGED THE SYSTEM OF EQUATIONS'
+ WRITE(ILUOUT,FMT=*) 'THE ANELASTIC CONSTRAINT IS PERHAPS CHANGED :'
+ WRITE(ILUOUT,FMT=*) 'FOR THE INITIAL FILE YOU HAVE USED ',HEQNSYS
+ WRITE(ILUOUT,FMT=*) 'FOR THE RUN YOU PLAN TO USE ',CEQNSYS
+ WRITE(ILUOUT,FMT=*) 'THIS CAN LEAD TO A NUMERICAL EXPLOSION IN THE FIRST TIME STEPS'
+ !callabortstop
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
+END IF
+!
+! 3.9 Numerical schemes
+!
+IF ( (CUVW_ADV_SCHEME == 'CEN4TH') .AND. &
+ (CTEMP_SCHEME /= 'LEFR') .AND. (CTEMP_SCHEME /= 'RKC4') ) THEN
+ WRITE(UNIT=ILUOUT,FMT=9003) KMI
+ WRITE(UNIT=ILUOUT,FMT='("CEN4TH SCHEME HAS TO BE USED WITH ",&
+ &"CTEMP_SCHEME = LEFR of RKC4 ONLY")')
+ !callabortstop
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
+END IF
+!
+IF ( (CUVW_ADV_SCHEME == 'WENO_K') .AND. LNUMDIFU ) THEN
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE NUMERICAL DIFFUSION ",&
+ &"WITH WENO SCHEME ALREADY DIFFUSIVE")')
+END IF
+!-------------------------------------------------------------------------------
+!
+!* 4. CHECK COHERENCE BETWEEN EXSEG VARIABLES
+! ---------------------------------------
+!
+!* 4.1 coherence between coupling variables in EXSEG file
+!
+IF (KMI == 1) THEN
+ NCPL_NBR = 0
+ DO JCI = 1,JPCPLFILEMAX
+ IF (LEN_TRIM(CCPLFILE(JCI)) /= 0) THEN ! Finds the number
+ NCPL_NBR = NCPL_NBR + 1 ! of coupling files
+ ENDIF
+ IF (JCI/=JPCPLFILEMAX) THEN ! Deplaces the coupling files
+ IF ((LEN_TRIM(CCPLFILE(JCI)) == 0) .AND. &! names if one missing
+ (LEN_TRIM(CCPLFILE(JCI+1)) /= 0)) THEN
+ DO JI=JCI,JPCPLFILEMAX-1
+ CCPLFILE(JI)=CCPLFILE(JI+1)
+ END DO
+ CCPLFILE(JPCPLFILEMAX)=' '
+ END IF
+ END IF
+ END DO
+!
+ IF (NCPL_NBR /= 0) THEN
+ LSTEADYLS = .FALSE.
+ ELSE
+ LSTEADYLS = .TRUE.
+ ENDIF
+END IF
+!
+!* 4.3 check consistency in forcing switches
+!
+IF ( LFORCING ) THEN
+ IF ( LRELAX_THRV_FRC .AND. ( LTEND_THRV_FRC .OR. LGEOST_TH_FRC ) ) THEN
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU CHOSE A TEMPERATURE AND HUMIDITY RELAXATION'
+ WRITE(ILUOUT,FMT=*) 'TOGETHER WITH TENDENCY OR GEOSTROPHIC FORCING'
+ WRITE(ILUOUT,FMT=*) &
+ 'YOU MIGHT CHECK YOUR SWITCHES: LRELAX_THRV_FRC, LTEND_THRV_FRC, AND'
+ WRITE(ILUOUT,FMT=*) 'LGEOST_TH_FRC'
+ END IF
+!
+ IF ( LRELAX_UV_FRC .AND. LRELAX_UVMEAN_FRC) THEN
+ WRITE(UNIT=ILUOUT,FMT=9003) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU MUST CHOOSE BETWEEN A RELAXATION APPLIED TO'
+ WRITE(ILUOUT,FMT=*) 'THE 3D FULL WIND FIELD (LRELAX_UV_FRC) OR'
+ WRITE(ILUOUT,FMT=*) 'THE HORIZONTAL MEAN WIND (LRELAX_UVMEAN_FRC)'
+ !callabortstop
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
+ END IF
+!
+ IF ( (LRELAX_UV_FRC .OR. LRELAX_UVMEAN_FRC) .AND. LGEOST_UV_FRC ) THEN
+ WRITE(UNIT=ILUOUT,FMT=9003) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU MUST NOT USE A WIND RELAXATION'
+ WRITE(ILUOUT,FMT=*) 'TOGETHER WITH A GEOSTROPHIC FORCING'
+ WRITE(ILUOUT,FMT=*) 'CHECK SWITCHES: LRELAX_UV_FRC, LRELAX_UVMEAN_FRC, LGEOST_UV_FRC'
+ !callabortstop
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
+ END IF
+!
+ IF ( CRELAX_HEIGHT_TYPE.NE."FIXE" .AND. CRELAX_HEIGHT_TYPE.NE."THGR" ) THEN
+ WRITE(UNIT=ILUOUT,FMT=9003) KMI
+ WRITE(ILUOUT,FMT=*) 'CRELAX_HEIGHT_TYPE MUST BE EITHER "FIXE" OR "THGR"'
+ WRITE(ILUOUT,FMT=*) 'BUT IT IS "', CRELAX_HEIGHT_TYPE, '"'
+ !callabortstop
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
+ END IF
+!
+ IF ( .NOT.LCORIO .AND. LGEOST_UV_FRC ) THEN
+ WRITE(UNIT=ILUOUT,FMT=9003) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU CANNOT HAVE A GEOSTROPHIC FORCING WITHOUT'
+ WRITE(ILUOUT,FMT=*) 'ACTIVATING LCORIOLIS OPTION'
+ !callabortstop
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
+ END IF
+!
+ IF ( LPGROUND_FRC ) THEN
+ WRITE(ILUOUT,FMT=*) 'SURFACE PRESSURE FORCING NOT YET IMPLEMENTED'
+ !callabortstop
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
+ END IF
+!
+END IF
+!
+IF (LTRANS .AND. .NOT. LFLAT ) THEN
+ WRITE(UNIT=ILUOUT,FMT=9003) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU ASK FOR A CONSTANT SPEED DOMAIN TRANSLATION '
+ WRITE(ILUOUT,FMT=*) 'BUT NOT IN THE FLAT TERRAIN CASE:'
+ WRITE(ILUOUT,FMT=*) 'THIS IS NOT ALLOWED ACTUALLY'
+ !callabortstop
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
+END IF
+!
+!* 4.4 Check the coherence between the LUSERn and LHORELAX
+!
+IF (.NOT. LUSERV .AND. LHORELAX_RV) THEN
+ LHORELAX_RV=.FALSE.
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX RV FIELD BUT IT DOES NOT EXIST.'
+ WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_RV=FALSE'
+END IF
+!
+IF (.NOT. LUSERC .AND. LHORELAX_RC) THEN
+ LHORELAX_RC=.FALSE.
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX RC FIELD BUT IT DOES NOT EXIST.'
+ WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_RC=FALSE'
+END IF
+!
+IF (.NOT. LUSERR .AND. LHORELAX_RR) THEN
+ LHORELAX_RR=.FALSE.
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX RR FIELD BUT IT DOES NOT EXIST.'
+ WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_RR=FALSE'
+END IF
+!
+IF (.NOT. LUSERI .AND. LHORELAX_RI) THEN
+ LHORELAX_RI=.FALSE.
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX RI FIELD BUT IT DOES NOT EXIST.'
+ WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_RI=FALSE'
+END IF
+!
+IF (.NOT. LUSERS .AND. LHORELAX_RS) THEN
+ LHORELAX_RS=.FALSE.
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX RS FIELD BUT IT DOES NOT EXIST.'
+ WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_RS=FALSE'
+END IF
+!
+IF (.NOT. LUSERG .AND. LHORELAX_RG) THEN
+ LHORELAX_RG=.FALSE.
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX RG FIELD BUT IT DOES NOT EXIST.'
+ WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_RG=FALSE'
+END IF
+!
+IF (.NOT. LUSERH .AND. LHORELAX_RH) THEN
+ LHORELAX_RH=.FALSE.
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX RH FIELD BUT IT DOES NOT EXIST.'
+ WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_RH=FALSE'
+END IF
+!
+IF (CTURB=='NONE' .AND. LHORELAX_TKE) THEN
+ LHORELAX_TKE=.FALSE.
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX TKE FIELD BUT IT DOES NOT EXIST.'
+ WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_TKE=FALSE'
+END IF
+!
+!
+IF (CCLOUD/='C2R2' .AND. CCLOUD/='KHKO' .AND. LHORELAX_SVC2R2) THEN
+ LHORELAX_SVC2R2=.FALSE.
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX C2R2 or KHKO FIELD BUT IT DOES NOT EXIST.'
+ WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_SVC2R2=FALSE'
+END IF
+!
+IF (CCLOUD/='C3R5' .AND. LHORELAX_SVC1R3) THEN
+ LHORELAX_SVC1R3=.FALSE.
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX C3R5 FIELD BUT IT DOES NOT EXIST.'
+ WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_SVC1R3=FALSE'
+END IF
+!
+IF (CCLOUD/='LIMA' .AND. LHORELAX_SVLIMA) THEN
+ LHORELAX_SVLIMA=.FALSE.
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX LIMA FIELD BUT IT DOES NOT EXIST.'
+ WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_SVLIMA=FALSE'
+END IF
+!
+IF (CELEC(1:3) /= 'ELE' .AND. LHORELAX_SVELEC) THEN
+ LHORELAX_SVELEC=.FALSE.
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX ELEC FIELD BUT IT DOES NOT EXIST.'
+ WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_SVELEC=FALSE'
+END IF
+!
+IF (.NOT. LUSECHEM .AND. LHORELAX_SVCHEM) THEN
+ LHORELAX_SVCHEM=.FALSE.
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX CHEM FIELD BUT IT DOES NOT EXIST.'
+ WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_SVCHEM=FALSE'
+END IF
+!
+IF (.NOT. LUSECHIC .AND. LHORELAX_SVCHIC) THEN
+ LHORELAX_SVCHIC=.FALSE.
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX ICE CHEM FIELD BUT IT DOES NOT EXIST.'
+ WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_SVCHIC=FALSE'
+END IF
+!
+IF (.NOT. LORILAM .AND. LHORELAX_SVAER) THEN
+ LHORELAX_SVAER=.FALSE.
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX AEROSOL FIELD BUT IT DOES NOT EXIST.'
+ WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_SVAER=FALSE'
+END IF
+
+IF (.NOT. LDUST .AND. LHORELAX_SVDST) THEN
+ LHORELAX_SVDST=.FALSE.
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX DUST FIELD BUT IT DOES NOT EXIST.'
+ WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_SVDST=FALSE'
+END IF
+
+IF (.NOT. LSALT .AND. LHORELAX_SVSLT) THEN
+ LHORELAX_SVSLT=.FALSE.
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX SEA SALT FIELD BUT IT DOES NOT EXIST.'
+ WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_SVSLT=FALSE'
+END IF
+
+IF (.NOT. LPASPOL .AND. LHORELAX_SVPP) THEN
+ LHORELAX_SVPP=.FALSE.
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX PASSIVE POLLUTANT FIELD BUT IT DOES NOT EXIST.'
+ WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_SVPP=FALSE'
+END IF
+#ifdef MNH_FOREFIRE
+IF (.NOT. LFOREFIRE .AND. LHORELAX_SVFF) THEN
+ LHORELAX_SVFF=.FALSE.
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX FOREFIRE FLUXES BUT THEY DO NOT EXIST.'
+ WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_SVFF=FALSE'
+END IF
+#endif
+IF (.NOT. LBLAZE .AND. LHORELAX_SVFIRE) THEN
+ LHORELAX_SVFIRE=.FALSE.
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX BLAZE FLUXES BUT THEY DO NOT EXIST.'
+ WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_SVFIRE=FALSE'
+END IF
+IF (.NOT. LCONDSAMP .AND. LHORELAX_SVCS) THEN
+ LHORELAX_SVCS=.FALSE.
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX CONDITIONAL SAMPLING FIELD BUT IT DOES NOT EXIST.'
+ WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_SVCS=FALSE'
+END IF
+
+IF (.NOT. LBLOWSNOW .AND. LHORELAX_SVSNW) THEN
+ LHORELAX_SVSNW=.FALSE.
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX BLOWING SNOW FIELD BUT IT DOES NOT EXIST.'
+ WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_SVSNW=FALSE'
+END IF
+
+IF (ANY(LHORELAX_SV(NSV+1:))) THEN
+ LHORELAX_SV(NSV+1:)=.FALSE.
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX SV(NSV+1:) FIELD BUT IT DOES NOT EXIST.'
+ WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_SV(NSV+1:)=FALSE'
+END IF
+!
+!* 4.5 check the number of points for the horizontal relaxation
+!
+IF ( NRIMX > KRIMX .AND. .NOT.LHORELAX_SVELEC ) THEN
+ NRIMX = KRIMX
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU WANT TO USE A LARGER NUMBER OF POINTS '
+ WRITE(ILUOUT,FMT=*) 'FOR THE HORIZONTAL RELAXATION THAN THE '
+ WRITE(ILUOUT,FMT=*) 'CORRESPONDING NUMBER OF LARGE SCALE FIELDS:'
+ WRITE(ILUOUT,FMT=*) 'IT IS THEREFORE REDUCED TO NRIMX =',NRIMX
+END IF
+!
+IF ( L2D .AND. KRIMY>0 ) THEN
+ NRIMY = 0
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU WANT TO USE A 2D MODEL THEREFORE NRIMY=0 '
+END IF
+!
+IF ( NRIMY > KRIMY .AND. .NOT.LHORELAX_SVELEC ) THEN
+ NRIMY = KRIMY
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU WANT TO USE A LARGER NUMBER OF POINTS '
+ WRITE(ILUOUT,FMT=*) 'FOR THE HORIZONTAL RELAXATION THAN THE '
+ WRITE(ILUOUT,FMT=*) 'CORRESPONDING NUMBER OF LARGE SCALE FIELDS:'
+ WRITE(ILUOUT,FMT=*) 'IT IS THEREFORE REDUCED TO NRIMY =',NRIMY
+END IF
+!
+IF ( (.NOT. LHORELAX_UVWTH) .AND. (.NOT.(ANY(LHORELAX_SV))) .AND. &
+ (.NOT. LHORELAX_SVC2R2).AND. (.NOT. LHORELAX_SVC1R3) .AND. &
+ (.NOT. LHORELAX_SVLIMA).AND. &
+ (.NOT. LHORELAX_SVELEC).AND. (.NOT. LHORELAX_SVCHEM) .AND. &
+ (.NOT. LHORELAX_SVLG) .AND. (.NOT. LHORELAX_SVPP) .AND. &
+ (.NOT. LHORELAX_SVCS) .AND. (.NOT. LHORELAX_SVFIRE) .AND. &
+#ifdef MNH_FOREFIRE
+ (.NOT. LHORELAX_SVFF) .AND. &
+#endif
+ (.NOT. LHORELAX_RV) .AND. (.NOT. LHORELAX_RC) .AND. &
+ (.NOT. LHORELAX_RR) .AND. (.NOT. LHORELAX_RI) .AND. &
+ (.NOT. LHORELAX_RS) .AND. (.NOT. LHORELAX_RG) .AND. &
+ (.NOT. LHORELAX_RH) .AND. (.NOT. LHORELAX_TKE) .AND. &
+ (.NOT. LHORELAX_SVCHIC).AND. &
+ (NRIMX /= 0 .OR. NRIMY /= 0)) THEN
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU DO NOT WANT TO USE THE HORIZONTAL RELAXATION '
+ WRITE(ILUOUT,FMT=*) 'THEREFORE NRIMX=NRIMY=0 '
+ NRIMX=0
+ NRIMY=0
+END IF
+!
+IF ((LHORELAX_UVWTH .OR. LHORELAX_SVPP .OR. &
+ LHORELAX_SVCS .OR. LHORELAX_SVFIRE .OR. &
+#ifdef MNH_FOREFIRE
+ LHORELAX_SVFF .OR. &
+#endif
+ LHORELAX_SVC2R2 .OR. LHORELAX_SVC1R3 .OR. &
+ LHORELAX_SVLIMA .OR. &
+ LHORELAX_SVELEC .OR. LHORELAX_SVCHEM .OR. &
+ LHORELAX_SVLG .OR. ANY(LHORELAX_SV) .OR. &
+ LHORELAX_RV .OR. LHORELAX_RC .OR. &
+ LHORELAX_RR .OR. LHORELAX_RI .OR. &
+ LHORELAX_RG .OR. LHORELAX_RS .OR. &
+ LHORELAX_RH .OR. LHORELAX_TKE.OR. &
+ LHORELAX_SVCHIC ) &
+ .AND. (NRIMX==0 .OR. (NRIMY==0 .AND. .NOT.(L2D) ))) THEN
+ WRITE(UNIT=ILUOUT,FMT=9003) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU WANT TO USE THE HORIZONTAL RELAXATION '
+ WRITE(ILUOUT,FMT=*) 'BUT NRIMX OR NRIMY=0 CHANGE YOUR VALUES '
+ WRITE(ILUOUT,FMT=*) "LHORELAX_UVWTH=",LHORELAX_UVWTH
+ WRITE(ILUOUT,FMT=*) "LHORELAX_SVC2R2=",LHORELAX_SVC2R2
+ WRITE(ILUOUT,FMT=*) "LHORELAX_SVC1R3=",LHORELAX_SVC1R3
+ WRITE(ILUOUT,FMT=*) "LHORELAX_SVLIMA=",LHORELAX_SVLIMA
+ WRITE(ILUOUT,FMT=*) "LHORELAX_SVELEC=",LHORELAX_SVELEC
+ WRITE(ILUOUT,FMT=*) "LHORELAX_SVCHEM=",LHORELAX_SVCHEM
+ WRITE(ILUOUT,FMT=*) "LHORELAX_SVCHIC=",LHORELAX_SVCHIC
+ WRITE(ILUOUT,FMT=*) "LHORELAX_SVLG=",LHORELAX_SVLG
+ WRITE(ILUOUT,FMT=*) "LHORELAX_SVPP=",LHORELAX_SVPP
+ WRITE(ILUOUT,FMT=*) "LHORELAX_SVFIRE=",LHORELAX_SVFIRE
+#ifdef MNH_FOREFIRE
+ WRITE(ILUOUT,FMT=*) "LHORELAX_SVFF=",LHORELAX_SVFF
+#endif
+ WRITE(ILUOUT,FMT=*) "LHORELAX_SVCS=",LHORELAX_SVCS
+ WRITE(ILUOUT,FMT=*) "LHORELAX_SV=",LHORELAX_SV
+ WRITE(ILUOUT,FMT=*) "LHORELAX_RV=",LHORELAX_RV
+ WRITE(ILUOUT,FMT=*) "LHORELAX_RC=",LHORELAX_RC
+ WRITE(ILUOUT,FMT=*) "LHORELAX_RR=",LHORELAX_RR
+ WRITE(ILUOUT,FMT=*) "LHORELAX_RI=",LHORELAX_RI
+ WRITE(ILUOUT,FMT=*) "LHORELAX_RG=",LHORELAX_RG
+ WRITE(ILUOUT,FMT=*) "LHORELAX_RS=",LHORELAX_RS
+ WRITE(ILUOUT,FMT=*) "LHORELAX_RH=",LHORELAX_RH
+ WRITE(ILUOUT,FMT=*) "LHORELAX_TKE=", LHORELAX_TKE
+ WRITE(ILUOUT,FMT=*) "NRIMX=",NRIMX
+ WRITE(ILUOUT,FMT=*) "NRIMY=",NRIMY
+ WRITE(ILUOUT,FMT=*) "L2D=",L2D
+ !callabortstop
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
+END IF
+!
+IF ((LHORELAX_UVWTH .OR. LHORELAX_SVPP .OR. &
+ LHORELAX_SVCS .OR. LHORELAX_SVFIRE .OR. &
+#ifdef MNH_FOREFIRE
+ LHORELAX_SVFF .OR. &
+#endif
+ LHORELAX_SVC2R2 .OR. LHORELAX_SVC1R3 .OR. &
+ LHORELAX_SVLIMA .OR. &
+ LHORELAX_SVELEC .OR. LHORELAX_SVCHEM .OR. &
+ LHORELAX_SVLG .OR. ANY(LHORELAX_SV) .OR. &
+ LHORELAX_RV .OR. LHORELAX_RC .OR. &
+ LHORELAX_RR .OR. LHORELAX_RI .OR. &
+ LHORELAX_RG .OR. LHORELAX_RS .OR. &
+ LHORELAX_RH .OR. LHORELAX_TKE.OR. &
+ LHORELAX_SVCHIC ) &
+ .AND. (KMI /=1)) THEN
+ WRITE(UNIT=ILUOUT,FMT=9003) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU WANT TO USE THE HORIZONTAL RELAXATION '
+ WRITE(ILUOUT,FMT=*) 'FOR A NESTED MODEL BUT THE COUPLING IS ALREADY DONE'
+ WRITE(ILUOUT,FMT=*) 'BY THE GRID NESTING. CHANGE LHORELAX TO FALSE'
+ !callabortstop
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
+END IF
+!
+IF ((LHORELAX_UVWTH .OR. LHORELAX_SVPP .OR. &
+ LHORELAX_SVCS .OR. LHORELAX_SVFIRE .OR. &
+#ifdef MNH_FOREFIRE
+ LHORELAX_SVFF .OR. &
+#endif
+ LHORELAX_SVC2R2 .OR. LHORELAX_SVC1R3 .OR. &
+ LHORELAX_SVLIMA .OR. &
+ LHORELAX_SVELEC .OR. LHORELAX_SVCHEM .OR. &
+ LHORELAX_SVLG .OR. ANY(LHORELAX_SV) .OR. &
+ LHORELAX_RV .OR. LHORELAX_RC .OR. &
+ LHORELAX_RR .OR. LHORELAX_RI .OR. &
+ LHORELAX_RG .OR. LHORELAX_RS .OR. &
+ LHORELAX_RH .OR. LHORELAX_TKE.OR. &
+ LHORELAX_SVCHIC ) &
+ .AND. (CLBCX(1)=='CYCL'.OR.CLBCX(2)=='CYCL' &
+ .OR.CLBCY(1)=='CYCL'.OR.CLBCY(2)=='CYCL')) THEN
+ WRITE(UNIT=ILUOUT,FMT=9003) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU WANT TO USE THE HORIZONTAL RELAXATION '
+ WRITE(ILUOUT,FMT=*) 'FOR CYCLIC CLBCX OR CLBCY VALUES'
+ WRITE(ILUOUT,FMT=*) 'CHANGE LHORELAX TO FALSE'
+ !callabortstop
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
+END IF
+!
+IF (KMI==1) THEN
+ GRELAX = .NOT.(OUSERV) .AND. LUSERV .AND. LHORELAX_RV
+ELSE
+ GRELAX = .NOT.(LUSERV_G(NDAD(KMI))) .AND. LUSERV_G(KMI).AND. LHORELAX_RV
+END IF
+!
+IF ( GRELAX ) THEN
+ LHORELAX_RV=.FALSE.
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX THE RV FIELD'
+ WRITE(ILUOUT,FMT=*) 'TOWARDS THE LARGE SCALE FIELD OF MODEL',NDAD(KMI)
+ WRITE(ILUOUT,FMT=*) 'BUT IT DOES NOT EXIST.'
+ WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_RV=FALSE'
+END IF
+!
+IF (KMI==1) THEN
+ GRELAX = .NOT.(OUSERC) .AND. LUSERC .AND. LHORELAX_RC
+ELSE
+ GRELAX = .NOT.(LUSERC_G(NDAD(KMI))) .AND. LUSERC_G(KMI).AND. LHORELAX_RC
+END IF
+!
+IF ( GRELAX ) THEN
+ LHORELAX_RC=.FALSE.
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX THE RC FIELD'
+ WRITE(ILUOUT,FMT=*) 'TOWARDS THE LARGE SCALE FIELD OF MODEL',NDAD(KMI)
+ WRITE(ILUOUT,FMT=*) 'BUT IT DOES NOT EXIST.'
+ WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_RC=FALSE'
+END IF
+!
+IF (KMI==1) THEN
+ GRELAX = .NOT.(OUSERR) .AND. LUSERR .AND. LHORELAX_RR
+ELSE
+ GRELAX = .NOT.(LUSERR_G(NDAD(KMI))) .AND. LUSERR_G(KMI).AND. LHORELAX_RR
+END IF
+!
+IF ( GRELAX ) THEN
+ LHORELAX_RR=.FALSE.
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX THE RR FIELD'
+ WRITE(ILUOUT,FMT=*) 'TOWARDS THE LARGE SCALE FIELD OF MODEL',NDAD(KMI)
+ WRITE(ILUOUT,FMT=*) 'BUT IT DOES NOT EXIST.'
+ WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_RR=FALSE'
+END IF
+!
+IF (KMI==1) THEN
+ GRELAX = .NOT.(OUSERI) .AND. LUSERI .AND. LHORELAX_RI
+ELSE
+ GRELAX = .NOT.(LUSERI_G(NDAD(KMI))) .AND. LUSERI_G(KMI).AND. LHORELAX_RI
+END IF
+!
+IF ( GRELAX ) THEN
+ LHORELAX_RI=.FALSE.
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX THE RI FIELD'
+ WRITE(ILUOUT,FMT=*) 'TOWARDS THE LARGE SCALE FIELD OF MODEL',NDAD(KMI)
+ WRITE(ILUOUT,FMT=*) 'BUT IT DOES NOT EXIST.'
+ WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_RI=FALSE'
+END IF
+!
+IF (KMI==1) THEN
+ GRELAX = .NOT.(OUSERG) .AND. LUSERG .AND. LHORELAX_RG
+ELSE
+ GRELAX = .NOT.(LUSERG_G(NDAD(KMI))) .AND. LUSERG_G(KMI).AND. LHORELAX_RG
+END IF
+!
+IF ( GRELAX ) THEN
+ LHORELAX_RG=.FALSE.
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX THE RG FIELD'
+ WRITE(ILUOUT,FMT=*) 'TOWARDS THE LARGE SCALE FIELD OF MODEL',NDAD(KMI)
+ WRITE(ILUOUT,FMT=*) 'BUT IT DOES NOT EXIST.'
+ WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_RG=FALSE'
+END IF
+!
+IF (KMI==1) THEN
+ GRELAX = .NOT.(OUSERH) .AND. LUSERH .AND. LHORELAX_RH
+ELSE
+ GRELAX = .NOT.(LUSERH_G(NDAD(KMI))) .AND. LUSERH_G(KMI).AND. LHORELAX_RH
+END IF
+!
+IF ( GRELAX ) THEN
+ LHORELAX_RH=.FALSE.
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX THE RH FIELD'
+ WRITE(ILUOUT,FMT=*) 'TOWARDS THE LARGE SCALE FIELD OF MODEL',NDAD(KMI)
+ WRITE(ILUOUT,FMT=*) 'BUT IT DOES NOT EXIST.'
+ WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_RH=FALSE'
+END IF
+!
+IF (KMI==1) THEN
+ GRELAX = .NOT.(OUSERS) .AND. LUSERS .AND. LHORELAX_RS
+ELSE
+ GRELAX = .NOT.(LUSERS_G(NDAD(KMI))) .AND. LUSERS_G(KMI).AND. LHORELAX_RS
+END IF
+!
+IF ( GRELAX ) THEN
+ LHORELAX_RS=.FALSE.
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX THE RS FIELD'
+ WRITE(ILUOUT,FMT=*) 'TOWARDS THE LARGE SCALE FIELD OF MODEL',NDAD(KMI)
+ WRITE(ILUOUT,FMT=*) 'BUT IT DOES NOT EXIST.'
+ WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_RS=FALSE'
+END IF
+!
+IF (KMI==1) THEN
+ GRELAX = HTURB=='NONE' .AND. LUSETKE(1).AND. LHORELAX_TKE
+ELSE
+ GRELAX = .NOT.(LUSETKE(NDAD(KMI))) .AND. LUSETKE(KMI) .AND. LHORELAX_TKE
+END IF
+!
+IF ( GRELAX ) THEN
+ LHORELAX_TKE=.FALSE.
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX THE TKE FIELD'
+ WRITE(ILUOUT,FMT=*) 'TOWARDS THE LARGE SCALE FIELD OF MODEL',NDAD(KMI)
+ WRITE(ILUOUT,FMT=*) 'BUT IT DOES NOT EXIST.'
+ WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_TKE=FALSE'
+END IF
+!
+!
+DO JSV = 1,NSV_USER
+!
+ IF (KMI==1) THEN
+ GRELAX = KSV_USER<JSV .AND. LUSESV(JSV,1).AND. LHORELAX_SV(JSV)
+ ELSE
+ GRELAX = .NOT.(LUSESV(JSV,NDAD(KMI))) .AND. LUSESV(JSV,KMI) .AND. LHORELAX_SV(JSV)
+ END IF
+ !
+ IF ( GRELAX ) THEN
+ LHORELAX_SV(JSV)=.FALSE.
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX THE ',JSV,' SV FIELD'
+ WRITE(ILUOUT,FMT=*) 'TOWARDS THE LARGE SCALE FIELD OF MODEL',NDAD(KMI)
+ WRITE(ILUOUT,FMT=*) 'BUT IT DOES NOT EXIST.'
+ WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_SV(',JSV,')=FALSE'
+ END IF
+END DO
+!
+!* 4.6 consistency in LES diagnostics choices
+!
+IF (CLES_NORM_TYPE=='EKMA' .AND. .NOT. LCORIO) THEN
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU WANT TO USE THE EKMAN NORMALIZATION'
+ WRITE(ILUOUT,FMT=*) 'BUT CORIOLIS FORCE IS NOT USED (LCORIO=.FALSE.)'
+ WRITE(ILUOUT,FMT=*) 'THEN, NO NORMALIZATION IS PERFORMED'
+ CLES_NORM_TYPE='NONE'
+END IF
+!
+!* 4.7 Check the coherence with LNUMDIFF
+!
+IF (L1D .AND. (LNUMDIFU .OR. LNUMDIFTH .OR. LNUMDIFSV) ) THEN
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU WANT TO USE HORIZONTAL DIFFUSION '
+ WRITE(ILUOUT,FMT=*) 'BUT YOU ARE IN A COLUMN MODEL (L1D=.TRUE.).'
+ WRITE(ILUOUT,FMT=*) 'THEREFORE LNUMDIFU and LNUMDIFTH and LNUMDIFSV'
+ WRITE(ILUOUT,FMT=*) 'ARE SET TO FALSE'
+ LNUMDIFU=.FALSE.
+ LNUMDIFTH=.FALSE.
+ LNUMDIFSV=.FALSE.
+END IF
+!
+IF (.NOT. LNUMDIFTH .AND. LZDIFFU) THEN
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU DO NOT WANT TO USE HORIZONTAL DIFFUSION (LNUMDIFTH=F)'
+ WRITE(ILUOUT,FMT=*) 'BUT YOU WANT TO USE Z-NUMERICAL DIFFUSION '
+ WRITE(ILUOUT,FMT=*) 'THEREFORE LNUMDIFTH IS SET TO TRUE'
+ LNUMDIFTH=.TRUE.
+END IF
+!
+!* 4.8 Other
+!
+IF (XTNUDGING < 4.*XTSTEP) THEN
+ XTNUDGING = 4.*XTSTEP
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(UNIT=ILUOUT,FMT='("TIME SCALE FOR NUDGING CAN NOT BE SMALLER THAN", &
+ & " FOUR TIMES THE TIME STEP")')
+ WRITE(ILUOUT,FMT=*) 'XTNUDGING is SET TO ',XTNUDGING
+END IF
+!
+!
+IF (XWAY(KMI) == 3. ) THEN
+ XWAY(KMI) = 2.
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(UNIT=ILUOUT,FMT='("XWAY=3 DOES NOT EXIST ANYMORE; ", &
+ & " IT IS REPLACED BY XWAY=2 ")')
+END IF
+!
+IF ( (KMI == 1) .AND. XWAY(KMI) /= 0. ) THEN
+ XWAY(KMI) = 0.
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(UNIT=ILUOUT,FMT='("XWAY MUST BE EQUAL TO 0 FOR DAD MODEL")')
+END IF
+!
+!JUANZ ZRESI solver need BSPLITTING
+IF ( CPRESOPT == 'ZRESI' .AND. CSPLIT /= 'BSPLITTING' ) THEN
+ WRITE(UNIT=ILUOUT,FMT=9003) KMI
+ WRITE(UNIT=ILUOUT,FMT='("Paralleliez in Z solver CPRESOPT=ZRESI need also CSPLIT=BSPLITTING ")')
+ WRITE(ILUOUT,FMT=*) ' ERROR you have to set also CSPLIT=BSPLITTING '
+ !callabortstop
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
+END IF
+!
+IF ( LEN_TRIM(HINIFILEPGD)>0 ) THEN
+ IF ( CINIFILEPGD/=HINIFILEPGD ) THEN
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(ILUOUT,FMT=*) ' ERROR : in EXSEG1.nam, in NAM_LUNITn you have CINIFILEPGD= ',CINIFILEPGD
+ WRITE(ILUOUT,FMT=*) ' whereas in .des you have CINIFILEPGD= ',HINIFILEPGD
+ WRITE(ILUOUT,FMT=*) ' Please check your Namelist '
+ WRITE(ILUOUT,FMT=*) ' For example, you may have specified the un-nested PGD file instead of the nested PGD file '
+ WRITE(ILUOUT,FMT=*)
+ WRITE(ILUOUT,FMT=*) '###############'
+ WRITE(ILUOUT,FMT=*) ' MESONH ABORTS'
+ WRITE(ILUOUT,FMT=*) '###############'
+ WRITE(ILUOUT,FMT=*)
+ !callabortstop
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
+ END IF
+ELSE
+ CINIFILEPGD = ''
+!* note that after a spawning, there is no value for CINIFILEPGD in the .des file,
+! so the checking cannot be made if the user starts a simulation directly from
+! a spawned file (without the prep_real_case stage)
+END IF
+!-------------------------------------------------------------------------------
+!
+!* 5. WE DO NOT FORGET TO UPDATE ALL DOLLARN NAMELIST VARIABLES
+! ---------------------------------------------------------
+!
+CALL UPDATE_NAM_LUNITN
+CALL UPDATE_NAM_CONFN
+CALL UPDATE_NAM_DRAGTREEN
+CALL UPDATE_NAM_DRAGBLDGN
+CALL UPDATE_NAM_DYNN
+CALL UPDATE_NAM_ADVN
+CALL UPDATE_NAM_PARAMN
+CALL UPDATE_NAM_PARAM_RADN
+#ifdef MNH_ECRAD
+CALL UPDATE_NAM_PARAM_ECRADN
+#endif
+CALL UPDATE_NAM_PARAM_KAFRN
+CALL UPDATE_NAM_PARAM_MFSHALLN
+CALL UPDATE_NAM_LBCN
+CALL UPDATE_NAM_NUDGINGN
+CALL UPDATE_NAM_TURBN
+CALL UPDATE_NAM_BLANKN
+CALL UPDATE_NAM_CH_MNHCN
+CALL UPDATE_NAM_CH_SOLVERN
+CALL UPDATE_NAM_SERIESN
+CALL UPDATE_NAM_BLOWSNOWN
+CALL UPDATE_NAM_PROFILERn
+CALL UPDATE_NAM_STATIONn
+CALL UPDATE_NAM_FIREn
+!-------------------------------------------------------------------------------
+WRITE(UNIT=ILUOUT,FMT='(/)')
+!-------------------------------------------------------------------------------
+!
+!* 6. FORMATS
+! -------
+!
+9000 FORMAT(/,'NOTE IN READ_EXSEG FOR MODEL ', I2, ' : ',/, &
+ '--------------------------------')
+9001 FORMAT(/,'CAUTION ERROR IN READ_EXSEG FOR MODEL ', I2,' : ',/, &
+ '----------------------------------------' )
+9002 FORMAT(/,'WARNING IN READ_EXSEG FOR MODEL ', I2,' : ',/, &
+ '----------------------------------' )
+9003 FORMAT(/,'FATAL ERROR IN READ_EXSEG FOR MODEL ', I2,' : ',/, &
+ '--------------------------------------' )
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE READ_EXSEG_n
diff --git a/src/PHYEX/ext/resolved_cloud.f90 b/src/PHYEX/ext/resolved_cloud.f90
new file mode 100644
index 0000000000000000000000000000000000000000..64d5eec3a4b455a24aac79de5c59f425d0789e2c
--- /dev/null
+++ b/src/PHYEX/ext/resolved_cloud.f90
@@ -0,0 +1,1108 @@
+!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! ##########################
+ MODULE MODI_RESOLVED_CLOUD
+! ##########################
+INTERFACE
+ SUBROUTINE RESOLVED_CLOUD ( HCLOUD, HACTCCN, HSCONV, HMF_CLOUD, &
+ KRR, KSPLITR, KSPLITG, KMI, KTCOUNT, &
+ HLBCX, HLBCY, TPFILE, HRAD, HTURBDIM, &
+ OSUBG_COND, OSIGMAS, HSUBG_AUCV, &
+ PTSTEP, PZZ, PRHODJ, PRHODREF, PEXNREF, &
+ PPABST, PTHT, PRT, PSIGS, PSIGQSAT, PMFCONV, &
+ PTHM, PRCM, PPABSTT, &
+ PW_ACT,PDTHRAD, PTHS, PRS, PSVT, PSVS, PSRCS, PCLDFR,&
+ PICEFR, &
+ PCIT, OSEDIC, OACTIT, OSEDC, OSEDI, &
+ ORAIN, OWARM, OHHONI, OCONVHG, &
+ PCF_MF,PRC_MF, PRI_MF, &
+ PINPRC,PINPRC3D,PINPRR,PINPRR3D, PEVAP3D, &
+ PINPRS,PINPRS3D,PINPRG,PINPRG3D,PINPRH,PINPRH3D, &
+ PSOLORG,PMI, &
+ PSPEEDC, PSPEEDR, PSPEEDS, PSPEEDG, PSPEEDH, &
+ PINDEP, PSUPSAT, PNACT, PNPRO,PSSPRO, PRAINFR, &
+ PHLC_HRC, PHLC_HCF, PHLI_HRI, PHLI_HCF, &
+ PSEA,PTOWN )
+!
+USE MODD_IO, ONLY: TFILEDATA
+!
+CHARACTER(LEN=4), INTENT(IN) :: HCLOUD ! kind of cloud
+CHARACTER(LEN=4), INTENT(IN) :: HACTCCN ! kind of CCN activation scheme
+ ! paramerization
+CHARACTER(LEN=4), INTENT(IN) :: HSCONV ! Shallow convection scheme
+CHARACTER(LEN=4), INTENT(IN) :: HMF_CLOUD! Type of statistical cloud
+INTEGER, INTENT(IN) :: KRR ! Number of moist variables
+INTEGER, INTENT(IN) :: KSPLITR ! Number of small time step
+ ! integrations for rain sedimendation
+INTEGER, INTENT(IN) :: KSPLITG ! Number of small time step
+ ! integrations for ice sedimendation
+INTEGER, INTENT(IN) :: KMI ! Model index
+INTEGER, INTENT(IN) :: KTCOUNT ! Temporal loop counter
+CHARACTER(LEN=4), DIMENSION(2), INTENT(IN) :: HLBCX,HLBCY ! X and Y-direc. LBC type
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
+CHARACTER(len=4), INTENT(IN) :: HRAD ! Radiation scheme name
+CHARACTER(len=4), INTENT(IN) :: HTURBDIM ! Dimensionality of the
+ ! turbulence scheme
+LOGICAL, INTENT(IN) :: OSUBG_COND ! Switch for Subgrid Cond.
+LOGICAL, INTENT(IN) :: OSIGMAS ! Switch for Sigma_s:
+ ! use values computed in CONDENSATION
+ ! or that from turbulence scheme
+CHARACTER(LEN=4), INTENT(IN) :: HSUBG_AUCV
+ ! Kind of Subgrid autoconversion method
+REAL, INTENT(IN) :: PTSTEP ! Time step :XTSTEP in namelist
+!
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Height (z)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ !Dry density * Jacobian
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF! Reference dry air density
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
+!
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! abs. pressure at time t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta at time t
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT):: PRT ! Moist variables at time t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSIGS ! Sigma_s at time t
+REAL, INTENT(IN) :: PSIGQSAT! coeff applied to qsat variance contribution
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PMFCONV ! convective mass flux
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHM ! Theta at time t-Dt
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABSTT ! Pressure time t+Dt
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCM ! Cloud water m.r. at time t-Dt
+!
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PW_ACT ! W for CCN activation
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDTHRAD! THeta RADiative Tendancy
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRS ! Moist variable sources
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVT ! Scalar variable at time t
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVS ! Scalar variable sources
+!
+!
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSRCS ! Second-order flux
+ ! s'rc'/2Sigma_s2 at time t+1
+ ! multiplied by Lambda_3
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCLDFR! Cloud fraction
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PICEFR! Cloud fraction
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCIT ! Pristine ice number
+ ! concentration at time t
+LOGICAL, INTENT(IN) :: OSEDIC! Switch to activate the
+ ! cloud droplet sedimentation
+ ! for ICE3
+LOGICAL, INTENT(IN) :: OACTIT ! Switch to activate the
+ ! activation through temp.
+ ! evolution in C2R2 and KHKO
+LOGICAL, INTENT(IN) :: OSEDC ! Switch to activate the
+ ! cloud droplet sedimentation
+ ! for C2R2 or KHKO
+LOGICAL, INTENT(IN) :: OSEDI ! Switch to activate the
+ ! cloud crystal sedimentation
+LOGICAL, INTENT(IN) :: ORAIN ! Switch to activate the
+ ! raindrop formation
+LOGICAL, INTENT(IN) :: OWARM ! Control of the rain formation
+ ! by slow warm microphysical
+ ! processes
+LOGICAL, INTENT(IN) :: OHHONI! enable haze freezing
+LOGICAL, INTENT(IN) :: OCONVHG! Switch for conversion from
+ ! hail to graupel
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCF_MF! Convective Mass Flux Cloud fraction
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRC_MF! Convective Mass Flux liquid mixing ratio
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRI_MF! Convective Mass Flux solid mixing ratio
+!
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRC ! Cloud instant precip
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRR ! Rain instant precip
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PINPRR3D ! sed flux of precip
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PEVAP3D ! evap profile
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRS ! Snow instant precip
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRG ! Graupel instant precip
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRH ! Hail instant precip
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PINPRC3D ! sed flux of precip
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PINPRS3D ! sed flux of precip
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PINPRG3D ! sed flux of precip
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PINPRH3D ! sed flux of precip
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSOLORG ![%] solubility fraction of soa
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PMI
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSPEEDC ! Cloud sedimentation speed
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSPEEDR ! Rain sedimentation speed
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSPEEDS ! Snow sedimentation speed
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSPEEDG ! Graupel sedimentation speed
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSPEEDH ! Hail sedimentation speed
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINDEP ! Cloud instant deposition
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSUPSAT !sursat
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PNACT !concentrtaion d'aérosols activés au temps t
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PNPRO !concentrtaion d'aérosols activés au temps t
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSSPRO !sursat
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRAINFR ! Rain fraction
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PHLC_HRC !HighLow liquid content
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PHLC_HCF !HighLow liquid cloud fraction
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PHLI_HRI !HighLow ice content
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PHLI_HCF !HighLow ice clous fraction
+REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PSEA ! Land Sea mask
+REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PTOWN ! Town fraction
+!
+END SUBROUTINE RESOLVED_CLOUD
+END INTERFACE
+END MODULE MODI_RESOLVED_CLOUD
+!
+! ##########################################################################
+ SUBROUTINE RESOLVED_CLOUD ( HCLOUD, HACTCCN, HSCONV, HMF_CLOUD, &
+ KRR, KSPLITR, KSPLITG, KMI, KTCOUNT, &
+ HLBCX, HLBCY, TPFILE, HRAD, HTURBDIM, &
+ OSUBG_COND, OSIGMAS, HSUBG_AUCV, &
+ PTSTEP, PZZ, PRHODJ, PRHODREF, PEXNREF, &
+ PPABST, PTHT, PRT, PSIGS, PSIGQSAT, PMFCONV, &
+ PTHM, PRCM, PPABSTT, &
+ PW_ACT,PDTHRAD, PTHS, PRS, PSVT, PSVS, PSRCS, PCLDFR,&
+ PICEFR, &
+ PCIT, OSEDIC, OACTIT, OSEDC, OSEDI, &
+ ORAIN, OWARM, OHHONI, OCONVHG, &
+ PCF_MF,PRC_MF, PRI_MF, &
+ PINPRC,PINPRC3D,PINPRR,PINPRR3D, PEVAP3D, &
+ PINPRS,PINPRS3D,PINPRG,PINPRG3D,PINPRH,PINPRH3D, &
+ PSOLORG,PMI, &
+ PSPEEDC, PSPEEDR, PSPEEDS, PSPEEDG, PSPEEDH, &
+ PINDEP, PSUPSAT, PNACT, PNPRO,PSSPRO, PRAINFR, &
+ PHLC_HRC, PHLC_HCF, PHLI_HRI, PHLI_HCF, &
+ PSEA,PTOWN )
+! ##########################################################################
+!
+!!**** * - compute the resolved clouds and precipitation
+!!
+!! PURPOSE
+!! -------
+!! The purpose of this routine is to compute the microphysical sources
+!! related to the resolved clouds and precipitation
+!!
+!!
+!!** METHOD
+!! ------
+!! The main actions of this routine is to call the routines computing the
+!! microphysical sources. Before that:
+!! - it computes the real absolute pressure,
+!! - negative values of the current guess of all mixing ratio are removed.
+!! This is done by a global filling algorithm based on a multiplicative
+!! method (Rood, 1987), in order to conserved the total mass in the
+!! simulation domain.
+!! - Sources are transformed in physical tendencies, by removing the
+!! multiplicative term Rhod*J.
+!! - External points values are filled owing to the use of cyclic
+!! l.b.c., in order to performe computations on the full domain.
+!! After calling to microphysical routines, the physical tendencies are
+!! switched back to prognostic variables.
+!!
+!!
+!! EXTERNAL
+!! --------
+!! Subroutine SLOW_TERMS: Computes the explicit microphysical sources
+!! Subroutine FAST_TERMS: Performs the saturation adjustment for l
+!! Subroutine RAIN_ICE : Computes the explicit microphysical sources for i
+!! Subroutine ICE_ADJUST: Performs the saturation adjustment for i+l
+!! MIN_ll,SUM3D_ll : distributed functions equivalent to MIN and SUM
+!!
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_PARAMETERS : contains declarations of parameter variables
+!! JPHEXT : Horizontal external points number
+!! JPVEXT : Vertical external points number
+!! Module MODD_CST
+!! CST%XP00 ! Reference pressure
+!! CST%XRD ! Gaz constant for dry air
+!! CST%XCPD ! Cpd (dry air)
+!!
+!! REFERENCE
+!! ---------
+!!
+!! Book1 and book2 of documentation ( routine RESOLVED_CLOUD )
+!!
+!! AUTHOR
+!! ------
+!! E. Richard * Laboratoire d'Aerologie*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 21/12/94
+!! Modifications: June 8, 1995 ( J.Stein )
+!! Cleaning to improve efficienty and clarity
+!! in agreement with the MESO-NH coding norm
+!! March 1, 1996 ( J.Stein )
+!! store the cloud fraction
+!! March 18, 1996 ( J.Stein )
+!! check that ZMASSPOS /= 0
+!! Oct. 12, 1996 ( J.Stein )
+!! remove the negative values correction
+!! for the KES2 case
+!! Modifications: Dec 14, 1995 (J.-P. Pinty)
+!! Add the mixed-phase option
+!! Modifications: Jul 01, 1996 (J.-P. Pinty)
+!! Change arg. list in routine FAST_TERMS
+!! Modifications: Jan 27, 1997 (J.-P. Pinty)
+!! add W and SV in arg. list
+!! Modifications: March 23, 98 (E.Richard)
+!! correction of negative value based on
+!! rv+rc+ri and thetal or thetail conservation
+!! Modifications: April 08, 98 (J.-P. Lafore and V. Ducrocq )
+!! modify the correction of negative values
+!! Modifications: June 08, 00 (J.-P. Pinty and J.-M. Cohard)
+!! add the C2R2 scheme
+!! Modifications: April 08, 01 (J.-P. Pinty)
+!! add the C3R5 scheme
+!! Modifications: July 21, 01 (J.-P. Pinty)
+!! Add OHHONI and PW_ACT (for haze freezing)
+!! Modifications: Sept 21, 01 (J.-P. Pinty)
+!! Add XCONC_CCN limitation
+!! Modifications: Nov 21, 02 (J.-P. Pinty)
+!! Add ICE4 and C3R5 options
+!! June, 2005 (V. Masson)
+!! Technical change in interface for scalar arguments
+!! Modifications : March, 2006 (O.Geoffroy)
+!! Add KHKO scheme
+!! Modifications : March 2013 (O.Thouron)
+!! Add prognostic supersaturation
+!! July, 2015 (O.Nuissier/F.Duffourg) Add microphysics diagnostic for
+!! aircraft, ballon and profiler
+!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
+!! M.Mazoyer : 04/2016 : Temperature radiative tendency used for
+!! activation by cooling (OACTIT)
+!! Modification 01/2016 (JP Pinty) Add LIMA
+!! 10/2016 M.Mazoyer New KHKO output fields
+!! 10/2016 (C.Lac) Add droplet deposition
+!! S.Riette : 11/2016 : ice_adjust before and after rain_ice
+!! ICE3/ICE4 modified, old version under LRED=F
+! P. Wautelet 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet 01/02/2019: ZRSMIN is now allocatable (instead of size of XRTMIN which was sometimes not allocated)
+! C. Lac 02/2019: add rain fraction as an output field
+! P. Wautelet 02/2020: use the new data structures and subroutines for budgets
+! B. Vie 03/2020: LIMA negativity checks after turbulence, advection and microphysics budgets
+! B. Vie 03/03/2020: use DTHRAD instead of dT/dt in Smax diagnostic computation
+! P. Wautelet 11/06/2020: bugfix: correct ZSVS array indices
+! P. Wautelet 11/06/2020: bugfix: add "Non local correction for precipitating species" for ICE4
+! P. Wautelet + Benoit Vié 06/2020: improve removal of negative scalar variables + adapt the corresponding budgets
+! P. Wautelet 23/06/2020: remove ZSVS and ZSVT to improve code readability
+! 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
+!-------------------------------------------------------------------------------
+!
+!* 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, ONLY: NEB
+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, ONLY: CSEDIM, LADJ_BEFORE, LADJ_AFTER, CFRAC_ICE_ADJUST, LRED, &
+ PARAM_ICE
+USE MODD_PARAM_LIMA, ONLY: LADJ, LPTSPLIT, LSPRO, NMOD_CCN, NMOD_IFN, NMOD_IMM, NMOM_I
+USE MODD_RAIN_ICE_DESCR, ONLY: XRTMIN, RAIN_ICE_DESCR
+USE MODD_RAIN_ICE_PARAM, ONLY: RAIN_ICE_PARAM
+USE MODD_SALT, ONLY: LSALT
+USE MODD_TURB_n, ONLY: TURBN, CSUBG_AUCV_RI, CCONDENS, CLAMBDA3, CSUBG_MF_PDF
+!
+USE MODE_ll
+USE MODE_FILL_DIMPHYEX, ONLY: FILL_DIMPHYEX
+use mode_sources_neg_correct, only: Sources_neg_correct
+!
+USE MODI_C2R2_ADJUST
+USE MODI_FAST_TERMS
+USE MODI_GET_HALO
+USE MODI_ICE_ADJUST
+USE MODI_KHKO_NOTADJUST
+USE MODI_LIMA
+USE MODI_LIMA_ADJUST
+USE MODI_LIMA_ADJUST_SPLIT
+USE MODI_LIMA_COLD
+USE MODI_LIMA_MIXED
+USE MODI_LIMA_NOTADJUST
+USE MODI_LIMA_WARM
+USE MODI_RAIN_C2R2_KHKO
+USE MODI_RAIN_ICE
+USE MODI_RAIN_ICE_OLD
+USE MODI_SHUMAN
+USE MODI_SLOW_TERMS
+USE MODI_AER2LIMA
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+!
+!
+CHARACTER(LEN=4), INTENT(IN) :: HCLOUD ! kind of cloud paramerization
+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
+INTEGER, INTENT(IN) :: KRR ! Number of moist variables
+INTEGER, INTENT(IN) :: KSPLITR ! Number of small time step
+ ! integrations for rain sedimendation
+INTEGER, INTENT(IN) :: KSPLITG ! Number of small time step
+ ! integrations for ice sedimendation
+INTEGER, INTENT(IN) :: KMI ! Model index
+INTEGER, INTENT(IN) :: KTCOUNT ! Temporal loop counter
+CHARACTER(LEN=4), DIMENSION(2), INTENT(IN) :: HLBCX,HLBCY ! X and Y-direc. LBC type
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
+CHARACTER(len=4), INTENT(IN) :: HRAD ! Radiation scheme name
+CHARACTER(len=4), INTENT(IN) :: HTURBDIM ! Dimensionality of the
+ ! turbulence scheme
+LOGICAL, INTENT(IN) :: OSUBG_COND ! Switch for Subgrid Cond.
+LOGICAL, INTENT(IN) :: OSIGMAS ! Switch for Sigma_s:
+ ! use values computed in CONDENSATION
+ ! or that from turbulence scheme
+CHARACTER(LEN=4), INTENT(IN) :: HSUBG_AUCV
+ ! Kind of Subgrid autoconversion method
+REAL, INTENT(IN) :: PTSTEP ! Time step :XTSTEP in namelist
+!
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Height (z)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ !Dry density * Jacobian
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF! Reference dry air density
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
+!
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! abs. pressure at time t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta at time t
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT):: PRT ! Moist variables at time t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSIGS ! Sigma_s at time t
+REAL, INTENT(IN) :: PSIGQSAT! coeff applied to qsat variance contribution
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PMFCONV ! convective mass flux
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHM ! Theta at time t-Dt
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABSTT ! Pressure time t+Dt
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCM ! Cloud water m.r. at time t-Dt
+!
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PW_ACT ! W for CCN activation
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDTHRAD! THeta RADiative Tendancy
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRS ! Moist variable sources
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVT ! Scalar variable at time t
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVS ! Scalar variable sources
+!
+!
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSRCS ! Second-order flux
+ ! s'rc'/2Sigma_s2 at time t+1
+ ! multiplied by Lambda_3
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCLDFR! Cloud fraction
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PICEFR! Cloud fraction
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCIT ! Pristine ice number
+ ! concentration at time t
+LOGICAL, INTENT(IN) :: OSEDIC! Switch to activate the
+ ! cloud droplet sedimentation
+ ! for ICE3
+LOGICAL, INTENT(IN) :: OACTIT ! Switch to activate the
+ ! activation through temp.
+ ! evolution in C2R2 and KHKO
+LOGICAL, INTENT(IN) :: OSEDC ! Switch to activate the
+ ! cloud droplet sedimentation
+LOGICAL, INTENT(IN) :: OSEDI ! Switch to activate the
+ ! cloud crystal sedimentation
+LOGICAL, INTENT(IN) :: ORAIN ! Switch to activate the
+ ! raindrop formation
+LOGICAL, INTENT(IN) :: OWARM ! Control of the rain formation
+ ! by slow warm microphysical
+ ! processes
+LOGICAL, INTENT(IN) :: OHHONI! enable haze freezing
+LOGICAL, INTENT(IN) :: OCONVHG! Switch for conversion from
+ ! hail to graupel
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCF_MF! Convective Mass Flux Cloud fraction
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRC_MF! Convective Mass Flux liquid mixing ratio
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRI_MF! Convective Mass Flux solid mixing ratio
+!
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRC ! Cloud instant precip
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRR ! Rain instant precip
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PINPRR3D ! sed flux of precip
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PEVAP3D ! evap profile
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRS ! Snow instant precip
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRG ! Graupel instant precip
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRH ! Hail instant precip
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PINPRC3D ! sed flux of precip
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PINPRS3D ! sed flux of precip
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PINPRG3D ! sed flux of precip
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PINPRH3D ! sed flux of precip
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSOLORG ![%] solubility fraction of soa
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PMI
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSPEEDC ! Cloud sedimentation speed
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSPEEDR ! Rain sedimentation speed
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSPEEDS ! Snow sedimentation speed
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSPEEDG ! Graupel sedimentation speed
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSPEEDH ! Hail sedimentation speed
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINDEP ! Cloud instant deposition
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSUPSAT !sursat
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PNACT !concentrtaion d'aérosols activés au temps t
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PNPRO !concentrtaion d'aérosols activés au temps t
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSSPRO !sursat
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRAINFR ! Rain fraction
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PHLC_HRC !HighLow liquid content
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PHLC_HCF !HighLow liquid cloud fraction
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PHLI_HRI !HighLow ice content
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PHLI_HCF !HighLow ice clous fraction
+REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PSEA ! Land Sea mask
+REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PTOWN ! Town fraction
+!
+!
+!* 0.2 Declarations of local variables :
+!
+INTEGER :: JRR,JSV ! Loop index for the moist and scalar variables
+INTEGER :: IIB ! Define the physical domain
+INTEGER :: IIE !
+INTEGER :: IJB !
+INTEGER :: IJE !
+INTEGER :: IKB !
+INTEGER :: IKE !
+INTEGER :: IKU
+INTEGER :: IINFO_ll ! return code of parallel routine
+INTEGER :: JK,JI,JL
+!
+!
+!
+REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)):: ZDZZ
+real, dimension(:,:,:), allocatable :: ZEXN
+REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)):: ZZZ
+ ! model layer height
+! REAL :: ZMASSTOT ! total mass for one water category
+! ! including the negative values
+! REAL :: ZMASSPOS ! total mass for one water category
+! ! after removing the negative values
+! REAL :: ZRATIO ! ZMASSTOT / ZMASSCOR
+!
+INTEGER :: ISVBEG ! first scalar index for microphysics
+INTEGER :: ISVEND ! last scalar index for microphysics
+!UPG*PT
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZSVT ! scalar variable for microphysics only
+!UPG*PT
+
+REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3), KRR) :: ZFPR
+!
+INTEGER :: JMOD, JMOD_IFN
+LOGICAL :: GWEST,GEAST,GNORTH,GSOUTH
+LOGICAL :: LMFCONV ! =SIZE(PMFCONV)!=0
+! BVIE work array waiting for PINPRI
+REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2)):: ZINPRI
+REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)):: ZICEFR
+REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)):: ZPRCFR
+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
+ZSIGQSAT2D(:,:) = PSIGQSAT
+!
+!------------------------------------------------------------------------------
+!
+!* 1. PRELIMINARY COMPUTATIONS
+! ------------------------
+!
+CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
+IKB=1+JPVEXT
+IKE=SIZE(PZZ,3) - JPVEXT
+IKU=SIZE(PZZ,3)
+!
+CALL FILL_DIMPHYEX(YLDIMPHYEX, SIZE(PZZ,1), SIZE(PZZ,2), SIZE(PZZ,3))
+!
+GWEST = LWEST_ll()
+GEAST = LEAST_ll()
+GSOUTH = LSOUTH_ll()
+GNORTH = LNORTH_ll()
+!
+LMFCONV=(SIZE(PMFCONV)/=0)
+!
+IF (HCLOUD == 'C2R2' .OR. HCLOUD == 'KHKO') THEN
+ ISVBEG = NSV_C2R2BEG
+ ISVEND = NSV_C2R2END
+ELSE IF (HCLOUD == 'C3R5') THEN
+ ISVBEG = NSV_C2R2BEG
+ ISVEND = NSV_C1R3END
+ELSE IF (HCLOUD == 'LIMA') THEN
+ ISVBEG = NSV_LIMA_BEG
+ IF (.NOT. LDUST .AND. .NOT. LSALT .AND. .NOT. LORILAM) THEN
+ ISVEND = NSV_LIMA_END
+ ELSE
+ IF (LORILAM) THEN
+ ISVEND = NSV_AEREND
+ END IF
+ IF (LDUST) THEN
+ ISVEND = NSV_DSTEND
+ END IF
+ IF (LSALT) THEN
+ ISVEND = NSV_SLTEND
+ END IF
+ END IF
+ELSE
+ ISVBEG = 0
+ ISVEND = 0
+END IF
+!
+!
+!
+!* 1. From ORILAM to LIMA:
+!
+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))
+ 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))
+
+! LIMA : variable instant t --> tendance s
+ PSVS(:,:,:,NSV_LIMA_CCN_FREE) = ZSVT(:,:,:,NSV_LIMA_CCN_FREE) * &
+ PRHODJ(:,:,:) / PTSTEP
+ PSVS(:,:,:,NSV_LIMA_CCN_FREE+1) = ZSVT(:,:,:,NSV_LIMA_CCN_FREE+1) * &
+ PRHODJ(:,:,:) / PTSTEP
+ PSVS(:,:,:,NSV_LIMA_CCN_FREE+2) = ZSVT(:,:,:,NSV_LIMA_CCN_FREE+2) * &
+ PRHODJ(:,:,:) / PTSTEP
+
+ PSVS(:,:,:,NSV_LIMA_IFN_FREE) = ZSVT(:,:,:,NSV_LIMA_IFN_FREE) * &
+ PRHODJ(:,:,:) / PTSTEP
+ PSVS(:,:,:,NSV_LIMA_IFN_FREE+1) = ZSVT(:,:,:,NSV_LIMA_IFN_FREE+1) * &
+ PRHODJ(:,:,:) / PTSTEP
+
+DEALLOCATE(ZSVT)
+END IF
+
+!UPG*PT
+!
+!
+!* 2. TRANSFORMATION INTO PHYSICAL TENDENCIES
+! ---------------------------------------
+!
+PTHS(:,:,:) = PTHS(:,:,:) / PRHODJ(:,:,:)
+DO JRR = 1,KRR
+ PRS(:,:,:,JRR) = PRS(:,:,:,JRR) / PRHODJ(:,:,:)
+END DO
+!
+IF (HCLOUD=='C2R2' .OR. HCLOUD=='C3R5' .OR. HCLOUD=='KHKO' .OR. HCLOUD=='LIMA') THEN
+ DO JSV = ISVBEG, ISVEND
+ PSVS(:,:,:,JSV) = PSVS(:,:,:,JSV) / PRHODJ(:,:,:)
+ ENDDO
+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,:,:)
+END DO
+!
+! complete the physical boundaries to avoid some computations
+!
+IF(GWEST .AND. HLBCX(1) /= 'CYCL') PRT(:IIB-1,:,:,2:) = 0.0
+IF(GEAST .AND. HLBCX(2) /= 'CYCL') PRT(IIE+1:,:,:,2:) = 0.0
+IF(GSOUTH .AND. HLBCY(1) /= 'CYCL') PRT(:,:IJB-1,:,2:) = 0.0
+IF(GNORTH .AND. HLBCY(2) /= 'CYCL') PRT(:,IJE+1:,:,2:) = 0.0
+!
+IF (HCLOUD=='C2R2' .OR. HCLOUD=='C3R5' .OR. HCLOUD=='KHKO' .OR. HCLOUD=='LIMA') THEN
+DO JI=1,JPHEXT
+ PSVS(JI, :, :, ISVBEG:ISVEND) = PSVS(IIB, :, :, ISVBEG:ISVEND)
+ PSVS(IIE+JI, :, :, ISVBEG:ISVEND) = PSVS(IIE, :, :, ISVBEG:ISVEND)
+ PSVS(:, JI, :, ISVBEG:ISVEND) = PSVS(:, IJB, :, ISVBEG:ISVEND)
+ PSVS(:, IJE+JI, :, ISVBEG:ISVEND) = PSVS(:, IJE, :, ISVBEG:ISVEND)
+END DO
+ !
+! complete the physical boundaries to avoid some computations
+!
+ IF(GWEST .AND. HLBCX(1) /= 'CYCL') PSVT(:IIB-1, :, :, ISVBEG:ISVEND) = 0.0
+ IF(GEAST .AND. HLBCX(2) /= 'CYCL') PSVT(IIE+1:, :, :, ISVBEG:ISVEND) = 0.0
+ IF(GSOUTH .AND. HLBCY(1) /= 'CYCL') PSVT(:, :IJB-1, :, ISVBEG:ISVEND) = 0.0
+ IF(GNORTH .AND. HLBCY(2) /= 'CYCL') PSVT(:, IJE+1:, :, ISVBEG:ISVEND) = 0.0
+ENDIF
+!
+! complete the vertical boundaries
+!
+PTHS(:,:,IKB-1) = PTHS(:,:,IKB)
+PTHS(:,:,IKE+1) = PTHS(:,:,IKE)
+!
+PRS(:,:,IKB-1,:) = PRS(:,:,IKB,:)
+PRS(:,:,IKE+1,:) = PRS(:,:,IKE,:)
+!
+PRT(:,:,IKB-1,:) = PRT(:,:,IKB,:)
+PRT(:,:,IKE+1,:) = PRT(:,:,IKE,:)
+!
+IF (HCLOUD == 'C2R2' .OR. HCLOUD == 'C3R5' .OR. HCLOUD == 'KHKO' &
+ .OR. HCLOUD == 'LIMA') THEN
+ PSVS(:,:,IKB-1,ISVBEG:ISVEND) = PSVS(:,:,IKB,ISVBEG:ISVEND)
+ PSVS(:,:,IKE+1,ISVBEG:ISVEND) = PSVS(:,:,IKE,ISVBEG:ISVEND)
+ PSVT(:,:,IKB-1,ISVBEG:ISVEND) = PSVT(:,:,IKB,ISVBEG:ISVEND)
+ PSVT(:,:,IKE+1,ISVBEG:ISVEND) = PSVT(:,:,IKE,ISVBEG:ISVEND)
+ENDIF
+!
+!
+!* 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 )
+!
+!* 3.4 Limitations of Na and Nc to the CCN max number concentration
+!
+! 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
+!
+!
+!-------------------------------------------------------------------------------
+!
+SELECT CASE ( HCLOUD )
+ CASE ('REVE')
+!
+!* 4. REVERSIBLE MICROPHYSICAL SCHEME
+! -------------------------------
+!
+ CALL FAST_TERMS ( KRR, KMI, HRAD, HTURBDIM, &
+ HSCONV, HMF_CLOUD, OSUBG_COND, PTSTEP, &
+ PRHODJ, PSIGS, PPABST, &
+ PCF_MF,PRC_MF, &
+ PRVT=PRT(:,:,:,1), PRCT=PRT(:,:,:,2), &
+ PRVS=PRS(:,:,:,1), PRCS=PRS(:,:,:,2), &
+ PTHS=PTHS, PSRCS=PSRCS, PCLDFR=PCLDFR )
+!
+ CASE ('KESS')
+!
+!* 5. KESSLER MICROPHYSICAL SCHEME
+! ----------------------------
+!
+!
+!* 5.1 Compute the explicit microphysical sources
+!
+ CALL SLOW_TERMS ( KSPLITR, PTSTEP, KMI, HSUBG_AUCV, &
+ PZZ, PRHODJ, PRHODREF, PCLDFR, &
+ PTHT, PRT(:,:,:,1), PRT(:,:,:,2), PRT(:,:,:,3), PPABST, &
+ PTHS, PRS(:,:,:,1), PRS(:,:,:,2), PRS(:,:,:,3), &
+ PINPRR, PINPRR3D, PEVAP3D )
+!
+!* 5.2 Perform the saturation adjustment
+!
+ CALL FAST_TERMS ( KRR, KMI, HRAD, HTURBDIM, &
+ HSCONV, HMF_CLOUD, OSUBG_COND, PTSTEP, &
+ PRHODJ, PSIGS, PPABST, &
+ PCF_MF,PRC_MF, &
+ PRVT=PRT(:,:,:,1), PRCT=PRT(:,:,:,2), &
+ PRVS=PRS(:,:,:,1), PRCS=PRS(:,:,:,2), PRRS=PRS(:,:,:,3), &
+ PTHS=PTHS, PSRCS=PSRCS, PCLDFR=PCLDFR )
+!
+!
+ CASE ('C2R2','KHKO')
+!
+!* 7. 2-MOMENT WARM MICROPHYSICAL SCHEME C2R2 or KHKO
+! ---------------------------------------
+!
+!
+!* 7.1 Compute the explicit microphysical sources
+!
+!
+ CALL RAIN_C2R2_KHKO ( HCLOUD, OACTIT, OSEDC, ORAIN, KSPLITR, PTSTEP, KMI, &
+ TPFILE, PZZ, PRHODJ, PRHODREF, PEXNREF, &
+ PPABST, PTHT, PRT(:,:,:,1), PRT(:,:,:,2), PRT(:,:,:,3), &
+ PTHM, PRCM, PPABSTT, &
+ PW_ACT,PDTHRAD,PTHS, PRS(:,:,:,1),PRS(:,:,:,2),PRS(:,:,:,3), &
+ PSVT(:,:,:,NSV_C2R2BEG), PSVT(:,:,:,NSV_C2R2BEG+1), &
+ PSVT(:,:,:,NSV_C2R2BEG+2), PSVS(:,:,:,NSV_C2R2BEG), &
+ PSVS(:,:,:,NSV_C2R2BEG+1), PSVS(:,:,:,NSV_C2R2BEG+2), &
+ PINPRC, PINPRR, PINPRR3D, PEVAP3D , &
+ PSVT(:,:,:,:), PSOLORG, PMI, HACTCCN, &
+ PINDEP, PSUPSAT, PNACT )
+!
+!
+!* 7.2 Perform the saturation adjustment
+!
+ IF (LSUPSAT) THEN
+ CALL KHKO_NOTADJUST (KRR, KTCOUNT,TPFILE, HRAD, &
+ PTSTEP, PRHODJ, PPABSTT, PPABST, PRHODREF, PZZ, &
+ PTHT,PRT(:,:,:,1),PRT(:,:,:,2),PRT(:,:,:,3), &
+ PTHS,PRS(:,:,:,1),PRS(:,:,:,2),PRS(:,:,:,3), &
+ PSVS(:,:,:,NSV_C2R2BEG+1), PSVS(:,:,:,NSV_C2R2BEG), &
+ PSVS(:,:,:,NSV_C2R2BEG+3), PCLDFR, PSRCS, PNPRO, PSSPRO )
+!
+ ELSE
+ CALL C2R2_ADJUST ( KRR,TPFILE, HRAD, &
+ HTURBDIM, OSUBG_COND, PTSTEP, &
+ PRHODJ, PSIGS, PPABST, &
+ PTHS=PTHS, PRVS=PRS(:,:,:,1), PRCS=PRS(:,:,:,2), &
+ PCNUCS=PSVS(:,:,:,NSV_C2R2BEG), &
+ PCCS=PSVS(:,:,:,NSV_C2R2BEG+1), &
+ PSRCS=PSRCS, PCLDFR=PCLDFR, PRRS=PRS(:,:,:,3) )
+!
+ END IF
+!
+ CASE ('ICE3')
+!
+!* 9. MIXED-PHASE MICROPHYSICAL SCHEME (WITH 3 ICE SPECIES)
+! -----------------------------------------------------
+!
+ allocate( zexn( size( pzz, 1 ), size( pzz, 2 ), size( pzz, 3 ) ) )
+ ZEXN(:,:,:)= (PPABST(:,:,:)/CST%XP00)**(CST%XRD/CST%XCPD)
+!
+!* 9.1 Compute the explicit microphysical sources
+!
+!
+ DO JK=IKB,IKE
+ ZDZZ(:,:,JK)=PZZ(:,:,JK+1)-PZZ(:,:,JK)
+ ENDDO
+ ZZZ = MZF( PZZ )
+ IF(LRED .AND. LADJ_BEFORE) THEN
+ CALL ICE_ADJUST (YLDIMPHYEX,CST, RAIN_ICE_PARAM, NEB, TURBN, TBUCONF, KRR, &
+ CFRAC_ICE_ADJUST, &
+ 'ADJU', .FALSE., .FALSE., &
+ 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 )
+ ENDIF
+ IF (LRED) THEN
+ CALL RAIN_ICE (YLDIMPHYEX,CST, PARAM_ICE, RAIN_ICE_PARAM, RAIN_ICE_DESCR,TBUCONF,&
+ 0, .FALSE., HSUBG_AUCV, CSUBG_AUCV_RI, &
+ 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 )
+ 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
+
+!
+!* 9.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_PARAM, NEB, TURBN, TBUCONF, KRR, &
+ CFRAC_ICE_ADJUST, &
+ 'DEPI', .FALSE., .FALSE., &
+ 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 )
+ END IF
+
+ deallocate( zexn )
+!
+ CASE ('ICE4')
+!
+!* 10. MIXED-PHASE MICROPHYSICAL SCHEME (WITH 4 ICE SPECIES)
+! -----------------------------------------------------
+!
+ allocate( zexn( size( pzz, 1 ), size( pzz, 2 ), size( pzz, 3 ) ) )
+ ZEXN(:,:,:)= (PPABST(:,:,:)/CST%XP00)**(CST%XRD/CST%XCPD)
+!
+!* 10.1 Compute the explicit microphysical sources
+!
+!
+ DO JK=IKB,IKE
+ ZDZZ(:,:,JK)=PZZ(:,:,JK+1)-PZZ(:,:,JK)
+ ENDDO
+ ZZZ = MZF( PZZ )
+ IF(LRED .AND. LADJ_BEFORE) THEN
+ CALL ICE_ADJUST (YLDIMPHYEX,CST, RAIN_ICE_PARAM, NEB, TURBN, TBUCONF, KRR, &
+ CFRAC_ICE_ADJUST, &
+ 'ADJU', .FALSE., .FALSE., &
+ 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 )
+ ENDIF
+ IF (LRED) THEN
+ CALL RAIN_ICE (YLDIMPHYEX,CST, PARAM_ICE, RAIN_ICE_PARAM, RAIN_ICE_DESCR,TBUCONF,&
+ 0, .FALSE., HSUBG_AUCV, CSUBG_AUCV_RI, &
+ 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 )
+ 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, &
+ 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_PARAM, NEB, TURBN, TBUCONF, KRR, &
+ CFRAC_ICE_ADJUST, &
+ 'DEPI', .FALSE., .FALSE., &
+ 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 )
+ END IF
+
+ deallocate( zexn )
+!
+!
+!* 12. 2-MOMENT MIXED-PHASE MICROPHYSICAL SCHEME LIMA
+! --------------------------------------------------------------
+!
+!
+!* 12.1 Compute the explicit microphysical sources
+!
+ CASE ('LIMA')
+ !
+ DO JK=IKB,IKE
+ ZDZZ(:,:,JK)=PZZ(:,:,JK+1)-PZZ(:,:,JK)
+ ENDDO
+ ZZZ = MZF( PZZ )
+ IF (LPTSPLIT) THEN
+ CALL LIMA (YLDIMPHYEX,CST,TBUCONF,TBUDGETS,SIZE(TBUDGETS), &
+ PTSTEP, &
+ 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 )
+ 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
+!
+END SELECT
+!
+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
+ PCIT(:,:,1) = 0.
+ PCIT(:,:,IKE+1) = 0.
+
+ PINPRC3D=ZFPR(:,:,:,2) / CST%XRHOLW
+ PINPRR3D=ZFPR(:,:,:,3) / CST%XRHOLW
+ PINPRS3D=ZFPR(:,:,:,5) / CST%XRHOLW
+ PINPRG3D=ZFPR(:,:,:,6) / CST%XRHOLW
+ IF(KRR==7) PINPRH3D=ZFPR(:,:,:,7) / CST%XRHOLW
+ WHERE (PRT(:,:,:,2) > 1.E-04 )
+ PSPEEDC=ZFPR(:,:,:,2) / (PRT(:,:,:,2) * PRHODREF(:,:,:))
+ ENDWHERE
+ WHERE (PRT(:,:,:,3) > 1.E-04 )
+ PSPEEDR=ZFPR(:,:,:,3) / (PRT(:,:,:,3) * PRHODREF(:,:,:))
+ ENDWHERE
+ WHERE (PRT(:,:,:,5) > 1.E-04 )
+ PSPEEDS=ZFPR(:,:,:,5) / (PRT(:,:,:,5) * PRHODREF(:,:,:))
+ ENDWHERE
+ WHERE (PRT(:,:,:,6) > 1.E-04 )
+ PSPEEDG=ZFPR(:,:,:,6) / (PRT(:,:,:,6) * PRHODREF(:,:,:))
+ ENDWHERE
+ IF(KRR==7) THEN
+ WHERE (PRT(:,:,:,7) > 1.E-04 )
+ PSPEEDH=ZFPR(:,:,:,7) / (PRT(:,:,:,7) * PRHODREF(:,:,:))
+ 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 )
+
+!-------------------------------------------------------------------------------
+!
+!
+!* 13. SWITCH BACK TO THE PROGNOSTIC VARIABLES
+! ---------------------------------------
+!
+PTHS(:,:,:) = PTHS(:,:,:) * PRHODJ(:,:,:)
+!
+DO JRR = 1,KRR
+ PRS(:,:,:,JRR) = PRS(:,:,:,JRR) * PRHODJ(:,:,:)
+END DO
+!
+IF (HCLOUD=='C2R2' .OR. HCLOUD=='C3R5' .OR. HCLOUD=='KHKO' .OR. HCLOUD=='LIMA') THEN
+ DO JSV = ISVBEG, ISVEND
+ PSVS(:,:,:,JSV) = PSVS(:,:,:,JSV) * PRHODJ(:,:,:)
+ ENDDO
+ENDIF
+
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE RESOLVED_CLOUD
diff --git a/src/PHYEX/micro/ice_adjust.f90 b/src/PHYEX/micro/ice_adjust.f90
index deec98d8ef92cda88971c6eb49b4b497ea1caac5..e2981ff0107fa5d87b62c408022608aa35e95ca8 100644
--- a/src/PHYEX/micro/ice_adjust.f90
+++ b/src/PHYEX/micro/ice_adjust.f90
@@ -118,7 +118,7 @@ USE MODD_TURB_n, ONLY: TURB_t
USE MODD_BUDGET, ONLY: TBUDGETDATA, TBUDGETCONF_t, NBUDGET_TH, NBUDGET_RV, NBUDGET_RC, NBUDGET_RI
USE MODD_RAIN_ICE_PARAM, ONLY : RAIN_ICE_PARAM_t
!
-USE MODE_BUDGET, ONLY: BUDGET_STORE_INIT_PHY, BUDGET_STORE_END_PHY
+USE MODE_BUDGET_PHY, ONLY: BUDGET_STORE_INIT_PHY, BUDGET_STORE_END_PHY
!
USE MODI_CONDENSATION
!
diff --git a/src/PHYEX/micro/ini_lima.f90 b/src/PHYEX/micro/ini_lima.f90
index 54c784e641111c8f83b00b5063f2006b38eb8569..6f4bdcd0015f42e8c770bac6981c0542eb09ee4a 100644
--- a/src/PHYEX/micro/ini_lima.f90
+++ b/src/PHYEX/micro/ini_lima.f90
@@ -55,7 +55,7 @@ USE MODD_CST
USE MODD_REF
USE MODD_PARAM_LIMA
USE MODD_PARAMETERS
-USE MODD_LUNIT, ONLY : TLUOUT0
+!USE MODD_LUNIT, ONLY : TLUOUT0
!
IMPLICIT NONE
!
@@ -88,7 +88,7 @@ INTEGER :: IRESP ! Return code of FM-routines
!
!
! Init output listing
-ILUOUT0 = TLUOUT0%NLU
+!ILUOUT0 = TLUOUT0%NLU
!
!
ZVTRMAX(2) = 0.3 ! Maximum cloud droplet fall speed
diff --git a/src/PHYEX/micro/ini_lima_cold_mixed.f90 b/src/PHYEX/micro/ini_lima_cold_mixed.f90
index 2e3d956a46102eb75e5707369aed815f7f9bb798..55303431f6c033e1ae31ab923f02f13b7570af5a 100644
--- a/src/PHYEX/micro/ini_lima_cold_mixed.f90
+++ b/src/PHYEX/micro/ini_lima_cold_mixed.f90
@@ -51,32 +51,30 @@ END MODULE MODI_INI_LIMA_COLD_MIXED
! ------------
!
USE MODD_CST
-USE MODD_LUNIT, ONLY: TLUOUT0
+!USE MODD_LUNIT, ONLY: TLUOUT0
USE MODD_PARAMETERS
USE MODD_PARAM_LIMA
USE MODD_PARAM_LIMA_WARM
USE MODD_PARAM_LIMA_COLD
USE MODD_PARAM_LIMA_MIXED
-USE MODD_RAIN_ICE_PARAM, ONLY: XALPHA1, XALPHA2, XBETA1, XBETA2, IMNU0=>XMNU0, XNU10, XNU20, &
- RAIN_ICE_PARAM_ASSOCIATE
USE MODD_REF
!
use mode_msg
!
-USE MODI_LIMA_FUNCTIONS
+USE MODE_LIMA_FUNCTIONS, ONLY: MOMG, GAUHER
USE MODI_GAMMA
USE MODI_GAMMA_INC
USE MODE_RRCOLSS, ONLY: RRCOLSS
USE MODE_RZCOLX, ONLY: RZCOLX
USE MODE_RSCOLRG, ONLY: RSCOLRG
-USE MODI_NRCOLSS
-USE MODI_NZCOLX
-USE MODI_NSCOLRG
-USE MODI_LIMA_READ_XKER_RACCS
-USE MODI_LIMA_READ_XKER_SDRYG
-USE MODI_LIMA_READ_XKER_RDRYG
-USE MODI_LIMA_READ_XKER_SWETH
-USE MODI_LIMA_READ_XKER_GWETH
+USE MODE_NRCOLSS, ONLY: NRCOLSS
+USE MODE_NZCOLX, ONLY: NZCOLX
+USE MODE_NSCOLRG, ONLY: NSCOLRG
+USE MODE_LIMA_READ_XKER_RACCS, ONLY: LIMA_READ_XKER_RACCS
+USE MODE_LIMA_READ_XKER_SDRYG, ONLY: LIMA_READ_XKER_SDRYG
+USE MODE_LIMA_READ_XKER_RDRYG, ONLY: LIMA_READ_XKER_RDRYG
+USE MODE_LIMA_READ_XKER_SWETH, ONLY: LIMA_READ_XKER_SWETH
+USE MODE_LIMA_READ_XKER_GWETH, ONLY: LIMA_READ_XKER_GWETH
!
IMPLICIT NONE
!
@@ -109,9 +107,9 @@ REAL :: ZESR, ZESS ! Mean efficiency of rain-aggregate collection, ag
REAL :: ZFDINFTY ! Factor used to define the "infinite" diameter
!
!
-INTEGER :: ILUOUT0 ! Logical unit number for output-listing
-LOGICAL :: GFLAG ! Logical flag for printing the constatnts on the output
- ! listing
+!INTEGER :: ILUOUT0 ! Logical unit number for output-listing
+!LOGICAL :: GFLAG ! Logical flag for printing the constatnts on the output
+! ! listing
REAL :: ZCONC_MAX ! Maximal concentration for snow
REAL :: ZFACT_NUCL! Amplification factor for the minimal ice concentration
!
@@ -150,13 +148,13 @@ REAL :: ZRHOIW ! ice density
!-------------------------------------------------------------------------------
!
!
-ILUOUT0 = TLUOUT0%NLU
+!ILUOUT0 = TLUOUT0%NLU
!
!
!* 1. CHARACTERISTICS OF THE SPECIES
! ------------------------------
!
-CALL RAIN_ICE_PARAM_ASSOCIATE()
+!CALL RAIN_ICE_PARAM_ASSOCIATE()
!
!* 1.2 Ice crystal characteristics
!
@@ -334,14 +332,14 @@ ELSE
XLBH = XAH * MOMG(XALPHAH,XNUH,XBH)
END IF
!
-GFLAG = .TRUE.
-IF (GFLAG) THEN
- WRITE(UNIT=ILUOUT0,FMT='(" Shape Parameters")')
- WRITE(UNIT=ILUOUT0,FMT='(" XLBEXI =",E13.6," XLBI =",E13.6)') XLBEXI,XLBI
- WRITE(UNIT=ILUOUT0,FMT='(" XLBEXS =",E13.6," XLBS =",E13.6)') XLBEXS,XLBS
- WRITE(UNIT=ILUOUT0,FMT='(" XLBEXG =",E13.6," XLBG =",E13.6)') XLBEXG,XLBG
- WRITE(UNIT=ILUOUT0,FMT='(" XLBEXH =",E13.6," XLBH =",E13.6)') XLBEXH,XLBH
-END IF
+!!$GFLAG = .TRUE.
+!!$IF (GFLAG) THEN
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" Shape Parameters")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" XLBEXI =",E13.6," XLBI =",E13.6)') XLBEXI,XLBI
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" XLBEXS =",E13.6," XLBS =",E13.6)') XLBEXS,XLBS
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" XLBEXG =",E13.6," XLBG =",E13.6)') XLBEXG,XLBG
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" XLBEXH =",E13.6," XLBH =",E13.6)') XLBEXH,XLBH
+!!$END IF
!
XLBDAS_MAX = 1.E7 ! (eq to r~1E-7kg/kg) (for non MP PSD, use conversion XTRANS_MP_GAMMAS)
XLBDAS_MIN = 1. ! (eq to r~0.18kg/kg) (for non MP PSD, use conversion XTRANS_MP_GAMMAS)
@@ -593,14 +591,14 @@ XEX_CON = -2.8
!
XMNU0 = 6.88E-13
!
-IF (LMEYERS) THEN
- WRITE(UNIT=ILUOUT0,FMT='(" Heterogeneous nucleation")')
- WRITE(UNIT=ILUOUT0,FMT='(" XNUC_DEP=",E13.6," XEXSI=",E13.6," XEX=",E13.6)') &
- XNUC_DEP,XEXSI_DEP,XEX_DEP
- WRITE(UNIT=ILUOUT0,FMT='(" XNUC_CON=",E13.6," XEXTT=",E13.6," XEX=",E13.6)') &
- XNUC_CON,XEXTT_CON,XEX_CON
- WRITE(UNIT=ILUOUT0,FMT='(" mass of embryo XMNU0=",E13.6)') XMNU0
-END IF
+!!$IF (LMEYERS) THEN
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" Heterogeneous nucleation")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" XNUC_DEP=",E13.6," XEXSI=",E13.6," XEX=",E13.6)') &
+!!$ XNUC_DEP,XEXSI_DEP,XEX_DEP
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" XNUC_CON=",E13.6," XEXTT=",E13.6," XEX=",E13.6)') &
+!!$ XNUC_CON,XEXTT_CON,XEX_CON
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" mass of embryo XMNU0=",E13.6)') XMNU0
+!!$END IF
!
! *****************
!* 4.3 NUCLEATION for NMOM_I=1
@@ -614,7 +612,7 @@ XNU20 = 1000.*ZFACT_NUCL
XALPHA2 = 12.96
XBETA2 = 0.639
!
-IMNU0 = 6.88E-13
+!XMNU0 = 6.88E-13
!-------------------------------------------------------------------------------
!
!
@@ -655,16 +653,16 @@ ELSE
'/= 3. No algorithm developed for this case' )
END IF
!
-GFLAG = .TRUE.
-IF (GFLAG) THEN
- WRITE(UNIT=ILUOUT0,FMT='(" Homogeneous nucleation")')
- WRITE(UNIT=ILUOUT0,FMT='(" XTEXP1_HONC=",E13.6)') XTEXP1_HONC
- WRITE(UNIT=ILUOUT0,FMT='(" XTEXP2_HONC=",E13.6)') XTEXP2_HONC
- WRITE(UNIT=ILUOUT0,FMT='(" XTEXP3_HONC=",E13.6)') XTEXP3_HONC
- WRITE(UNIT=ILUOUT0,FMT='(" XTEXP4_HONC=",E13.6)') XTEXP4_HONC
- WRITE(UNIT=ILUOUT0,FMT='(" XTEXP5_HONC=",E13.6)') XTEXP5_HONC
- WRITE(UNIT=ILUOUT0,FMT='("XC_HONC=",E13.6," XR_HONC=",E13.6)') XC_HONC,XR_HONC
-END IF
+!!$GFLAG = .TRUE.
+!!$IF (GFLAG) THEN
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" Homogeneous nucleation")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" XTEXP1_HONC=",E13.6)') XTEXP1_HONC
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" XTEXP2_HONC=",E13.6)') XTEXP2_HONC
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" XTEXP3_HONC=",E13.6)') XTEXP3_HONC
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" XTEXP4_HONC=",E13.6)') XTEXP4_HONC
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" XTEXP5_HONC=",E13.6)') XTEXP5_HONC
+!!$ WRITE(UNIT=ILUOUT0,FMT='("XC_HONC=",E13.6," XR_HONC=",E13.6)') XC_HONC,XR_HONC
+!!$END IF
!
!
!* 5.2 Constants for vapor deposition on ice
@@ -756,11 +754,11 @@ XCOLEXII = 0.025 ! Temperature factor of the I+I collection efficiency
!
XTEXAUTI = 0.025 ! Temperature factor of the I+I collection efficiency
!
-GFLAG = .TRUE.
-IF (GFLAG) THEN
- WRITE(UNIT=ILUOUT0,FMT='(" pristine ice autoconversion")')
- WRITE(UNIT=ILUOUT0,FMT='(" Temp. factor XTEXAUTI=",E13.6)') XTEXAUTI
-END IF
+!!$GFLAG = .TRUE.
+!!$IF (GFLAG) THEN
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" pristine ice autoconversion")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" Temp. factor XTEXAUTI=",E13.6)') XTEXAUTI
+!!$END IF
!
XAUTO3 = 6.25E18*(ZGAMI(2))**(1./3.)*SQRT(ZGAMI(4))
XAUTO4 = 0.5E6*(ZGAMI(4))**(1./6.)
@@ -780,11 +778,11 @@ XAGGS_CLARGE2 = XKER_ZRNIC_A2*ZGAMS(2)
XAGGS_RLARGE1 = XKER_ZRNIC_A2*ZGAMI(6)*XAI
XAGGS_RLARGE2 = XKER_ZRNIC_A2*ZGAMI(7)*ZGAMS(2)*XAI
!
-GFLAG = .TRUE.
-IF (GFLAG) THEN
- WRITE(UNIT=ILUOUT0,FMT='(" snow aggregation")')
- WRITE(UNIT=ILUOUT0,FMT='(" Temp. factor XCOLEXIS=",E13.6)') XCOLEXIS
-END IF
+!!$GFLAG = .TRUE.
+!!$IF (GFLAG) THEN
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" snow aggregation")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" Temp. factor XCOLEXIS=",E13.6)') XCOLEXIS
+!!$END IF
!
!-------------------------------------------------------------------------------
!
@@ -809,13 +807,13 @@ XEXSRIMCG= -XBS
XSRIMCG2 = XAG*MOMG(XALPHAS,XNUS,XBG)
XSRIMCG3 = 0.1
XEXSRIMCG2=XBG
-GFLAG = .TRUE.
-IF (GFLAG) THEN
- WRITE(UNIT=ILUOUT0,FMT='(" riming of the aggregates")')
- WRITE(UNIT=ILUOUT0,FMT='(" D_cs^lim (Farley et al.) XDCSLIM=",E13.6)') XDCSLIM
- WRITE(UNIT=ILUOUT0,FMT='(" Coll. efficiency XCOLCS=",E13.6)') XCOLCS
-END IF
-!
+!!$GFLAG = .TRUE.
+!!$IF (GFLAG) THEN
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" riming of the aggregates")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" D_cs^lim (Farley et al.) XDCSLIM=",E13.6)') XDCSLIM
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" Coll. efficiency XCOLCS=",E13.6)') XCOLCS
+!!$END IF
+!!$!
NGAMINC = 80
XGAMINC_BOUND_MIN = (1000.*XTRANS_MP_GAMMAS*XDCSLIM)**XALPHAS !1.0E-1 ! Minimal value of (Lbda * D_cs^lim)**alpha
XGAMINC_BOUND_MAX = (50000.*XTRANS_MP_GAMMAS*XDCSLIM)**XALPHAS !1.0E7 ! Maximal value of (Lbda * D_cs^lim)**alpha
@@ -929,33 +927,33 @@ CALL NSCOLRG ( IND, XALPHAS, XNUS, XALPHAR, XNUR, &
ZESR, XCS, XDS, XFVELOS, XCR, XDR, &
XACCLBDAS_MAX, XACCLBDAR_MAX, XACCLBDAS_MIN, XACCLBDAR_MIN, &
ZFDINFTY, XKER_N_SACCRG,XAG, XBS, XAS )
-WRITE(UNIT=ILUOUT0,FMT='("!")')
-WRITE(UNIT=ILUOUT0,FMT='("IF( PRESENT(PKER_N_RACCSS) ) THEN")')
-DO J1 = 1 , NACCLBDAS
- DO J2 = 1 , NACCLBDAR
- WRITE(UNIT=ILUOUT0,FMT='(" PKER_N_RACCSS(",I3,",",I3,") = ",E13.6)') &
- J1,J2,XKER_N_RACCSS(J1,J2)
- END DO
-END DO
-WRITE(UNIT=ILUOUT0,FMT='("!")')
-WRITE(UNIT=ILUOUT0,FMT='("!")')
-WRITE(UNIT=ILUOUT0,FMT='("IF( PRESENT(PKER_N_RACCS) ) THEN")')
-DO J1 = 1 , NACCLBDAS
- DO J2 = 1 , NACCLBDAR
- WRITE(UNIT=ILUOUT0,FMT='(" PKER_N_RACCS(",I3,",",I3,") = ",E13.6)') &
- J1,J2,XKER_N_RACCS(J1,J2)
- END DO
-END DO
-WRITE(UNIT=ILUOUT0,FMT='("!")')
-WRITE(UNIT=ILUOUT0,FMT='("!")')
-WRITE(UNIT=ILUOUT0,FMT='("IF( PRESENT(PKER_N_SACCRG) ) THEN")')
-DO J1 = 1 , NACCLBDAR
- DO J2 = 1 , NACCLBDAS
- WRITE(UNIT=ILUOUT0,FMT='(" PKER_N_SACCRG(",I3,",",I3,") = ",E13.6)') &
- J1,J2,XKER_N_SACCRG(J1,J2)
- END DO
-END DO
-WRITE(UNIT=ILUOUT0,FMT='("!")')
+!!$WRITE(UNIT=ILUOUT0,FMT='("!")')
+!!$WRITE(UNIT=ILUOUT0,FMT='("IF( PRESENT(PKER_N_RACCSS) ) THEN")')
+!!$DO J1 = 1 , NACCLBDAS
+!!$ DO J2 = 1 , NACCLBDAR
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" PKER_N_RACCSS(",I3,",",I3,") = ",E13.6)') &
+!!$ J1,J2,XKER_N_RACCSS(J1,J2)
+!!$ END DO
+!!$END DO
+!!$WRITE(UNIT=ILUOUT0,FMT='("!")')
+!!$WRITE(UNIT=ILUOUT0,FMT='("!")')
+!!$WRITE(UNIT=ILUOUT0,FMT='("IF( PRESENT(PKER_N_RACCS) ) THEN")')
+!!$DO J1 = 1 , NACCLBDAS
+!!$ DO J2 = 1 , NACCLBDAR
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" PKER_N_RACCS(",I3,",",I3,") = ",E13.6)') &
+!!$ J1,J2,XKER_N_RACCS(J1,J2)
+!!$ END DO
+!!$END DO
+!!$WRITE(UNIT=ILUOUT0,FMT='("!")')
+!!$WRITE(UNIT=ILUOUT0,FMT='("!")')
+!!$WRITE(UNIT=ILUOUT0,FMT='("IF( PRESENT(PKER_N_SACCRG) ) THEN")')
+!!$DO J1 = 1 , NACCLBDAR
+!!$ DO J2 = 1 , NACCLBDAS
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" PKER_N_SACCRG(",I3,",",I3,") = ",E13.6)') &
+!!$ J1,J2,XKER_N_SACCRG(J1,J2)
+!!$ END DO
+!!$END DO
+!!$WRITE(UNIT=ILUOUT0,FMT='("!")')
!
CALL LIMA_READ_XKER_RACCS (KACCLBDAS,KACCLBDAR,KND, &
@@ -982,71 +980,71 @@ IF( (KACCLBDAS/=NACCLBDAS) .OR. (KACCLBDAR/=NACCLBDAR) .OR. (KND/=IND) .OR. &
ZESR, XBS, XCS, XDS, XFVELOS, XCR, XDR, &
XACCLBDAS_MAX, XACCLBDAR_MAX, XACCLBDAS_MIN, XACCLBDAR_MIN, &
ZFDINFTY, XKER_SACCRG,XAG, XBS, XAS )
- WRITE(UNIT=ILUOUT0,FMT='("*****************************************")')
- WRITE(UNIT=ILUOUT0,FMT='("**** UPDATE NEW SET OF RACSS KERNELS ****")')
- WRITE(UNIT=ILUOUT0,FMT='("**** UPDATE NEW SET OF RACS KERNELS ****")')
- WRITE(UNIT=ILUOUT0,FMT='("**** UPDATE NEW SET OF SACRG KERNELS ****")')
- WRITE(UNIT=ILUOUT0,FMT='("*****************************************")')
- WRITE(UNIT=ILUOUT0,FMT='("!")')
- WRITE(UNIT=ILUOUT0,FMT='("KND=",I3)') IND
- WRITE(UNIT=ILUOUT0,FMT='("KACCLBDAS=",I3)') NACCLBDAS
- WRITE(UNIT=ILUOUT0,FMT='("KACCLBDAR=",I3)') NACCLBDAR
- WRITE(UNIT=ILUOUT0,FMT='("PALPHAS=",E13.6)') XALPHAS
- WRITE(UNIT=ILUOUT0,FMT='("PNUS=",E13.6)') XNUS
- WRITE(UNIT=ILUOUT0,FMT='("PALPHAR=",E13.6)') XALPHAR
- WRITE(UNIT=ILUOUT0,FMT='("PNUR=",E13.6)') XNUR
- WRITE(UNIT=ILUOUT0,FMT='("PESR=",E13.6)') ZESR
- WRITE(UNIT=ILUOUT0,FMT='("PBS=",E13.6)') XBS
- WRITE(UNIT=ILUOUT0,FMT='("PBR=",E13.6)') XBR
- WRITE(UNIT=ILUOUT0,FMT='("PCS=",E13.6)') XCS
- WRITE(UNIT=ILUOUT0,FMT='("PDS=",E13.6)') XDS
- WRITE(UNIT=ILUOUT0,FMT='("PFVELOS=",E13.6)') XFVELOS
- WRITE(UNIT=ILUOUT0,FMT='("PCR=",E13.6)') XCR
- WRITE(UNIT=ILUOUT0,FMT='("PDR=",E13.6)') XDR
- WRITE(UNIT=ILUOUT0,FMT='("PACCLBDAS_MAX=",E13.6)') &
- XACCLBDAS_MAX
- WRITE(UNIT=ILUOUT0,FMT='("PACCLBDAR_MAX=",E13.6)') &
- XACCLBDAR_MAX
- WRITE(UNIT=ILUOUT0,FMT='("PACCLBDAS_MIN=",E13.6)') &
- XACCLBDAS_MIN
- WRITE(UNIT=ILUOUT0,FMT='("PACCLBDAR_MIN=",E13.6)') &
- XACCLBDAR_MIN
- WRITE(UNIT=ILUOUT0,FMT='("PFDINFTY=",E13.6)') ZFDINFTY
- WRITE(UNIT=ILUOUT0,FMT='("!")')
- WRITE(UNIT=ILUOUT0,FMT='("IF( PRESENT(PKER_RACCSS) ) THEN")')
- DO J1 = 1 , NACCLBDAS
- DO J2 = 1 , NACCLBDAR
- WRITE(UNIT=ILUOUT0,FMT='(" PKER_RACCSS(",I3,",",I3,") = ",E13.6)') &
- J1,J2,XKER_RACCSS(J1,J2)
- END DO
- END DO
- WRITE(UNIT=ILUOUT0,FMT='("END IF")')
- WRITE(UNIT=ILUOUT0,FMT='("!")')
- WRITE(UNIT=ILUOUT0,FMT='("IF( PRESENT(PKER_RACCS ) ) THEN")')
- DO J1 = 1 , NACCLBDAS
- DO J2 = 1 , NACCLBDAR
- WRITE(UNIT=ILUOUT0,FMT='(" PKER_RACCS (",I3,",",I3,") = ",E13.6)') &
- J1,J2,XKER_RACCS (J1,J2)
- END DO
- END DO
- WRITE(UNIT=ILUOUT0,FMT='("END IF")')
- WRITE(UNIT=ILUOUT0,FMT='("!")')
- WRITE(UNIT=ILUOUT0,FMT='("IF( PRESENT(PKER_SACCRG) ) THEN")')
- DO J1 = 1 , NACCLBDAR
- DO J2 = 1 , NACCLBDAS
- WRITE(UNIT=ILUOUT0,FMT='(" PKER_SACCRG(",I3,",",I3,") = ",E13.6)') &
- J1,J2,XKER_SACCRG(J1,J2)
- END DO
- END DO
- WRITE(UNIT=ILUOUT0,FMT='("END IF")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='("*****************************************")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='("**** UPDATE NEW SET OF RACSS KERNELS ****")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='("**** UPDATE NEW SET OF RACS KERNELS ****")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='("**** UPDATE NEW SET OF SACRG KERNELS ****")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='("*****************************************")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='("!")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='("KND=",I3)') IND
+!!$ WRITE(UNIT=ILUOUT0,FMT='("KACCLBDAS=",I3)') NACCLBDAS
+!!$ WRITE(UNIT=ILUOUT0,FMT='("KACCLBDAR=",I3)') NACCLBDAR
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PALPHAS=",E13.6)') XALPHAS
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PNUS=",E13.6)') XNUS
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PALPHAR=",E13.6)') XALPHAR
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PNUR=",E13.6)') XNUR
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PESR=",E13.6)') ZESR
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PBS=",E13.6)') XBS
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PBR=",E13.6)') XBR
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PCS=",E13.6)') XCS
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PDS=",E13.6)') XDS
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PFVELOS=",E13.6)') XFVELOS
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PCR=",E13.6)') XCR
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PDR=",E13.6)') XDR
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PACCLBDAS_MAX=",E13.6)') &
+!!$ XACCLBDAS_MAX
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PACCLBDAR_MAX=",E13.6)') &
+!!$ XACCLBDAR_MAX
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PACCLBDAS_MIN=",E13.6)') &
+!!$ XACCLBDAS_MIN
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PACCLBDAR_MIN=",E13.6)') &
+!!$ XACCLBDAR_MIN
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PFDINFTY=",E13.6)') ZFDINFTY
+!!$ WRITE(UNIT=ILUOUT0,FMT='("!")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='("IF( PRESENT(PKER_RACCSS) ) THEN")')
+!!$ DO J1 = 1 , NACCLBDAS
+!!$ DO J2 = 1 , NACCLBDAR
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" PKER_RACCSS(",I3,",",I3,") = ",E13.6)') &
+!!$ J1,J2,XKER_RACCSS(J1,J2)
+!!$ END DO
+!!$ END DO
+!!$ WRITE(UNIT=ILUOUT0,FMT='("END IF")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='("!")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='("IF( PRESENT(PKER_RACCS ) ) THEN")')
+!!$ DO J1 = 1 , NACCLBDAS
+!!$ DO J2 = 1 , NACCLBDAR
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" PKER_RACCS (",I3,",",I3,") = ",E13.6)') &
+!!$ J1,J2,XKER_RACCS (J1,J2)
+!!$ END DO
+!!$ END DO
+!!$ WRITE(UNIT=ILUOUT0,FMT='("END IF")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='("!")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='("IF( PRESENT(PKER_SACCRG) ) THEN")')
+!!$ DO J1 = 1 , NACCLBDAR
+!!$ DO J2 = 1 , NACCLBDAS
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" PKER_SACCRG(",I3,",",I3,") = ",E13.6)') &
+!!$ J1,J2,XKER_SACCRG(J1,J2)
+!!$ END DO
+!!$ END DO
+!!$ WRITE(UNIT=ILUOUT0,FMT='("END IF")')
ELSE
CALL LIMA_READ_XKER_RACCS (KACCLBDAS,KACCLBDAR,KND, &
PALPHAS,PNUS,PALPHAR,PNUR,PESR,PBS,PBR,PCS,PDS,PFVELOS,PCR,PDR, &
PACCLBDAS_MAX,PACCLBDAR_MAX,PACCLBDAS_MIN,PACCLBDAR_MIN, &
PFDINFTY,XKER_RACCSS,XKER_RACCS,XKER_SACCRG )
- WRITE(UNIT=ILUOUT0,FMT='(" Read XKER_RACCSS")')
- WRITE(UNIT=ILUOUT0,FMT='(" Read XKER_RACCS ")')
- WRITE(UNIT=ILUOUT0,FMT='(" Read XKER_SACCRG")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" Read XKER_RACCSS")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" Read XKER_RACCS ")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" Read XKER_SACCRG")')
END IF
!
!* 7.2N Computations of the tabulated normalized kernels Snow Self Collection !!
@@ -1083,31 +1081,31 @@ XSCINTP2S = 1.0 - LOG( XSCLBDAS_MIN ) / ZRATE
XSCLBDAS_MAX, XSCLBDAS_MAX, XSCLBDAS_MIN, XSCLBDAS_MIN, &
ZFDINFTY, XKER_N_SSCS )
!
- WRITE(UNIT=ILUOUT0,FMT='("*****************************************")')
- WRITE(UNIT=ILUOUT0,FMT='("**** UPDATE NEW SET OF SSCS KERNELS ***")')
- WRITE(UNIT=ILUOUT0,FMT='("*****************************************")')
- WRITE(UNIT=ILUOUT0,FMT='("!")')
- WRITE(UNIT=ILUOUT0,FMT='("KND=",I3)') IND
- WRITE(UNIT=ILUOUT0,FMT='("KSCLBDAS=",I3)') NSCLBDAS
- WRITE(UNIT=ILUOUT0,FMT='("PALPHAS=",E13.6)') XALPHAS
- WRITE(UNIT=ILUOUT0,FMT='("PNUS=",E13.6)') XNUS
- WRITE(UNIT=ILUOUT0,FMT='("PESS=",E13.6)') ZESS
- WRITE(UNIT=ILUOUT0,FMT='("PBS=",E13.6)') XBS
- WRITE(UNIT=ILUOUT0,FMT='("PCS=",E13.6)') XCS
- WRITE(UNIT=ILUOUT0,FMT='("PDS=",E13.6)') XDS
- WRITE(UNIT=ILUOUT0,FMT='("PSCLBDAS_MAX=",E13.6)') &
- XSCLBDAS_MAX
- WRITE(UNIT=ILUOUT0,FMT='("PSCLBDAS_MIN=",E13.6)') &
- XSCLBDAS_MIN
- WRITE(UNIT=ILUOUT0,FMT='("PFDINFTY=",E13.6)') ZFDINFTY
- WRITE(UNIT=ILUOUT0,FMT='("!")')
- WRITE(UNIT=ILUOUT0,FMT='("!")')
- WRITE(UNIT=ILUOUT0,FMT='("IF( PRESENT(PKER_N_SSCS ) ) THEN")')
- DO J1 = 1 , NSCLBDAS
- WRITE(UNIT=ILUOUT0,FMT='(" PKER_N_SSCS (",I3,",",I3,") = ",E13.6)') &
- J1,J1,XKER_N_SSCS (J1,J1)
- END DO
- WRITE(UNIT=ILUOUT0,FMT='("!")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='("*****************************************")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='("**** UPDATE NEW SET OF SSCS KERNELS ***")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='("*****************************************")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='("!")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='("KND=",I3)') IND
+!!$ WRITE(UNIT=ILUOUT0,FMT='("KSCLBDAS=",I3)') NSCLBDAS
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PALPHAS=",E13.6)') XALPHAS
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PNUS=",E13.6)') XNUS
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PESS=",E13.6)') ZESS
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PBS=",E13.6)') XBS
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PCS=",E13.6)') XCS
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PDS=",E13.6)') XDS
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PSCLBDAS_MAX=",E13.6)') &
+!!$ XSCLBDAS_MAX
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PSCLBDAS_MIN=",E13.6)') &
+!!$ XSCLBDAS_MIN
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PFDINFTY=",E13.6)') ZFDINFTY
+!!$ WRITE(UNIT=ILUOUT0,FMT='("!")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='("!")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='("IF( PRESENT(PKER_N_SSCS ) ) THEN")')
+!!$ DO J1 = 1 , NSCLBDAS
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" PKER_N_SSCS (",I3,",",I3,") = ",E13.6)') &
+!!$ J1,J1,XKER_N_SSCS (J1,J1)
+!!$ END DO
+!!$ WRITE(UNIT=ILUOUT0,FMT='("!")')
!
!* 7.2N2 Constants for the 'spontaneous' break-up
!
@@ -1123,11 +1121,11 @@ XSCINTP2S = 1.0 - LOG( XSCLBDAS_MIN ) / ZRATE
!
XFSCVMG = 2.0
!
-GFLAG = .TRUE.
-IF (GFLAG) THEN
- WRITE(UNIT=ILUOUT0,FMT='(" conversion-melting of the aggregates")')
- WRITE(UNIT=ILUOUT0,FMT='(" Conv. factor XFSCVMG=",E13.6)') XFSCVMG
-END IF
+!!$GFLAG = .TRUE.
+!!$IF (GFLAG) THEN
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" conversion-melting of the aggregates")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" Conv. factor XFSCVMG=",E13.6)') XFSCVMG
+!!$END IF
!
!
!* 7.4 Constants for Ice-Ice collision process (CIBU)
@@ -1136,12 +1134,12 @@ XDCSLIM_CIBU_MIN = 2.0E-4 ! D_cs lim min
XDCSLIM_CIBU_MAX = 1.0E-3 ! D_cs lim max
XDCGLIM_CIBU_MIN = 2.0E-3 ! D_cg lim min
!
-GFLAG = .TRUE.
-IF (GFLAG) THEN
- WRITE(UNIT=ILUOUT0,FMT='(" Ice-ice collision process")')
- WRITE(UNIT=ILUOUT0,FMT='(" D_cs^lim min-max =",E13.6)') XDCSLIM_CIBU_MIN,XDCSLIM_CIBU_MAX
- WRITE(UNIT=ILUOUT0,FMT='(" D_cg^lim min =",E13.6)') XDCGLIM_CIBU_MIN
-END IF
+!!$GFLAG = .TRUE.
+!!$IF (GFLAG) THEN
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" Ice-ice collision process")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" D_cs^lim min-max =",E13.6)') XDCSLIM_CIBU_MIN,XDCSLIM_CIBU_MAX
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" D_cg^lim min =",E13.6)') XDCGLIM_CIBU_MIN
+!!$END IF
!
NGAMINC = 80
!
@@ -1196,11 +1194,11 @@ XMOMGS_CIBU_3 = MOMG(XALPHAS,XNUS,XBS+XDS)
!
XDCRLIM_RDSF_MIN = 0.1E-3 ! D_cr lim min
!
-GFLAG = .TRUE.
-IF (GFLAG) THEN
- WRITE(UNIT=ILUOUT0,FMT='(" Ice-rain collision process")')
- WRITE(UNIT=ILUOUT0,FMT='(" D_cr^lim min =",E13.6)') XDCRLIM_RDSF_MIN
-END IF
+!!$GFLAG = .TRUE.
+!!$IF (GFLAG) THEN
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" Ice-rain collision process")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" D_cr^lim min =",E13.6)') XDCRLIM_RDSF_MIN
+!!$END IF
!
NGAMINC = 80
!
@@ -1246,11 +1244,11 @@ XEXICFRR = -XDR-2.0
XICFRR = (XPI/4.0)*XCOLIR*XCR*(ZRHO00**XCEXVT) &
*MOMG(XALPHAR,XNUR,XDR+2.0)
!
-GFLAG = .TRUE.
-IF (GFLAG) THEN
- WRITE(UNIT=ILUOUT0,FMT='(" rain contact freezing")')
- WRITE(UNIT=ILUOUT0,FMT='(" Coll. efficiency XCOLIR=",E13.6)') XCOLIR
-END IF
+!!$GFLAG = .TRUE.
+!!$IF (GFLAG) THEN
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" rain contact freezing")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" Coll. efficiency XCOLIR=",E13.6)') XCOLIR
+!!$END IF
!
!
!* 8.2 Constants for the dry growth of the graupeln
@@ -1270,16 +1268,16 @@ XCOLIG = 0.25 ! Collection efficiency of I+G
XCOLEXIG = 0.05 ! Temperature factor of the I+G collection efficiency
XCOLIG = 0.01 ! Collection efficiency of I+G
XCOLEXIG = 0.1 ! Temperature factor of the I+G collection efficiency
-WRITE (ILUOUT0, FMT=*) ' NEW Constants for the cloud ice collection by the graupeln'
-WRITE (ILUOUT0, FMT=*) ' XCOLIG, XCOLEXIG = ',XCOLIG,XCOLEXIG
+!!$WRITE (ILUOUT0, FMT=*) ' NEW Constants for the cloud ice collection by the graupeln'
+!!$WRITE (ILUOUT0, FMT=*) ' XCOLIG, XCOLEXIG = ',XCOLIG,XCOLEXIG
XFIDRYG = (XPI/4.0)*XCOLIG*XCG*(ZRHO00**XCEXVT)*MOMG(XALPHAG,XNUG,XDG+2.0)
!
-GFLAG = .TRUE.
-IF (GFLAG) THEN
- WRITE(UNIT=ILUOUT0,FMT='(" cloud ice collection by the graupeln")')
- WRITE(UNIT=ILUOUT0,FMT='(" Coll. efficiency XCOLIG=",E13.6)') XCOLIG
- WRITE(UNIT=ILUOUT0,FMT='(" Temp. factor XCOLEXIG=",E13.6)') XCOLEXIG
-END IF
+!!$GFLAG = .TRUE.
+!!$IF (GFLAG) THEN
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" cloud ice collection by the graupeln")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" Coll. efficiency XCOLIG=",E13.6)') XCOLIG
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" Temp. factor XCOLEXIG=",E13.6)') XCOLEXIG
+!!$END IF
!
!* 8.2.3 Constants for the aggregate collection by the graupeln
!
@@ -1287,8 +1285,8 @@ XCOLSG = 0.25 ! Collection efficiency of S+G
XCOLEXSG = 0.05 ! Temperature factor of the S+G collection efficiency
XCOLSG = 0.01 ! Collection efficiency of S+G
XCOLEXSG = 0.1 ! Temperature factor of the S+G collection efficiency
-WRITE (ILUOUT0, FMT=*) ' NEW Constants for the aggregate collection by the graupeln'
-WRITE (ILUOUT0, FMT=*) ' XCOLSG, XCOLEXSG = ',XCOLSG,XCOLEXSG
+!!$WRITE (ILUOUT0, FMT=*) ' NEW Constants for the aggregate collection by the graupeln'
+!!$WRITE (ILUOUT0, FMT=*) ' XCOLSG, XCOLEXSG = ',XCOLSG,XCOLEXSG
XFSDRYG = XNS*(XPI/4.0)*XCOLSG*XAS*(ZRHO00**XCEXVT)
XFNSDRYG= (XPI/4.0)*XCOLSG*(ZRHO00**XCEXVT)
!
@@ -1299,12 +1297,12 @@ XLBSDRYG1 = MOMG(XALPHAG,XNUG,2.)*MOMG(XALPHAS,XNUS,XBS)
XLBSDRYG2 = 2.*MOMG(XALPHAG,XNUG,1.)*MOMG(XALPHAS,XNUS,XBS+1.)
XLBSDRYG3 = MOMG(XALPHAS,XNUS,XBS+2.)
!
-GFLAG = .TRUE.
-IF (GFLAG) THEN
- WRITE(UNIT=ILUOUT0,FMT='(" aggregate collection by the graupeln")')
- WRITE(UNIT=ILUOUT0,FMT='(" Coll. efficiency XCOLSG=",E13.6)') XCOLSG
- WRITE(UNIT=ILUOUT0,FMT='(" Temp. factor XCOLEXSG=",E13.6)') XCOLEXSG
-END IF
+!!$GFLAG = .TRUE.
+!!$IF (GFLAG) THEN
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" aggregate collection by the graupeln")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" Coll. efficiency XCOLSG=",E13.6)') XCOLSG
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" Temp. factor XCOLEXSG=",E13.6)') XCOLEXSG
+!!$END IF
!
!* 8.2.4 Constants for the raindrop collection by the graupeln
!
@@ -1352,15 +1350,15 @@ ALLOCATE( XKER_SDRYG(NDRYLBDAG,NDRYLBDAS) )
ZEGS, XCG, XDG, 0., XCS, XDS, XFVELOS, &
XDRYLBDAG_MAX, XDRYLBDAS_MAX, XDRYLBDAG_MIN, XDRYLBDAS_MIN, &
ZFDINFTY, XKER_N_SDRYG )
- WRITE(UNIT=ILUOUT0,FMT='("!")')
- WRITE(UNIT=ILUOUT0,FMT='("IF( PRESENT(PKER_N_SDRYG) ) THEN")')
- DO J1 = 1 , NDRYLBDAG
- DO J2 = 1 , NDRYLBDAS
- WRITE(UNIT=ILUOUT0,FMT='(" PKER_N_SDRYG(",I3,",",I3,") = ",E13.6)') &
- J1,J2,XKER_N_SDRYG(J1,J2)
- END DO
- END DO
- WRITE(UNIT=ILUOUT0,FMT='("!")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='("!")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='("IF( PRESENT(PKER_N_SDRYG) ) THEN")')
+!!$ DO J1 = 1 , NDRYLBDAG
+!!$ DO J2 = 1 , NDRYLBDAS
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" PKER_N_SDRYG(",I3,",",I3,") = ",E13.6)') &
+!!$ J1,J2,XKER_N_SDRYG(J1,J2)
+!!$ END DO
+!!$ END DO
+!!$ WRITE(UNIT=ILUOUT0,FMT='("!")')
!end if
!
CALL LIMA_READ_XKER_SDRYG (KDRYLBDAG,KDRYLBDAS,KND, &
@@ -1379,48 +1377,48 @@ IF( (KDRYLBDAG/=NDRYLBDAG) .OR. (KDRYLBDAS/=NDRYLBDAS) .OR. (KND/=IND) .OR. &
ZEGS, XBS, XCG, XDG, 0., XCS, XDS, XFVELOS, &
XDRYLBDAG_MAX, XDRYLBDAS_MAX, XDRYLBDAG_MIN, XDRYLBDAS_MIN, &
ZFDINFTY, XKER_SDRYG )
- WRITE(UNIT=ILUOUT0,FMT='("*****************************************")')
- WRITE(UNIT=ILUOUT0,FMT='("**** UPDATE NEW SET OF SDRYG KERNELS ****")')
- WRITE(UNIT=ILUOUT0,FMT='("*****************************************")')
- WRITE(UNIT=ILUOUT0,FMT='("!")')
- WRITE(UNIT=ILUOUT0,FMT='("KND=",I3)') IND
- WRITE(UNIT=ILUOUT0,FMT='("KDRYLBDAG=",I3)') NDRYLBDAG
- WRITE(UNIT=ILUOUT0,FMT='("KDRYLBDAS=",I3)') NDRYLBDAS
- WRITE(UNIT=ILUOUT0,FMT='("PALPHAG=",E13.6)') XALPHAG
- WRITE(UNIT=ILUOUT0,FMT='("PNUG=",E13.6)') XNUG
- WRITE(UNIT=ILUOUT0,FMT='("PALPHAS=",E13.6)') XALPHAS
- WRITE(UNIT=ILUOUT0,FMT='("PNUS=",E13.6)') XNUS
- WRITE(UNIT=ILUOUT0,FMT='("PEGS=",E13.6)') ZEGS
- WRITE(UNIT=ILUOUT0,FMT='("PBS=",E13.6)') XBS
- WRITE(UNIT=ILUOUT0,FMT='("PCG=",E13.6)') XCG
- WRITE(UNIT=ILUOUT0,FMT='("PDG=",E13.6)') XDG
- WRITE(UNIT=ILUOUT0,FMT='("PCS=",E13.6)') XCS
- WRITE(UNIT=ILUOUT0,FMT='("PDS=",E13.6)') XDS
- WRITE(UNIT=ILUOUT0,FMT='("PFVELOS=",E13.6)') XFVELOS
- WRITE(UNIT=ILUOUT0,FMT='("PDRYLBDAG_MAX=",E13.6)') &
- XDRYLBDAG_MAX
- WRITE(UNIT=ILUOUT0,FMT='("PDRYLBDAS_MAX=",E13.6)') &
- XDRYLBDAS_MAX
- WRITE(UNIT=ILUOUT0,FMT='("PDRYLBDAG_MIN=",E13.6)') &
- XDRYLBDAG_MIN
- WRITE(UNIT=ILUOUT0,FMT='("PDRYLBDAS_MIN=",E13.6)') &
- XDRYLBDAS_MIN
- WRITE(UNIT=ILUOUT0,FMT='("PFDINFTY=",E13.6)') ZFDINFTY
- WRITE(UNIT=ILUOUT0,FMT='("!")')
- WRITE(UNIT=ILUOUT0,FMT='("IF( PRESENT(PKER_SDRYG) ) THEN")')
- DO J1 = 1 , NDRYLBDAG
- DO J2 = 1 , NDRYLBDAS
- WRITE(UNIT=ILUOUT0,FMT='("PKER_SDRYG(",I3,",",I3,") = ",E13.6)') &
- J1,J2,XKER_SDRYG(J1,J2)
- END DO
- END DO
- WRITE(UNIT=ILUOUT0,FMT='("END IF")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='("*****************************************")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='("**** UPDATE NEW SET OF SDRYG KERNELS ****")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='("*****************************************")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='("!")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='("KND=",I3)') IND
+!!$ WRITE(UNIT=ILUOUT0,FMT='("KDRYLBDAG=",I3)') NDRYLBDAG
+!!$ WRITE(UNIT=ILUOUT0,FMT='("KDRYLBDAS=",I3)') NDRYLBDAS
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PALPHAG=",E13.6)') XALPHAG
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PNUG=",E13.6)') XNUG
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PALPHAS=",E13.6)') XALPHAS
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PNUS=",E13.6)') XNUS
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PEGS=",E13.6)') ZEGS
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PBS=",E13.6)') XBS
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PCG=",E13.6)') XCG
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PDG=",E13.6)') XDG
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PCS=",E13.6)') XCS
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PDS=",E13.6)') XDS
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PFVELOS=",E13.6)') XFVELOS
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PDRYLBDAG_MAX=",E13.6)') &
+!!$ XDRYLBDAG_MAX
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PDRYLBDAS_MAX=",E13.6)') &
+!!$ XDRYLBDAS_MAX
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PDRYLBDAG_MIN=",E13.6)') &
+!!$ XDRYLBDAG_MIN
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PDRYLBDAS_MIN=",E13.6)') &
+!!$ XDRYLBDAS_MIN
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PFDINFTY=",E13.6)') ZFDINFTY
+!!$ WRITE(UNIT=ILUOUT0,FMT='("!")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='("IF( PRESENT(PKER_SDRYG) ) THEN")')
+!!$ DO J1 = 1 , NDRYLBDAG
+!!$ DO J2 = 1 , NDRYLBDAS
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PKER_SDRYG(",I3,",",I3,") = ",E13.6)') &
+!!$ J1,J2,XKER_SDRYG(J1,J2)
+!!$ END DO
+!!$ END DO
+!!$ WRITE(UNIT=ILUOUT0,FMT='("END IF")')
ELSE
CALL LIMA_READ_XKER_SDRYG (KDRYLBDAG,KDRYLBDAS,KND, &
PALPHAG,PNUG,PALPHAS,PNUS,PEGS,PBS,PCG,PDG,PCS,PDS,PFVELOS, &
PDRYLBDAG_MAX,PDRYLBDAS_MAX,PDRYLBDAG_MIN,PDRYLBDAS_MIN, &
PFDINFTY,XKER_SDRYG )
- WRITE(UNIT=ILUOUT0,FMT='(" Read XKER_SDRYG")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" Read XKER_SDRYG")')
END IF
!
!
@@ -1435,15 +1433,15 @@ ALLOCATE( XKER_RDRYG(NDRYLBDAG,NDRYLBDAR) )
ZEGR, XCG, XDG, 0., XCR, XDR, 0., &
XDRYLBDAG_MAX, XDRYLBDAR_MAX, XDRYLBDAG_MIN, XDRYLBDAR_MIN, &
ZFDINFTY, XKER_N_RDRYG )
- WRITE(UNIT=ILUOUT0,FMT='("!")')
- WRITE(UNIT=ILUOUT0,FMT='("IF( PRESENT(PKER_N_RDRYG) ) THEN")')
- DO J1 = 1 , NDRYLBDAG
- DO J2 = 1 , NDRYLBDAR
- WRITE(UNIT=ILUOUT0,FMT='(" PKER_N_RDRYG(",I3,",",I3,") = ",E13.6)') &
- J1,J2,XKER_N_RDRYG(J1,J2)
- END DO
- END DO
- WRITE(UNIT=ILUOUT0,FMT='("!")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='("!")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='("IF( PRESENT(PKER_N_RDRYG) ) THEN")')
+!!$ DO J1 = 1 , NDRYLBDAG
+!!$ DO J2 = 1 , NDRYLBDAR
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" PKER_N_RDRYG(",I3,",",I3,") = ",E13.6)') &
+!!$ J1,J2,XKER_N_RDRYG(J1,J2)
+!!$ END DO
+!!$ END DO
+!!$ WRITE(UNIT=ILUOUT0,FMT='("!")')
!end if
!
CALL LIMA_READ_XKER_RDRYG (KDRYLBDAG,KDRYLBDAR,KND, &
@@ -1462,47 +1460,47 @@ IF( (KDRYLBDAG/=NDRYLBDAG) .OR. (KDRYLBDAR/=NDRYLBDAR) .OR. (KND/=IND) .OR. &
ZEGR, XBR, XCG, XDG, 0., XCR, XDR, 0., &
XDRYLBDAG_MAX, XDRYLBDAR_MAX, XDRYLBDAG_MIN, XDRYLBDAR_MIN, &
ZFDINFTY, XKER_RDRYG )
- WRITE(UNIT=ILUOUT0,FMT='("*****************************************")')
- WRITE(UNIT=ILUOUT0,FMT='("**** UPDATE NEW SET OF RDRYG KERNELS ****")')
- WRITE(UNIT=ILUOUT0,FMT='("*****************************************")')
- WRITE(UNIT=ILUOUT0,FMT='("!")')
- WRITE(UNIT=ILUOUT0,FMT='("KND=",I3)') IND
- WRITE(UNIT=ILUOUT0,FMT='("KDRYLBDAG=",I3)') NDRYLBDAG
- WRITE(UNIT=ILUOUT0,FMT='("KDRYLBDAR=",I3)') NDRYLBDAR
- WRITE(UNIT=ILUOUT0,FMT='("PALPHAG=",E13.6)') XALPHAG
- WRITE(UNIT=ILUOUT0,FMT='("PNUG=",E13.6)') XNUG
- WRITE(UNIT=ILUOUT0,FMT='("PALPHAR=",E13.6)') XALPHAR
- WRITE(UNIT=ILUOUT0,FMT='("PNUR=",E13.6)') XNUR
- WRITE(UNIT=ILUOUT0,FMT='("PEGR=",E13.6)') ZEGR
- WRITE(UNIT=ILUOUT0,FMT='("PBR=",E13.6)') XBR
- WRITE(UNIT=ILUOUT0,FMT='("PCG=",E13.6)') XCG
- WRITE(UNIT=ILUOUT0,FMT='("PDG=",E13.6)') XDG
- WRITE(UNIT=ILUOUT0,FMT='("PCR=",E13.6)') XCR
- WRITE(UNIT=ILUOUT0,FMT='("PDR=",E13.6)') XDR
- WRITE(UNIT=ILUOUT0,FMT='("PDRYLBDAG_MAX=",E13.6)') &
- XDRYLBDAG_MAX
- WRITE(UNIT=ILUOUT0,FMT='("PDRYLBDAR_MAX=",E13.6)') &
- XDRYLBDAR_MAX
- WRITE(UNIT=ILUOUT0,FMT='("PDRYLBDAG_MIN=",E13.6)') &
- XDRYLBDAG_MIN
- WRITE(UNIT=ILUOUT0,FMT='("PDRYLBDAR_MIN=",E13.6)') &
- XDRYLBDAR_MIN
- WRITE(UNIT=ILUOUT0,FMT='("PFDINFTY=",E13.6)') ZFDINFTY
- WRITE(UNIT=ILUOUT0,FMT='("!")')
- WRITE(UNIT=ILUOUT0,FMT='("IF( PRESENT(PKER_RDRYG) ) THEN")')
- DO J1 = 1 , NDRYLBDAG
- DO J2 = 1 , NDRYLBDAR
- WRITE(UNIT=ILUOUT0,FMT='("PKER_RDRYG(",I3,",",I3,") = ",E13.6)') &
- J1,J2,XKER_RDRYG(J1,J2)
- END DO
- END DO
- WRITE(UNIT=ILUOUT0,FMT='("END IF")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='("*****************************************")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='("**** UPDATE NEW SET OF RDRYG KERNELS ****")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='("*****************************************")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='("!")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='("KND=",I3)') IND
+!!$ WRITE(UNIT=ILUOUT0,FMT='("KDRYLBDAG=",I3)') NDRYLBDAG
+!!$ WRITE(UNIT=ILUOUT0,FMT='("KDRYLBDAR=",I3)') NDRYLBDAR
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PALPHAG=",E13.6)') XALPHAG
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PNUG=",E13.6)') XNUG
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PALPHAR=",E13.6)') XALPHAR
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PNUR=",E13.6)') XNUR
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PEGR=",E13.6)') ZEGR
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PBR=",E13.6)') XBR
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PCG=",E13.6)') XCG
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PDG=",E13.6)') XDG
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PCR=",E13.6)') XCR
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PDR=",E13.6)') XDR
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PDRYLBDAG_MAX=",E13.6)') &
+!!$ XDRYLBDAG_MAX
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PDRYLBDAR_MAX=",E13.6)') &
+!!$ XDRYLBDAR_MAX
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PDRYLBDAG_MIN=",E13.6)') &
+!!$ XDRYLBDAG_MIN
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PDRYLBDAR_MIN=",E13.6)') &
+!!$ XDRYLBDAR_MIN
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PFDINFTY=",E13.6)') ZFDINFTY
+!!$ WRITE(UNIT=ILUOUT0,FMT='("!")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='("IF( PRESENT(PKER_RDRYG) ) THEN")')
+!!$ DO J1 = 1 , NDRYLBDAG
+!!$ DO J2 = 1 , NDRYLBDAR
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PKER_RDRYG(",I3,",",I3,") = ",E13.6)') &
+!!$ J1,J2,XKER_RDRYG(J1,J2)
+!!$ END DO
+!!$ END DO
+!!$ WRITE(UNIT=ILUOUT0,FMT='("END IF")')
ELSE
CALL LIMA_READ_XKER_RDRYG (KDRYLBDAG,KDRYLBDAR,KND, &
PALPHAG,PNUG,PALPHAR,PNUR,PEGR,PBR,PCG,PDG,PCR,PDR, &
PDRYLBDAG_MAX,PDRYLBDAR_MAX,PDRYLBDAG_MIN,PDRYLBDAR_MIN, &
PFDINFTY,XKER_RDRYG )
- WRITE(UNIT=ILUOUT0,FMT='(" Read XKER_RDRYG")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" Read XKER_RDRYG")')
END IF
!
!-------------------------------------------------------------------------------
@@ -1575,15 +1573,15 @@ ZFDINFTY = 20.0 ! computing the kernels XKER_SWETH
ZEHS, XCH, XDH, 0., XCS, XDS, XFVELOS, & !
XWETLBDAH_MAX, XWETLBDAS_MAX, XWETLBDAH_MIN, XWETLBDAS_MIN, & !
ZFDINFTY, XKER_N_SWETH )
- WRITE(UNIT=ILUOUT0,FMT='("!")')
- WRITE(UNIT=ILUOUT0,FMT='("IF( PRESENT(PKER_N_SWETH) ) THEN")')
- DO J1 = 1 , NWETLBDAH
- DO J2 = 1 , NWETLBDAS
- WRITE(UNIT=ILUOUT0,FMT='(" PKER_N_SWETH(",I3,",",I3,") = ",E13.6)') &
- J1,J2,XKER_N_SWETH(J1,J2)
- END DO
- END DO
- WRITE(UNIT=ILUOUT0,FMT='("!")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='("!")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='("IF( PRESENT(PKER_N_SWETH) ) THEN")')
+!!$ DO J1 = 1 , NWETLBDAH
+!!$ DO J2 = 1 , NWETLBDAS
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" PKER_N_SWETH(",I3,",",I3,") = ",E13.6)') &
+!!$ J1,J2,XKER_N_SWETH(J1,J2)
+!!$ END DO
+!!$ END DO
+!!$ WRITE(UNIT=ILUOUT0,FMT='("!")')
!end if
IF( .NOT.ALLOCATED(XKER_SWETH) ) ALLOCATE( XKER_SWETH(NWETLBDAH,NWETLBDAS) )
!
@@ -1603,48 +1601,48 @@ IF( (KWETLBDAH/=NWETLBDAH) .OR. (KWETLBDAS/=NWETLBDAS) .OR. (KND/=IND) .OR. &
ZEHS, XBS, XCH, XDH, 0., XCS, XDS, XFVELOS, &
XWETLBDAH_MAX, XWETLBDAS_MAX, XWETLBDAH_MIN, XWETLBDAS_MIN, &
ZFDINFTY, XKER_SWETH )
- WRITE(UNIT=ILUOUT0,FMT='("*****************************************")')
- WRITE(UNIT=ILUOUT0,FMT='("**** UPDATE NEW SET OF SWETH KERNELS ****")')
- WRITE(UNIT=ILUOUT0,FMT='("*****************************************")')
- WRITE(UNIT=ILUOUT0,FMT='("!")')
- WRITE(UNIT=ILUOUT0,FMT='("KND=",I3)') IND
- WRITE(UNIT=ILUOUT0,FMT='("KWETLBDAH=",I3)') NWETLBDAH
- WRITE(UNIT=ILUOUT0,FMT='("KWETLBDAS=",I3)') NWETLBDAS
- WRITE(UNIT=ILUOUT0,FMT='("PALPHAH=",E13.6)') XALPHAH
- WRITE(UNIT=ILUOUT0,FMT='("PNUH=",E13.6)') XNUH
- WRITE(UNIT=ILUOUT0,FMT='("PALPHAS=",E13.6)') XALPHAS
- WRITE(UNIT=ILUOUT0,FMT='("PNUS=",E13.6)') XNUS
- WRITE(UNIT=ILUOUT0,FMT='("PEHS=",E13.6)') ZEHS
- WRITE(UNIT=ILUOUT0,FMT='("PBS=",E13.6)') XBS
- WRITE(UNIT=ILUOUT0,FMT='("PCH=",E13.6)') XCH
- WRITE(UNIT=ILUOUT0,FMT='("PDH=",E13.6)') XDH
- WRITE(UNIT=ILUOUT0,FMT='("PCS=",E13.6)') XCS
- WRITE(UNIT=ILUOUT0,FMT='("PDS=",E13.6)') XDS
- WRITE(UNIT=ILUOUT0,FMT='("PFVELOS=",E13.6)') XFVELOS
- WRITE(UNIT=ILUOUT0,FMT='("PWETLBDAH_MAX=",E13.6)') &
- XWETLBDAH_MAX
- WRITE(UNIT=ILUOUT0,FMT='("PWETLBDAS_MAX=",E13.6)') &
- XWETLBDAS_MAX
- WRITE(UNIT=ILUOUT0,FMT='("PWETLBDAH_MIN=",E13.6)') &
- XWETLBDAH_MIN
- WRITE(UNIT=ILUOUT0,FMT='("PWETLBDAS_MIN=",E13.6)') &
- XWETLBDAS_MIN
- WRITE(UNIT=ILUOUT0,FMT='("PFDINFTY=",E13.6)') ZFDINFTY
- WRITE(UNIT=ILUOUT0,FMT='("!")')
- WRITE(UNIT=ILUOUT0,FMT='("IF( PRESENT(PKER_SWETH) ) THEN")')
- DO J1 = 1 , NWETLBDAH
- DO J2 = 1 , NWETLBDAS
- WRITE(UNIT=ILUOUT0,FMT='("PKER_SWETH(",I3,",",I3,") = ",E13.6)') &
- J1,J2,XKER_SWETH(J1,J2)
- END DO
- END DO
- WRITE(UNIT=ILUOUT0,FMT='("END IF")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='("*****************************************")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='("**** UPDATE NEW SET OF SWETH KERNELS ****")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='("*****************************************")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='("!")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='("KND=",I3)') IND
+!!$ WRITE(UNIT=ILUOUT0,FMT='("KWETLBDAH=",I3)') NWETLBDAH
+!!$ WRITE(UNIT=ILUOUT0,FMT='("KWETLBDAS=",I3)') NWETLBDAS
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PALPHAH=",E13.6)') XALPHAH
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PNUH=",E13.6)') XNUH
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PALPHAS=",E13.6)') XALPHAS
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PNUS=",E13.6)') XNUS
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PEHS=",E13.6)') ZEHS
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PBS=",E13.6)') XBS
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PCH=",E13.6)') XCH
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PDH=",E13.6)') XDH
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PCS=",E13.6)') XCS
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PDS=",E13.6)') XDS
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PFVELOS=",E13.6)') XFVELOS
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PWETLBDAH_MAX=",E13.6)') &
+!!$ XWETLBDAH_MAX
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PWETLBDAS_MAX=",E13.6)') &
+!!$ XWETLBDAS_MAX
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PWETLBDAH_MIN=",E13.6)') &
+!!$ XWETLBDAH_MIN
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PWETLBDAS_MIN=",E13.6)') &
+!!$ XWETLBDAS_MIN
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PFDINFTY=",E13.6)') ZFDINFTY
+!!$ WRITE(UNIT=ILUOUT0,FMT='("!")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='("IF( PRESENT(PKER_SWETH) ) THEN")')
+!!$ DO J1 = 1 , NWETLBDAH
+!!$ DO J2 = 1 , NWETLBDAS
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PKER_SWETH(",I3,",",I3,") = ",E13.6)') &
+!!$ J1,J2,XKER_SWETH(J1,J2)
+!!$ END DO
+!!$ END DO
+!!$ WRITE(UNIT=ILUOUT0,FMT='("END IF")')
ELSE
CALL LIMA_READ_XKER_SWETH (KWETLBDAH,KWETLBDAS,KND, &
PALPHAH,PNUH,PALPHAS,PNUS,PEHS,PBS,PCH,PDH,PCS,PDS,PFVELOS, &
PWETLBDAH_MAX,PWETLBDAS_MAX,PWETLBDAH_MIN,PWETLBDAS_MIN, &
PFDINFTY,XKER_SWETH )
- WRITE(UNIT=ILUOUT0,FMT='(" Read XKER_SWETH")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" Read XKER_SWETH")')
END IF
!
!
@@ -1658,15 +1656,15 @@ ZFDINFTY = 20.0
ZEHG, XCH, XDH, 0., XCG, XDG, 0., &
XWETLBDAH_MAX, XWETLBDAG_MAX, XWETLBDAH_MIN, XWETLBDAG_MIN, &
ZFDINFTY, XKER_N_GWETH )
- WRITE(UNIT=ILUOUT0,FMT='("!")')
- WRITE(UNIT=ILUOUT0,FMT='("IF( PRESENT(PKER_N_GWETH) ) THEN")')
- DO J1 = 1 , NWETLBDAH
- DO J2 = 1 , NWETLBDAG
- WRITE(UNIT=ILUOUT0,FMT='(" PKER_N_GWETH(",I3,",",I3,") = ",E13.6)') &
- J1,J2,XKER_N_GWETH(J1,J2)
- END DO
- END DO
- WRITE(UNIT=ILUOUT0,FMT='("!")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='("!")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='("IF( PRESENT(PKER_N_GWETH) ) THEN")')
+!!$ DO J1 = 1 , NWETLBDAH
+!!$ DO J2 = 1 , NWETLBDAG
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" PKER_N_GWETH(",I3,",",I3,") = ",E13.6)') &
+!!$ J1,J2,XKER_N_GWETH(J1,J2)
+!!$ END DO
+!!$ END DO
+!!$ WRITE(UNIT=ILUOUT0,FMT='("!")')
!end if
IF( .NOT.ALLOCATED(XKER_GWETH) ) ALLOCATE( XKER_GWETH(NWETLBDAH,NWETLBDAG) )
!
@@ -1686,47 +1684,47 @@ IF( (KWETLBDAH/=NWETLBDAH) .OR. (KWETLBDAG/=NWETLBDAG) .OR. (KND/=IND) .OR. &
ZEHG, XBG, XCH, XDH, 0., XCG, XDG, 0., &
XWETLBDAH_MAX, XWETLBDAG_MAX, XWETLBDAH_MIN, XWETLBDAG_MIN, &
ZFDINFTY, XKER_GWETH )
- WRITE(UNIT=ILUOUT0,FMT='("*****************************************")')
- WRITE(UNIT=ILUOUT0,FMT='("**** UPDATE NEW SET OF GWETH KERNELS ****")')
- WRITE(UNIT=ILUOUT0,FMT='("*****************************************")')
- WRITE(UNIT=ILUOUT0,FMT='("!")')
- WRITE(UNIT=ILUOUT0,FMT='("KND=",I3)') IND
- WRITE(UNIT=ILUOUT0,FMT='("KWETLBDAH=",I3)') NWETLBDAH
- WRITE(UNIT=ILUOUT0,FMT='("KWETLBDAG=",I3)') NWETLBDAG
- WRITE(UNIT=ILUOUT0,FMT='("PALPHAH=",E13.6)') XALPHAH
- WRITE(UNIT=ILUOUT0,FMT='("PNUH=",E13.6)') XNUH
- WRITE(UNIT=ILUOUT0,FMT='("PALPHAG=",E13.6)') XALPHAG
- WRITE(UNIT=ILUOUT0,FMT='("PNUG=",E13.6)') XNUG
- WRITE(UNIT=ILUOUT0,FMT='("PEHG=",E13.6)') ZEHG
- WRITE(UNIT=ILUOUT0,FMT='("PBG=",E13.6)') XBG
- WRITE(UNIT=ILUOUT0,FMT='("PCH=",E13.6)') XCH
- WRITE(UNIT=ILUOUT0,FMT='("PDH=",E13.6)') XDH
- WRITE(UNIT=ILUOUT0,FMT='("PCG=",E13.6)') XCG
- WRITE(UNIT=ILUOUT0,FMT='("PDG=",E13.6)') XDG
- WRITE(UNIT=ILUOUT0,FMT='("PWETLBDAH_MAX=",E13.6)') &
- XWETLBDAH_MAX
- WRITE(UNIT=ILUOUT0,FMT='("PWETLBDAG_MAX=",E13.6)') &
- XWETLBDAG_MAX
- WRITE(UNIT=ILUOUT0,FMT='("PWETLBDAH_MIN=",E13.6)') &
- XWETLBDAH_MIN
- WRITE(UNIT=ILUOUT0,FMT='("PWETLBDAG_MIN=",E13.6)') &
- XWETLBDAG_MIN
- WRITE(UNIT=ILUOUT0,FMT='("PFDINFTY=",E13.6)') ZFDINFTY
- WRITE(UNIT=ILUOUT0,FMT='("!")')
- WRITE(UNIT=ILUOUT0,FMT='("IF( PRESENT(PKER_GWETH) ) THEN")')
- DO J1 = 1 , NWETLBDAH
- DO J2 = 1 , NWETLBDAG
- WRITE(UNIT=ILUOUT0,FMT='("PKER_GWETH(",I3,",",I3,") = ",E13.6)') &
- J1,J2,XKER_GWETH(J1,J2)
- END DO
- END DO
- WRITE(UNIT=ILUOUT0,FMT='("END IF")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='("*****************************************")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='("**** UPDATE NEW SET OF GWETH KERNELS ****")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='("*****************************************")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='("!")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='("KND=",I3)') IND
+!!$ WRITE(UNIT=ILUOUT0,FMT='("KWETLBDAH=",I3)') NWETLBDAH
+!!$ WRITE(UNIT=ILUOUT0,FMT='("KWETLBDAG=",I3)') NWETLBDAG
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PALPHAH=",E13.6)') XALPHAH
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PNUH=",E13.6)') XNUH
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PALPHAG=",E13.6)') XALPHAG
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PNUG=",E13.6)') XNUG
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PEHG=",E13.6)') ZEHG
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PBG=",E13.6)') XBG
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PCH=",E13.6)') XCH
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PDH=",E13.6)') XDH
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PCG=",E13.6)') XCG
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PDG=",E13.6)') XDG
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PWETLBDAH_MAX=",E13.6)') &
+!!$ XWETLBDAH_MAX
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PWETLBDAG_MAX=",E13.6)') &
+!!$ XWETLBDAG_MAX
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PWETLBDAH_MIN=",E13.6)') &
+!!$ XWETLBDAH_MIN
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PWETLBDAG_MIN=",E13.6)') &
+!!$ XWETLBDAG_MIN
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PFDINFTY=",E13.6)') ZFDINFTY
+!!$ WRITE(UNIT=ILUOUT0,FMT='("!")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='("IF( PRESENT(PKER_GWETH) ) THEN")')
+!!$ DO J1 = 1 , NWETLBDAH
+!!$ DO J2 = 1 , NWETLBDAG
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PKER_GWETH(",I3,",",I3,") = ",E13.6)') &
+!!$ J1,J2,XKER_GWETH(J1,J2)
+!!$ END DO
+!!$ END DO
+!!$ WRITE(UNIT=ILUOUT0,FMT='("END IF")')
ELSE
CALL LIMA_READ_XKER_GWETH (KWETLBDAH,KWETLBDAG,KND, &
PALPHAH,PNUH,PALPHAG,PNUG,PEHG,PBG,PCH,PDH,PCG,PDG, &
PWETLBDAH_MAX,PWETLBDAG_MAX,PWETLBDAH_MIN,PWETLBDAG_MIN, &
PFDINFTY,XKER_GWETH )
- WRITE(UNIT=ILUOUT0,FMT='(" Read XKER_GWETH")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" Read XKER_GWETH")')
END IF
!
!
@@ -1748,35 +1746,35 @@ XFREFFI = 0.5 * ZGAMI(8) * (1.0/XLBI)**XLBEXI
! -----------------------
!
!
-GFLAG = .TRUE.
-IF (GFLAG) THEN
- WRITE(UNIT=ILUOUT0,FMT='(" Summary of the ice particule characteristics")')
- WRITE(UNIT=ILUOUT0,FMT='(" PRISTINE ICE")')
- WRITE(UNIT=ILUOUT0,FMT='(" masse: A=",E13.6," B=",E13.6)') &
- XAI,XBI
- WRITE(UNIT=ILUOUT0,FMT='(" vitesse: C=",E13.6," D=",E13.6)') &
- XC_I,XDI
- WRITE(UNIT=ILUOUT0,FMT='(" distribution:AL=",E13.6,"NU=",E13.6)') &
- XALPHAI,XNUI
- WRITE(UNIT=ILUOUT0,FMT='(" SNOW")')
- WRITE(UNIT=ILUOUT0,FMT='(" masse: A=",E13.6," B=",E13.6)') &
- XAS,XBS
- WRITE(UNIT=ILUOUT0,FMT='(" vitesse: C=",E13.6," D=",E13.6)') &
- XCS,XDS
- WRITE(UNIT=ILUOUT0,FMT='(" concentration:CC=",E13.6," x=",E13.6)') &
- XCCS,XCXS
- WRITE(UNIT=ILUOUT0,FMT='(" distribution:AL=",E13.6,"NU=",E13.6)') &
- XALPHAS,XNUS
- WRITE(UNIT=ILUOUT0,FMT='(" GRAUPEL")')
- WRITE(UNIT=ILUOUT0,FMT='(" masse: A=",E13.6," B=",E13.6)') &
- XAG,XBG
- WRITE(UNIT=ILUOUT0,FMT='(" vitesse: C=",E13.6," D=",E13.6)') &
- XCG,XDG
- WRITE(UNIT=ILUOUT0,FMT='(" concentration:CC=",E13.6," x=",E13.6)') &
- XCCG,XCXG
- WRITE(UNIT=ILUOUT0,FMT='(" distribution:AL=",E13.6,"NU=",E13.6)') &
- XALPHAG,XNUG
-END IF
+!!$GFLAG = .TRUE.
+!!$IF (GFLAG) THEN
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" Summary of the ice particule characteristics")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" PRISTINE ICE")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" masse: A=",E13.6," B=",E13.6)') &
+!!$ XAI,XBI
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" vitesse: C=",E13.6," D=",E13.6)') &
+!!$ XC_I,XDI
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" distribution:AL=",E13.6,"NU=",E13.6)') &
+!!$ XALPHAI,XNUI
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" SNOW")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" masse: A=",E13.6," B=",E13.6)') &
+!!$ XAS,XBS
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" vitesse: C=",E13.6," D=",E13.6)') &
+!!$ XCS,XDS
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" concentration:CC=",E13.6," x=",E13.6)') &
+!!$ XCCS,XCXS
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" distribution:AL=",E13.6,"NU=",E13.6)') &
+!!$ XALPHAS,XNUS
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" GRAUPEL")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" masse: A=",E13.6," B=",E13.6)') &
+!!$ XAG,XBG
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" vitesse: C=",E13.6," D=",E13.6)') &
+!!$ XCG,XDG
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" concentration:CC=",E13.6," x=",E13.6)') &
+!!$ XCCG,XCXG
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" distribution:AL=",E13.6,"NU=",E13.6)') &
+!!$ XALPHAG,XNUG
+!!$END IF
!
!------------------------------------------------------------------------------
!
diff --git a/src/PHYEX/micro/ini_lima_warm.f90 b/src/PHYEX/micro/ini_lima_warm.f90
index aea2517cab9d168a998aa6785bd35693674050d9..8ae14ed0fe38348f4a761530db6ec43c75b2238d 100644
--- a/src/PHYEX/micro/ini_lima_warm.f90
+++ b/src/PHYEX/micro/ini_lima_warm.f90
@@ -50,9 +50,9 @@ USE MODD_REF
USE MODD_PARAM_LIMA
USE MODD_PARAM_LIMA_WARM
USE MODD_PARAMETERS
-USE MODD_LUNIT, ONLY : TLUOUT0
+!USE MODD_LUNIT, ONLY : TLUOUT0
!
-USE MODI_LIMA_FUNCTIONS
+USE MODE_LIMA_FUNCTIONS, ONLY: MOMG
USE MODI_HYPGEO
USE MODI_GAMMA
!
@@ -85,9 +85,9 @@ REAL :: ZSMIN, ZSMAX ! Minimal and maximal supersaturation used to
! discretize the HYP functions
!
!
-INTEGER :: ILUOUT0 ! Logical unit number for output-listing
-INTEGER :: IRESP ! Return code of FM-routines
-LOGICAL :: GFLAG ! Logical flag for printing the constatnts on the output
+!INTEGER :: ILUOUT0 ! Logical unit number for output-listing
+!INTEGER :: IRESP ! Return code of FM-routines
+!LOGICAL :: GFLAG ! Logical flag for printing the constatnts on the output
! listing
!
!-------------------------------------------------------------------------------
@@ -448,29 +448,29 @@ XCRER = 1.0/ (ZGAMR(6) * XAR**(2.0/3.0))
! -----------------------
!
!
-GFLAG = .TRUE.
-IF (GFLAG) THEN
- ILUOUT0 = TLUOUT0%NLU
- WRITE(UNIT=ILUOUT0,FMT='(" Summary of the cloud particule characteristics")')
- WRITE(UNIT=ILUOUT0,FMT='(" CLOUD")')
- WRITE(UNIT=ILUOUT0,FMT='(" masse: A=",E13.6," B=",E13.6)') &
- XAR,XBR
- WRITE(UNIT=ILUOUT0,FMT='(" vitesse: C=",E13.6," D=",E13.6)') &
- XCC,XDC
- WRITE(UNIT=ILUOUT0,FMT='(" distribution:AL=",E13.6,"NU=",E13.6)') &
- XALPHAC,XNUC
- WRITE(UNIT=ILUOUT0,FMT='(" RAIN")')
- WRITE(UNIT=ILUOUT0,FMT='(" masse: A=",E13.6," B=",E13.6)') &
- XAR,XBR
- WRITE(UNIT=ILUOUT0,FMT='(" vitesse: C=",E13.6," D=",E13.6)') &
- XCR,XDR
+!!$GFLAG = .TRUE.
+!!$IF (GFLAG) THEN
+!!$ ILUOUT0 = TLUOUT0%NLU
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" Summary of the cloud particule characteristics")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" CLOUD")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" masse: A=",E13.6," B=",E13.6)') &
+!!$ XAR,XBR
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" vitesse: C=",E13.6," D=",E13.6)') &
+!!$ XCC,XDC
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" distribution:AL=",E13.6,"NU=",E13.6)') &
+!!$ XALPHAC,XNUC
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" RAIN")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" masse: A=",E13.6," B=",E13.6)') &
+!!$ XAR,XBR
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" vitesse: C=",E13.6," D=",E13.6)') &
+!!$ XCR,XDR
!!$ WRITE(UNIT=ILUOUT0,FMT='(" distribution:AL=",E13.6,"NU=",E13.6)') &
!!$ XALPHAR,XNUR
!!$ WRITE(UNIT=ILUOUT0,FMT='(" Description of the nucleation spectrum")')
!!$ WRITE(UNIT=ILUOUT0,FMT='(" C=",E13.6," k=",E13.6)') XCHEN, XKHEN
!!$ WRITE(UNIT=ILUOUT0,FMT='(" Beta=",E13.6," MU=",E13.6)') XBETAHEN, XMUHEN
!!$ WRITE(UNIT=ILUOUT0,FMT='(" CCN max=",E13.6)') XCONC_CCN
-END IF
+!!$END IF
!
!------------------------------------------------------------------------------
!
diff --git a/src/PHYEX/micro/init_aerosol_properties.f90 b/src/PHYEX/micro/init_aerosol_properties.f90
index 52f7ddc882a89149d5f467797f07c70b1a9f5ba2..ecd30df7f7498c011657b3af21a40a14cc675103 100644
--- a/src/PHYEX/micro/init_aerosol_properties.f90
+++ b/src/PHYEX/micro/init_aerosol_properties.f90
@@ -44,7 +44,7 @@ END MODULE MODI_INIT_AEROSOL_PROPERTIES
!* 0. DECLARATIONS
! ------------
!
-USE MODD_LUNIT, ONLY : TLUOUT0
+!USE MODD_LUNIT, ONLY : TLUOUT0
USE MODD_PARAM_LIMA, ONLY : NMOD_CCN, HINI_CCN, HTYPE_CCN, &
XR_MEAN_CCN, XLOGSIG_CCN, XRHO_CCN, &
XKHEN_MULTI, XMUHEN_MULTI, XBETAHEN_MULTI, &
@@ -52,12 +52,13 @@ USE MODD_PARAM_LIMA, ONLY : NMOD_CCN, HINI_CCN, HTYPE_CCN, &
XACTEMP_CCN, XFSOLUB_CCN, &
NMOD_IFN, NSPECIE, CIFN_SPECIES, &
XMDIAM_IFN, XSIGMA_IFN, XRHO_IFN, XFRAC, XFRAC_REF, &
- CINT_MIXING, NPHILLIPS
+ CINT_MIXING, NPHILLIPS, &
+ NIMM, NMOD_IMM, NINDICE_CCN_IMM
!
use mode_msg
!
USE MODI_GAMMA
-USE MODI_LIMA_INIT_CCN_ACTIVATION_SPECTRUM
+USE MODE_LIMA_INIT_CCN_ACTIVATION_SPECTRUM, ONLY: LIMA_INIT_CCN_ACTIVATION_SPECTRUM
!
IMPLICIT NONE
!
@@ -84,8 +85,8 @@ REAL, DIMENSION(3) :: RHOCCN
!
INTEGER :: I,J,JMOD
!
-INTEGER :: ILUOUT0 ! Logical unit number for output-listing
-INTEGER :: IRESP ! Return code of FM-routines
+!INTEGER :: ILUOUT0 ! Logical unit number for output-listing
+!INTEGER :: IRESP ! Return code of FM-routines
!
REAL :: X1, X2, X3, X4, X5
! REAL, DIMENSION(7) :: diameters=(/ 0.01E-6, 0.05E-6, 0.1E-6, 0.2E-6, 0.5E-6, 1.E-6, 2.E-6 /)
@@ -97,7 +98,7 @@ INTEGER :: II, IJ, IK
!
!-------------------------------------------------------------------------------
!
-ILUOUT0 = TLUOUT0%NLU
+!ILUOUT0 = TLUOUT0%NLU
!
!!!!!!!!!!!!!!!!
! CCN properties
@@ -183,13 +184,13 @@ IF ( NMOD_CCN .GE. 1 ) THEN
IF (.NOT.(ALLOCATED(XLIMIT_FACTOR))) ALLOCATE(XLIMIT_FACTOR(NMOD_CCN))
!
IF (HINI_CCN == 'CCN') THEN
- IF (LSCAV) THEN
-! Attention !
- WRITE(UNIT=ILUOUT0,FMT='("You are using a numerical initialization &
- ¬ depending on the aerosol properties, however you need it for &
- &scavenging. &
- &With LSCAV = true, HINI_CCN should be set to AER for consistency")')
- END IF
+!!$ IF (LSCAV) THEN
+!!$! Attention !
+!!$ WRITE(UNIT=ILUOUT0,FMT='("You are using a numerical initialization &
+!!$ ¬ depending on the aerosol properties, however you need it for &
+!!$ &scavenging. &
+!!$ &With LSCAV = true, HINI_CCN should be set to AER for consistency")')
+!!$ END IF
! Numerical initialization without dependence on AP physical properties
DO JMOD = 1, NMOD_CCN
XKHEN_MULTI(JMOD) = XKHEN_TMP(JMOD)
@@ -431,6 +432,22 @@ IF ( NMOD_IFN .GE. 1 ) THEN
XFRAC_REF(4)=0.06
END IF
!
+! Immersion modes
+!
+ IF (.NOT.(ALLOCATED(NIMM))) ALLOCATE(NIMM(NMOD_CCN))
+ NIMM(:)=0
+ IF (ALLOCATED(NINDICE_CCN_IMM)) DEALLOCATE(NINDICE_CCN_IMM)
+ ALLOCATE(NINDICE_CCN_IMM(MAX(1,NMOD_IMM)))
+ IF (NMOD_IMM .GE. 1) THEN
+ DO J = 0, NMOD_IMM-1
+ NIMM(NMOD_CCN-J)=1
+ NINDICE_CCN_IMM(NMOD_IMM-J) = NMOD_CCN-J
+ END DO
+! ELSE IF (NMOD_IMM == 0) THEN ! PNIS existe mais vaut 0, pour l'appel à resolved_cloud
+! NMOD_IMM = 1
+! NINDICE_CCN_IMM(1) = 0
+ END IF
+!
END IF ! NMOD_IFN > 0
!
END SUBROUTINE INIT_AEROSOL_PROPERTIES
diff --git a/src/PHYEX/micro/lima.f90 b/src/PHYEX/micro/lima.f90
index 0ed11fe4885abca003bda12c21d85a861f293d43..36474a920f88ec2b69ca5ca86947fa837a375b33 100644
--- a/src/PHYEX/micro/lima.f90
+++ b/src/PHYEX/micro/lima.f90
@@ -3,82 +3,17 @@
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
-! ######spl
-MODULE MODI_LIMA
-! ####################
-!
-INTERFACE
-!
- SUBROUTINE LIMA ( KKA, KKU, KKL, &
- PTSTEP, TPFILE, &
- PRHODREF, PEXNREF, PDZZ, &
- PRHODJ, PPABST, &
- NCCN, NIFN, NIMM, &
- PDTHRAD, PTHT, PRT, PSVT, PW_NU, &
- PTHS, PRS, PSVS, &
- PINPRC, PINDEP, PINPRR, PINPRI, PINPRS, PINPRG, PINPRH, &
- PEVAP3D, PCLDFR, PICEFR, PPRCFR )
-!
-USE MODD_IO, ONLY: TFILEDATA
-USE MODD_NSV, only: NSV_LIMA_BEG
-!
-INTEGER, INTENT(IN) :: KKA !near ground array index
-INTEGER, INTENT(IN) :: KKU !uppest atmosphere array index
-INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=ARO
-!
-REAL, INTENT(IN) :: PTSTEP ! Time step
-TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Reference density
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! Layer thikness (m)
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! absolute pressure at t
-!
-INTEGER, INTENT(IN) :: NCCN ! for array size declarations
-INTEGER, INTENT(IN) :: NIFN ! for array size declarations
-INTEGER, INTENT(IN) :: NIMM ! for array size declarations
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDTHRAD ! dT/dt due to radiation
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta at time t
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT ! Mixing ratios at time t
-REAL, DIMENSION(:,:,:,NSV_LIMA_BEG:), INTENT(IN) :: PSVT ! Concentrations at time t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PW_NU ! w for CCN activation
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRS ! Mixing ratios sources
-REAL, DIMENSION(:,:,:,NSV_LIMA_BEG:), INTENT(INOUT) :: PSVS ! Concentration sources
-!
-REAL, DIMENSION(:,:), INTENT(OUT) :: PINPRC ! Cloud instant precip
-REAL, DIMENSION(:,:), INTENT(OUT) :: PINDEP ! Cloud droplets deposition
-REAL, DIMENSION(:,:), INTENT(OUT) :: PINPRR ! Rain instant precip
-REAL, DIMENSION(:,:), INTENT(OUT) :: PINPRI ! Rain instant precip
-REAL, DIMENSION(:,:), INTENT(OUT) :: PINPRS ! Snow instant precip
-REAL, DIMENSION(:,:), INTENT(OUT) :: PINPRG ! Graupel instant precip
-REAL, DIMENSION(:,:), INTENT(OUT) :: PINPRH ! Rain instant precip
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PEVAP3D ! Rain evap profile
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCLDFR ! Cloud fraction
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PICEFR ! Cloud fraction
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PPRCFR ! Cloud fraction
-!
-END SUBROUTINE LIMA
-END INTERFACE
-END MODULE MODI_LIMA
-!
-!
-! ######spl
- SUBROUTINE LIMA ( KKA, KKU, KKL, &
- PTSTEP, TPFILE, &
- PRHODREF, PEXNREF, PDZZ, &
- PRHODJ, PPABST, &
- NCCN, NIFN, NIMM, &
- PDTHRAD, PTHT, PRT, PSVT, PW_NU, &
- PTHS, PRS, PSVS, &
- PINPRC, PINDEP, PINPRR, PINPRI, PINPRS, PINPRG, PINPRH, &
- PEVAP3D, PCLDFR, PICEFR, PPRCFR )
-! ######################################################################
+! #####################################################################
+SUBROUTINE LIMA ( D, CST, BUCONF, TBUDGETS, KBUDGETS, &
+ PTSTEP, &
+ PRHODREF, PEXNREF, PDZZ, &
+ PRHODJ, PPABST, &
+ NCCN, NIFN, NIMM, &
+ PDTHRAD, PTHT, PRT, PSVT, PW_NU, &
+ PTHS, PRS, PSVS, &
+ PINPRC, PINDEP, PINPRR, PINPRI, PINPRS, PINPRG, PINPRH, &
+ PEVAP3D, PCLDFR, PICEFR, PPRCFR, PFPR )
+! #####################################################################
!
!! PURPOSE
!! -------
@@ -110,48 +45,44 @@ END MODULE MODI_LIMA
!
!* 0. DECLARATIONS
! ------------
-use modd_budget, only: lbu_enable, &
- lbudget_th, lbudget_rv, lbudget_rc, lbudget_rr, lbudget_ri, &
- lbudget_rs, lbudget_rg, lbudget_rh, lbudget_sv, &
- NBUDGET_TH, NBUDGET_RV, NBUDGET_RC, NBUDGET_RR, NBUDGET_RI, &
- NBUDGET_RS, NBUDGET_RG, NBUDGET_RH, NBUDGET_SV1, &
- tbudgets
-USE MODD_CST, ONLY: XCI, XCL, XCPD, XCPV, XLSTT, XLVTT, XTT, XRHOLW, XP00, XRD
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_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_IO, ONLY: TFILEDATA
-USE MODD_NSV, ONLY: NSV_LIMA_BEG, &
- NSV_LIMA_NC, NSV_LIMA_NR, NSV_LIMA_CCN_FREE, NSV_LIMA_CCN_ACTI, &
+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_IFN_FREE, NSV_LIMA_IFN_NUCL, NSV_LIMA_IMM_NUCL, NSV_LIMA_HOM_HAZE, &
+ NSV_LIMA_BEG
USE MODD_PARAMETERS, ONLY: JPHEXT, JPVEXT
-USE MODD_PARAM_LIMA, ONLY: LCOLD, LRAIN, LWARM, NMOD_CCN, NMOD_IFN, NMOD_IMM, LHHONI, &
+USE MODD_PARAM_LIMA, ONLY: NMOD_CCN, NMOD_IFN, NMOD_IMM, LHHONI, &
LACTIT, LFEEDBACKT, NMAXITER, XMRSTEP, XTSTEP_TS, &
LSEDC, LSEDI, XRTMIN, XCTMIN, LDEPOC, XVDEPOC, &
- LHAIL, LSNOW, &
NMOM_C, NMOM_R, NMOM_I, NMOM_S, NMOM_G, NMOM_H
USE MODD_PARAM_LIMA_COLD, ONLY: XAI, XBI
USE MODD_PARAM_LIMA_WARM, ONLY: XLBC, XLBEXC, XAC, XBC, XAR, XBR
-USE MODD_TURB_n, ONLY: LSUBG_COND
-use mode_budget, only: Budget_store_add, Budget_store_init, Budget_store_end
+USE MODE_BUDGET_PHY, ONLY: BUDGET_STORE_ADD_PHY, BUDGET_STORE_INIT_PHY, BUDGET_STORE_END_PHY
use mode_tools, only: Countjv
-USE MODI_LIMA_COMPUTE_CLOUD_FRACTIONS
-USE MODI_LIMA_DROPS_TO_DROPLETS_CONV
-USE MODI_LIMA_INST_PROCS
-USE MODI_LIMA_NUCLEATION_PROCS
-USE MODI_LIMA_SEDIMENTATION
-USE MODI_LIMA_TENDENCIES
+USE MODE_LIMA_COMPUTE_CLOUD_FRACTIONS, ONLY: LIMA_COMPUTE_CLOUD_FRACTIONS
+USE MODE_LIMA_DROPS_TO_DROPLETS_CONV, ONLY: LIMA_DROPS_TO_DROPLETS_CONV
+USE MODE_LIMA_INST_PROCS, ONLY: LIMA_INST_PROCS
+USE MODE_LIMA_NUCLEATION_PROCS, ONLY: LIMA_NUCLEATION_PROCS
+USE MODE_LIMA_SEDIMENTATION, ONLY: LIMA_SEDIMENTATION
+USE MODE_LIMA_TENDENCIES, ONLY: LIMA_TENDENCIES
!
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
!
-INTEGER, INTENT(IN) :: KKA !near ground array index
-INTEGER, INTENT(IN) :: KKU !uppest atmosphere array index
-INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=ARO
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+TYPE(CST_t), INTENT(IN) :: CST
+TYPE(TBUDGETCONF_t), INTENT(IN) :: BUCONF
+TYPE(TBUDGETDATA), DIMENSION(KBUDGETS), INTENT(INOUT) :: TBUDGETS
+INTEGER, INTENT(IN) :: KBUDGETS
!
REAL, INTENT(IN) :: PTSTEP ! Time step
-TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Reference density
REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
@@ -167,12 +98,12 @@ INTEGER, INTENT(IN) :: NIMM ! for array size declarati
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDTHRAD ! dT/dt due to radiation
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta at time t
REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT ! Mixing ratios at time t
-REAL, DIMENSION(:,:,:,NSV_LIMA_BEG:), INTENT(IN) :: PSVT ! Concentrations at time t
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVT ! Concentrations at time t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PW_NU ! w for CCN activation
!
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source
REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRS ! Mixing ratios sources
-REAL, DIMENSION(:,:,:,NSV_LIMA_BEG:), INTENT(INOUT) :: PSVS ! Concentration sources
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVS ! Concentration sources
!
REAL, DIMENSION(:,:), INTENT(OUT) :: PINPRC ! Cloud instant precip
REAL, DIMENSION(:,:), INTENT(OUT) :: PINDEP ! Cloud droplets deposition
@@ -186,6 +117,7 @@ REAL, DIMENSION(:,:,:), INTENT(OUT) :: PEVAP3D ! Rain evap profile
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCLDFR ! Cloud fraction
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PICEFR ! Cloud fraction
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PPRCFR ! Cloud fraction
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PFPR ! Precipitation fluxes in altitude
!
!* 0.2 Declarations of local variables :
!
@@ -340,7 +272,6 @@ REAL, DIMENSION(:), ALLOCATABLE :: ZCF1D, ZIF1D, ZPF1D
! Various parameters
! domain size and levels (AROME compatibility)
INTEGER :: KRR
-INTEGER :: IIB, IIE, IIT, IJB, IJE, IJT, IKB, IKE, IKT, IKTB, IKTE
! loops and packing
INTEGER :: II, IPACK, JI, JJ, JK
integer :: idx
@@ -355,26 +286,36 @@ REAL, DIMENSION(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3)) :: ZCPT ! Total condense
LOGICAL, DIMENSION(SIZE(PRT,1),SIZE(PRT,2)) :: GDEP
real, dimension(:,:,:), allocatable :: zrhodjontstep
!
+INTEGER :: ISV_LIMA_NC
+INTEGER :: ISV_LIMA_NR
+INTEGER :: ISV_LIMA_CCN_FREE
+INTEGER :: ISV_LIMA_CCN_ACTI
+INTEGER :: ISV_LIMA_NI
+INTEGER :: ISV_LIMA_NS
+INTEGER :: ISV_LIMA_NG
+INTEGER :: ISV_LIMA_NH
+INTEGER :: ISV_LIMA_IFN_FREE
+INTEGER :: ISV_LIMA_IFN_NUCL
+INTEGER :: ISV_LIMA_IMM_NUCL
+INTEGER :: ISV_LIMA_HOM_HAZE
+!
!-------------------------------------------------------------------------------
!
!* 0. Init
! ----
!
-!
-IIB=1+JPHEXT ! first physical point in i
-IIT=SIZE(PDZZ,1) ! total number of points in i
-IIE=IIT - JPHEXT ! last physical point in i
-!
-IJB=1+JPHEXT ! first physical point in j
-IJT=SIZE(PDZZ,2) ! total number of points in j
-IJE=IJT - JPHEXT ! last physical point in j
-!
-IKB=KKA+JPVEXT*KKL ! near ground physical point
-IKE=KKU-JPVEXT*KKL ! near TOA physical point
-IKT=SIZE(PDZZ,3) ! total number of points in k
-!
-IKTB=1+JPVEXT ! first index for a physical point in k
-IKTE=IKT-JPVEXT ! last index for a physical point in k
+ISV_LIMA_NC = NSV_LIMA_NC - NSV_LIMA_BEG + 1
+ISV_LIMA_NR = NSV_LIMA_NR - NSV_LIMA_BEG + 1
+ISV_LIMA_CCN_FREE = NSV_LIMA_CCN_FREE - NSV_LIMA_BEG + 1
+ISV_LIMA_CCN_ACTI = NSV_LIMA_CCN_ACTI - NSV_LIMA_BEG + 1
+ISV_LIMA_NI = NSV_LIMA_NI - NSV_LIMA_BEG + 1
+ISV_LIMA_NS = NSV_LIMA_NS - NSV_LIMA_BEG + 1
+ISV_LIMA_NG = NSV_LIMA_NG - NSV_LIMA_BEG + 1
+ISV_LIMA_NH = NSV_LIMA_NH - NSV_LIMA_BEG + 1
+ISV_LIMA_IFN_FREE = NSV_LIMA_IFN_FREE - NSV_LIMA_BEG + 1
+ISV_LIMA_IFN_NUCL = NSV_LIMA_IFN_NUCL - NSV_LIMA_BEG + 1
+ISV_LIMA_IMM_NUCL = NSV_LIMA_IMM_NUCL - NSV_LIMA_BEG + 1
+ISV_LIMA_HOM_HAZE = NSV_LIMA_HOM_HAZE - NSV_LIMA_BEG + 1
!
ZTHS(:,:,:) = PTHS(:,:,:)
ZTHT(:,:,:) = PTHS(:,:,:) * PTSTEP
@@ -418,7 +359,7 @@ ZIMMNS(:,:,:,:) = 0.
ZHOMFT(:,:,:) = 0.
ZHOMFS(:,:,:) = 0.
-if ( lbu_enable ) then
+if ( BUCONF%lbu_enable ) then
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.
@@ -569,62 +510,62 @@ IF ( KRR .GE. 7 ) ZRHS(:,:,:) = PRS(:,:,:,7)
! Concentrations
!
IF ( NMOM_C.GE.2) THEN
- ZCCT(:,:,:) = PSVS(:,:,:,NSV_LIMA_NC) * PTSTEP
- ZCCS(:,:,:) = PSVS(:,:,:,NSV_LIMA_NC)
+ ZCCT(:,:,:) = PSVS(:,:,:,ISV_LIMA_NC) * PTSTEP
+ ZCCS(:,:,:) = PSVS(:,:,:,ISV_LIMA_NC)
ELSE
ZCCT(:,:,:) = 300.E6 / PRHODREF(:,:,:)
ZCCS(:,:,:) = ZCCT(:,:,:) / PTSTEP
END IF
-IF ( LWARM .AND. LRAIN .AND. NMOM_R.GE.2) ZCRT(:,:,:) = PSVS(:,:,:,NSV_LIMA_NR) * PTSTEP
-IF ( LWARM .AND. LRAIN .AND. NMOM_R.GE.2) ZCRS(:,:,:) = PSVS(:,:,:,NSV_LIMA_NR)
-IF ( LCOLD .AND. NMOM_I.GE.2) ZCIT(:,:,:) = PSVS(:,:,:,NSV_LIMA_NI) * PTSTEP
-IF ( LCOLD .AND. NMOM_I.GE.2) ZCIS(:,:,:) = PSVS(:,:,:,NSV_LIMA_NI)
-IF ( LCOLD .AND. LSNOW .AND. NMOM_S.GE.2) ZCST(:,:,:) = PSVS(:,:,:,NSV_LIMA_NS) * PTSTEP
-IF ( LCOLD .AND. LSNOW .AND. NMOM_S.GE.2) ZCSS(:,:,:) = PSVS(:,:,:,NSV_LIMA_NS)
-IF ( LCOLD .AND. NMOM_G.GE.2) ZCGT(:,:,:) = PSVS(:,:,:,NSV_LIMA_NG) * PTSTEP
-IF ( LCOLD .AND. NMOM_G.GE.2) ZCGS(:,:,:) = PSVS(:,:,:,NSV_LIMA_NG)
-IF ( LCOLD .AND. NMOM_H.GE.2) ZCHT(:,:,:) = PSVS(:,:,:,NSV_LIMA_NH) * PTSTEP
-IF ( LCOLD .AND. NMOM_H.GE.2) ZCHS(:,:,:) = PSVS(:,:,:,NSV_LIMA_NH)
-!
-IF ( NMOD_CCN .GE. 1 ) ZCCNFT(:,:,:,:) = PSVS(:,:,:,NSV_LIMA_CCN_FREE:NSV_LIMA_CCN_FREE+NMOD_CCN-1) * PTSTEP
-IF ( NMOD_CCN .GE. 1 ) ZCCNAT(:,:,:,:) = PSVS(:,:,:,NSV_LIMA_CCN_ACTI:NSV_LIMA_CCN_ACTI+NMOD_CCN-1) * PTSTEP
-IF ( NMOD_CCN .GE. 1 ) ZCCNFS(:,:,:,:) = PSVS(:,:,:,NSV_LIMA_CCN_FREE:NSV_LIMA_CCN_FREE+NMOD_CCN-1)
-IF ( NMOD_CCN .GE. 1 ) ZCCNAS(:,:,:,:) = PSVS(:,:,:,NSV_LIMA_CCN_ACTI:NSV_LIMA_CCN_ACTI+NMOD_CCN-1)
-!
-IF ( NMOD_IFN .GE. 1 ) ZIFNFT(:,:,:,:) = PSVS(:,:,:,NSV_LIMA_IFN_FREE:NSV_LIMA_IFN_FREE+NMOD_IFN-1) * PTSTEP
-IF ( NMOD_IFN .GE. 1 ) ZIFNNT(:,:,:,:) = PSVS(:,:,:,NSV_LIMA_IFN_NUCL:NSV_LIMA_IFN_NUCL+NMOD_IFN-1) * PTSTEP
-IF ( NMOD_IFN .GE. 1 ) ZIFNFS(:,:,:,:) = PSVS(:,:,:,NSV_LIMA_IFN_FREE:NSV_LIMA_IFN_FREE+NMOD_IFN-1)
-IF ( NMOD_IFN .GE. 1 ) ZIFNNS(:,:,:,:) = PSVS(:,:,:,NSV_LIMA_IFN_NUCL:NSV_LIMA_IFN_NUCL+NMOD_IFN-1)
-!
-IF ( NMOD_IMM .GE. 1 ) ZIMMNT(:,:,:,:) = PSVS(:,:,:,NSV_LIMA_IMM_NUCL:NSV_LIMA_IMM_NUCL+NMOD_IMM-1) * PTSTEP
-IF ( NMOD_IMM .GE. 1 ) ZIMMNS(:,:,:,:) = PSVS(:,:,:,NSV_LIMA_IMM_NUCL:NSV_LIMA_IMM_NUCL+NMOD_IMM-1)
-!
-IF ( LCOLD .AND. LHHONI ) ZHOMFT(:,:,:) = PSVS(:,:,:,NSV_LIMA_HOM_HAZE) * PTSTEP
-IF ( LCOLD .AND. LHHONI ) ZHOMFS(:,:,:) = PSVS(:,:,:,NSV_LIMA_HOM_HAZE)
+IF ( NMOM_R.GE.2) ZCRT(:,:,:) = PSVS(:,:,:,ISV_LIMA_NR) * PTSTEP
+IF ( NMOM_R.GE.2) ZCRS(:,:,:) = PSVS(:,:,:,ISV_LIMA_NR)
+IF ( NMOM_I.GE.2) ZCIT(:,:,:) = PSVS(:,:,:,ISV_LIMA_NI) * PTSTEP
+IF ( NMOM_I.GE.2) ZCIS(:,:,:) = PSVS(:,:,:,ISV_LIMA_NI)
+IF ( NMOM_S.GE.2) ZCST(:,:,:) = PSVS(:,:,:,ISV_LIMA_NS) * PTSTEP
+IF ( NMOM_S.GE.2) ZCSS(:,:,:) = PSVS(:,:,:,ISV_LIMA_NS)
+IF ( NMOM_G.GE.2) ZCGT(:,:,:) = PSVS(:,:,:,ISV_LIMA_NG) * PTSTEP
+IF ( NMOM_G.GE.2) ZCGS(:,:,:) = PSVS(:,:,:,ISV_LIMA_NG)
+IF ( NMOM_H.GE.2) ZCHT(:,:,:) = PSVS(:,:,:,ISV_LIMA_NH) * PTSTEP
+IF ( NMOM_H.GE.2) ZCHS(:,:,:) = PSVS(:,:,:,ISV_LIMA_NH)
+!
+IF ( NMOD_CCN .GE. 1 ) ZCCNFT(:,:,:,:) = PSVS(:,:,:,ISV_LIMA_CCN_FREE:ISV_LIMA_CCN_FREE+NMOD_CCN-1) * PTSTEP
+IF ( NMOD_CCN .GE. 1 ) ZCCNAT(:,:,:,:) = PSVS(:,:,:,ISV_LIMA_CCN_ACTI:ISV_LIMA_CCN_ACTI+NMOD_CCN-1) * PTSTEP
+IF ( NMOD_CCN .GE. 1 ) ZCCNFS(:,:,:,:) = PSVS(:,:,:,ISV_LIMA_CCN_FREE:ISV_LIMA_CCN_FREE+NMOD_CCN-1)
+IF ( NMOD_CCN .GE. 1 ) ZCCNAS(:,:,:,:) = PSVS(:,:,:,ISV_LIMA_CCN_ACTI:ISV_LIMA_CCN_ACTI+NMOD_CCN-1)
+!
+IF ( NMOD_IFN .GE. 1 ) ZIFNFT(:,:,:,:) = PSVS(:,:,:,ISV_LIMA_IFN_FREE:ISV_LIMA_IFN_FREE+NMOD_IFN-1) * PTSTEP
+IF ( NMOD_IFN .GE. 1 ) ZIFNNT(:,:,:,:) = PSVS(:,:,:,ISV_LIMA_IFN_NUCL:ISV_LIMA_IFN_NUCL+NMOD_IFN-1) * PTSTEP
+IF ( NMOD_IFN .GE. 1 ) ZIFNFS(:,:,:,:) = PSVS(:,:,:,ISV_LIMA_IFN_FREE:ISV_LIMA_IFN_FREE+NMOD_IFN-1)
+IF ( NMOD_IFN .GE. 1 ) ZIFNNS(:,:,:,:) = PSVS(:,:,:,ISV_LIMA_IFN_NUCL:ISV_LIMA_IFN_NUCL+NMOD_IFN-1)
+!
+IF ( NMOD_IMM .GE. 1 ) ZIMMNT(:,:,:,:) = PSVS(:,:,:,ISV_LIMA_IMM_NUCL:ISV_LIMA_IMM_NUCL+NMOD_IMM-1) * PTSTEP
+IF ( NMOD_IMM .GE. 1 ) ZIMMNS(:,:,:,:) = PSVS(:,:,:,ISV_LIMA_IMM_NUCL:ISV_LIMA_IMM_NUCL+NMOD_IMM-1)
+!
+IF ( LHHONI ) ZHOMFT(:,:,:) = PSVS(:,:,:,ISV_LIMA_HOM_HAZE) * PTSTEP
+IF ( LHHONI ) ZHOMFS(:,:,:) = PSVS(:,:,:,ISV_LIMA_HOM_HAZE)
!
ZINV_TSTEP = 1./PTSTEP
-ZEXN(:,:,:) = (PPABST(:,:,:)/XP00)**(XRD/XCPD)
+ZEXN(:,:,:) = (PPABST(:,:,:)/CST%XP00)**(CST%XRD/CST%XCPD)
ZT(:,:,:) = ZTHT(:,:,:) * ZEXN(:,:,:)
!
!-------------------------------------------------------------------------------
!
!* 0. Check mean diameter for cloud, rain and ice
! --------------------------------------------
-! if ( lbu_enable ) then
-! if ( lbudget_rc .and. lwarm .and. lrain ) call Budget_store_init( tbudgets(NBUDGET_RC), 'CORR', zrcs(:, :, :) * prhodj(:, :, :) )
-! if ( lbudget_rr .and. lwarm .and. lrain ) call Budget_store_init( tbudgets(NBUDGET_RR), 'CORR', zrrs(:, :, :) * prhodj(:, :, :) )
-! if ( lbudget_ri .and. lcold .and. lsnow ) call Budget_store_init( tbudgets(NBUDGET_RI), 'CORR', zris(:, :, :) * prhodj(:, :, :) )
-! if ( lbudget_rs .and. lcold .and. lsnow ) call Budget_store_init( tbudgets(NBUDGET_RS), 'CORR', zrss(:, :, :) * prhodj(:, :, :) )
-! if ( lbudget_sv ) then
+! if ( BUCONF%lbu_enable ) then
+! if ( BUCONF%lbudget_rc .and. lwarm .and. lrain ) call BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RC), 'CORR', zrcs(:, :, :) * prhodj(:, :, :) )
+! if ( BUCONF%lbudget_rr .and. lwarm .and. lrain ) call BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RR), 'CORR', zrrs(:, :, :) * prhodj(:, :, :) )
+! if ( BUCONF%lbudget_ri .and. lcold .and. lsnow ) call BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RI), 'CORR', zris(:, :, :) * prhodj(:, :, :) )
+! if ( BUCONF%lbudget_rs .and. lcold .and. lsnow ) call BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RS), 'CORR', zrss(:, :, :) * prhodj(:, :, :) )
+! if ( BUCONF%lbudget_sv ) then
! if ( lwarm .and. lrain .and. nmom_c.ge.2) &
-! call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'CORR', zccs(:, :, :) * prhodj(:, :, :) )
+! call BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + nsv_lima_nc), 'CORR', zccs(:, :, :) * prhodj(:, :, :) )
! if ( lwarm .and. lrain .and. nmom_r.ge.2) &
-! call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'CORR', zcrs(:, :, :) * prhodj(:, :, :) )
+! call BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + nsv_lima_nr), 'CORR', zcrs(:, :, :) * prhodj(:, :, :) )
! if ( lcold .and. lsnow .and. nmom_i.ge.2) &
-! call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'CORR', zcis(:, :, :) * prhodj(:, :, :) )
+! call BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + nsv_lima_ni), 'CORR', zcis(:, :, :) * prhodj(:, :, :) )
! end if
! end if
-!!$IF (LWARM .AND. LRAIN) THEN
+!!$IF (NMOM_R.GE.2) THEN
!!$ WHERE( ZRCT>XRTMIN(2) .AND. ZCCT>XCTMIN(2) .AND. ZRCT>XAC*ZCCT*(100.E-6)**XBC )
!!$ ZRRT=ZRRT+ZRCT
!!$ ZRRS=ZRRS+ZRCS
@@ -637,7 +578,7 @@ ZT(:,:,:) = ZTHT(:,:,:) * ZEXN(:,:,:)
!!$ END WHERE
!!$END IF
!!$!
-!!$IF (LWARM .AND. LRAIN) THEN
+!!$IF (NMOM_R.GE.2) THEN
!!$ WHERE( ZRRT>XRTMIN(3) .AND. ZCRT>XCTMIN(3) .AND. ZRRT<XAR*ZCRT*(60.E-6)**XBR )
!!$ ZRCT=ZRCT+ZRRT
!!$ ZRCS=ZRCS+ZRRS
@@ -650,7 +591,7 @@ ZT(:,:,:) = ZTHT(:,:,:) * ZEXN(:,:,:)
!!$ END WHERE
!!$END IF
!!$!
-!!$IF (LCOLD .AND. LSNOW) THEN
+!!$IF (NMOM_S.GE.2) THEN
!!$ WHERE( ZRIT>XRTMIN(4) .AND. ZCIT>XCTMIN(4) .AND. ZRIT>XAI*ZCIT*(250.E-6)**XBI )
!!$ ZRST=ZRST+ZRIT
!!$ ZRSS=ZRSS+ZRIS
@@ -661,18 +602,18 @@ ZT(:,:,:) = ZTHT(:,:,:) * ZEXN(:,:,:)
!!$ END WHERE
!!$END IF
!
-! if ( lbu_enable ) then
-! if ( lbudget_rc .and. lwarm .and. lrain ) call Budget_store_end( tbudgets(NBUDGET_RC), 'CORR', zrcs(:, :, :) * prhodj(:, :, :) )
-! if ( lbudget_rr .and. lwarm .and. lrain ) call Budget_store_end( tbudgets(NBUDGET_RR), 'CORR', zrrs(:, :, :) * prhodj(:, :, :) )
-! if ( lbudget_ri .and. lcold .and. lsnow ) call Budget_store_end( tbudgets(NBUDGET_RI), 'CORR', zris(:, :, :) * prhodj(:, :, :) )
-! if ( lbudget_rs .and. lcold .and. lsnow ) call Budget_store_end( tbudgets(NBUDGET_RS), 'CORR', zrss(:, :, :) * prhodj(:, :, :) )
-! if ( lbudget_sv ) then
+! if ( BUCONF%lbu_enable ) then
+! if ( BUCONF%lbudget_rc .and. lwarm .and. lrain ) call BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_RC), 'CORR', zrcs(:, :, :) * prhodj(:, :, :) )
+! if ( BUCONF%lbudget_rr .and. lwarm .and. lrain ) call BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_RR), 'CORR', zrrs(:, :, :) * prhodj(:, :, :) )
+! if ( BUCONF%lbudget_ri .and. lcold .and. lsnow ) call BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_RI), 'CORR', zris(:, :, :) * prhodj(:, :, :) )
+! if ( BUCONF%lbudget_rs .and. lcold .and. lsnow ) call BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_RS), 'CORR', zrss(:, :, :) * prhodj(:, :, :) )
+! if ( BUCONF%lbudget_sv ) then
! if ( lwarm .and. lrain .and. nmom_c.ge.2) &
-! call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'CORR', zccs(:, :, :) * prhodj(:, :, :) )
+! call BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + nsv_lima_nc), 'CORR', zccs(:, :, :) * prhodj(:, :, :) )
! if ( lwarm .and. lrain .and. nmom_r.ge.2) &
-! call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'CORR', zcrs(:, :, :) * prhodj(:, :, :) )
+! call BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + nsv_lima_nr), 'CORR', zcrs(:, :, :) * prhodj(:, :, :) )
! if ( lcold .and. lsnow .and. nmom_i.ge.2) &
-! call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'CORR', zcis(:, :, :) * prhodj(:, :, :) )
+! call BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + nsv_lima_ni), 'CORR', zcis(:, :, :) * prhodj(:, :, :) )
! end if
! end if
!-------------------------------------------------------------------------------
@@ -688,102 +629,130 @@ PINPRI=0.
PINPRS=0.
PINPRG=0.
PINPRH=0.
-if ( lbu_enable ) then
- if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'SEDI', zths(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rc .and. lwarm .and. lsedc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'SEDI', zrcs(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rr .and. lwarm .and. lrain ) call Budget_store_init( tbudgets(NBUDGET_RR), 'SEDI', zrrs(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_ri .and. lcold .and. lsedi ) call Budget_store_init( tbudgets(NBUDGET_RI), 'SEDI', zris(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rs .and. lcold .and. lsnow ) call Budget_store_init( tbudgets(NBUDGET_RS), 'SEDI', zrss(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rg .and. lcold .and. lsnow ) call Budget_store_init( tbudgets(NBUDGET_RG), 'SEDI', zrgs(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rh .and. lcold .and. lhail ) call Budget_store_init( tbudgets(NBUDGET_RH), 'SEDI', zrhs(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_sv ) then
- if ( lwarm .and. lsedc .and. nmom_c.ge.2) &
- call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'SEDI', zccs(:, :, :) * prhodj(:, :, :) )
- if ( lwarm .and. lrain .and. nmom_r.ge.2) &
- call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'SEDI', zcrs(:, :, :) * prhodj(:, :, :) )
- if ( lcold .and. lsedi .and. nmom_i.ge.2) &
- call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'SEDI', zcis(:, :, :) * prhodj(:, :, :) )
+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_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(:, :, :) )
+ if ( nmom_r.ge.2) &
+ call BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + nsv_lima_nr), 'SEDI', zcrs(:, :, :) * prhodj(:, :, :) )
+ if ( lsedi .and. nmom_i.ge.2) &
+ call BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + nsv_lima_ni), 'SEDI', zcis(:, :, :) * prhodj(:, :, :) )
+ if ( nmom_s.ge.2) &
+ call BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + nsv_lima_ns), 'SEDI', zcss(:, :, :) * prhodj(:, :, :) )
+ if ( nmom_g.ge.2) &
+ 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(:, :, :) )
end if
end if
-
+PFPR(:,:,:,:)=0.
ZRT_SUM = (ZRVS + ZRCS + ZRRS + ZRIS + ZRSS + ZRGS + ZRHS)*PTSTEP
-ZCPT = XCPD + (XCPV * ZRVS + XCL * (ZRCS + ZRRS) + XCI * (ZRIS + ZRSS + ZRGS + ZRHS))*PTSTEP
-IF (LWARM .AND. LSEDC) CALL LIMA_SEDIMENTATION(IIB, IIE, IIT, IJB, IJE, IJT, IKB, IKE, IKTB, IKTE, IKT, KKL, &
- 'L', 2, 2, 1, PTSTEP, PDZZ, PRHODREF, PPABST, ZT, ZRT_SUM, ZCPT, ZRCS, ZCCS, PINPRC)
+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))
ZRT_SUM = (ZRVS + ZRCS + ZRRS + ZRIS + ZRSS + ZRGS + ZRHS)*PTSTEP
-ZCPT = XCPD + (XCPV * ZRVS + XCL * (ZRCS + ZRRS) + XCI * (ZRIS + ZRSS + ZRGS + ZRHS))*PTSTEP
-IF (LWARM .AND. LRAIN) CALL LIMA_SEDIMENTATION(IIB, IIE, IIT, IJB, IJE, IJT, IKB, IKE, IKTB, IKTE, IKT, KKL, &
- 'L', NMOM_R, 3, 1, PTSTEP, PDZZ, PRHODREF, PPABST, ZT, ZRT_SUM, ZCPT, ZRRS, ZCRS, PINPRR)
+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))
ZRT_SUM = (ZRVS + ZRCS + ZRRS + ZRIS + ZRSS + ZRGS + ZRHS)*PTSTEP
-ZCPT = XCPD + (XCPV * ZRVS + XCL * (ZRCS + ZRRS) + XCI * (ZRIS + ZRSS + ZRGS + ZRHS))*PTSTEP
-IF (LCOLD .AND. LSEDI) CALL LIMA_SEDIMENTATION(IIB, IIE, IIT, IJB, IJE, IJT, IKB, IKE, IKTB, IKTE, IKT, KKL, &
- 'I', NMOM_I, 4, 1, PTSTEP, PDZZ, PRHODREF, PPABST, ZT, ZRT_SUM, ZCPT, ZRIS, ZCIS, ZW2D)
+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))
ZRT_SUM = (ZRVS + ZRCS + ZRRS + ZRIS + ZRSS + ZRGS + ZRHS)*PTSTEP
-ZCPT = XCPD + (XCPV * ZRVS + XCL * (ZRCS + ZRRS) + XCI * (ZRIS + ZRSS + ZRGS + ZRHS))*PTSTEP
-IF (LCOLD .AND. LSNOW) CALL LIMA_SEDIMENTATION(IIB, IIE, IIT, IJB, IJE, IJT, IKB, IKE, IKTB, IKTE, IKT, KKL, &
- 'I', NMOM_S, 5, 1, PTSTEP, PDZZ, PRHODREF, PPABST, ZT, ZRT_SUM, ZCPT, ZRSS, ZCSS, PINPRS)
+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))
ZRT_SUM = (ZRVS + ZRCS + ZRRS + ZRIS + ZRSS + ZRGS + ZRHS)*PTSTEP
-ZCPT = XCPD + (XCPV * ZRVS + XCL * (ZRCS + ZRRS) + XCI * (ZRIS + ZRSS + ZRGS + ZRHS))*PTSTEP
-IF (LCOLD .AND. LSNOW) CALL LIMA_SEDIMENTATION(IIB, IIE, IIT, IJB, IJE, IJT, IKB, IKE, IKTB, IKTE, IKT, KKL, &
- 'I', NMOM_G, 6, 1, PTSTEP, PDZZ, PRHODREF, PPABST, ZT, ZRT_SUM, ZCPT, ZRGS, ZCGS, PINPRG)
+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))
ZRT_SUM = (ZRVS + ZRCS + ZRRS + ZRIS + ZRSS + ZRGS + ZRHS)*PTSTEP
-ZCPT = XCPD + (XCPV * ZRVS + XCL * (ZRCS + ZRRS) + XCI * (ZRIS + ZRSS + ZRGS + ZRHS))*PTSTEP
-IF (LCOLD .AND. LHAIL) CALL LIMA_SEDIMENTATION(IIB, IIE, IIT, IJB, IJE, IJT, IKB, IKE, IKTB, IKTE, IKT, KKL, &
- 'I', NMOM_H, 7, 1, PTSTEP, PDZZ, PRHODREF, PPABST, ZT, ZRT_SUM, ZCPT, ZRHS, ZCHS, PINPRH)
+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))
!
ZTHS(:,:,:) = ZT(:,:,:) / ZEXN(:,:,:) * ZINV_TSTEP
!
! Call budgets
!
-if ( lbu_enable ) then
- if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'SEDI', zths(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rc .and. lwarm .and. lsedc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'SEDI', zrcs(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rr .and. lwarm .and. lrain ) call Budget_store_end( tbudgets(NBUDGET_RR), 'SEDI', zrrs(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_ri .and. lcold .and. lsedi ) call Budget_store_end( tbudgets(NBUDGET_RI), 'SEDI', zris(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rs .and. lcold .and. lsnow ) call Budget_store_end( tbudgets(NBUDGET_RS), 'SEDI', zrss(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rg .and. lcold .and. lsnow ) call Budget_store_end( tbudgets(NBUDGET_RG), 'SEDI', zrgs(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rh .and. lcold .and. lhail ) call Budget_store_end( tbudgets(NBUDGET_RH), 'SEDI', zrhs(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_sv ) then
- if ( lwarm .and. lsedc .and. nmom_c.ge.2) &
- call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'SEDI', zccs(:, :, :) * prhodj(:, :, :) )
- if ( lwarm .and. lrain .and. nmom_r.ge.2) &
- call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'SEDI', zcrs(:, :, :) * prhodj(:, :, :) )
- if ( lcold .and. lsedi .and. nmom_i.ge.2) &
- call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'SEDI', zcis(:, :, :) * prhodj(:, :, :) )
+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_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(:, :, :) )
+ if ( nmom_r.ge.2 ) &
+ call BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + nsv_lima_nr), 'SEDI', zcrs(:, :, :) * prhodj(:, :, :) )
+ if ( lsedi .and. nmom_i.ge.2 ) &
+ call BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + nsv_lima_ni), 'SEDI', zcis(:, :, :) * prhodj(:, :, :) )
+ if ( nmom_s.ge.2 ) &
+ call BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + nsv_lima_ns), 'SEDI', zcss(:, :, :) * prhodj(:, :, :) )
+ if ( nmom_g.ge.2 ) &
+ 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(:, :, :) )
end if
end if
!
! 1.bis Deposition at 1st level above ground
!
-IF (LWARM .AND. LDEPOC) THEN
- if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'DEPO', zrcs(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_sv .and. nmom_c.ge.2) &
- call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'DEPO', zccs(:, :, :) * prhodj(:, :, :) )
+IF (NMOM_C.GE.1 .AND. LDEPOC) THEN
+ if ( BUCONF%lbudget_rc ) call BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RC), 'DEPO', zrcs(:, :, :) * prhodj(:, :, :) )
+ if ( BUCONF%lbudget_sv .and. nmom_c.ge.2) &
+ call BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + nsv_lima_nc), 'DEPO', zccs(:, :, :) * prhodj(:, :, :) )
PINDEP(:,:)=0.
GDEP(:,:) = .FALSE.
- GDEP(:,:) = ZRCS(:,:,IKB) >0 .AND. ZCCS(:,:,IKB) >0 .AND. ZRCT(:,:,IKB) >0 .AND. ZCCT(:,:,IKB) >0
+ GDEP(:,:) = ZRCS(:,:,D%NKB) >0 .AND. ZCCS(:,:,D%NKB) >0 .AND. ZRCT(:,:,D%NKB) >0 .AND. ZCCT(:,:,D%NKB) >0
WHERE (GDEP)
- ZRCS(:,:,IKB) = ZRCS(:,:,IKB) - XVDEPOC * ZRCT(:,:,IKB) / PDZZ(:,:,IKB)
- ZCCS(:,:,IKB) = ZCCS(:,:,IKB) - XVDEPOC * ZCCT(:,:,IKB) / PDZZ(:,:,IKB)
- PINPRC(:,:) = PINPRC(:,:) + XVDEPOC * ZRCT(:,:,IKB) * PRHODREF(:,:,IKB) /XRHOLW
- PINDEP(:,:) = XVDEPOC * ZRCT(:,:,IKB) * PRHODREF(:,:,IKB) /XRHOLW
+ ZRCS(:,:,D%NKB) = ZRCS(:,:,D%NKB) - XVDEPOC * ZRCT(:,:,D%NKB) / PDZZ(:,:,D%NKB)
+ ZCCS(:,:,D%NKB) = ZCCS(:,:,D%NKB) - XVDEPOC * ZCCT(:,:,D%NKB) / PDZZ(:,:,D%NKB)
+ PINPRC(:,:) = PINPRC(:,:) + XVDEPOC * ZRCT(:,:,D%NKB) * PRHODREF(:,:,D%NKB) /CST%XRHOLW
+ PINDEP(:,:) = XVDEPOC * ZRCT(:,:,D%NKB) * PRHODREF(:,:,D%NKB) /CST%XRHOLW
END WHERE
- if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'DEPO', zrcs(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_sv .and. nmom_c.ge.2) &
- call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'DEPO', zccs(:, :, :) * prhodj(:, :, :) )
+ if ( BUCONF%lbudget_rc ) call BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_RC), 'DEPO', zrcs(:, :, :) * prhodj(:, :, :) )
+ if ( BUCONF%lbudget_sv .and. nmom_c.ge.2) &
+ call BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + nsv_lima_nc), 'DEPO', zccs(:, :, :) * prhodj(:, :, :) )
END IF
!
!
-!!$IF (LWARM .AND. LRAIN) THEN
-!!$ if( lbu_enable ) then
-!!$ if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'R2C1', zrcs(:, :, :) * prhodj(:, :, :) )
-!!$ if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'R2C1', zrrs(:, :, :) * prhodj(:, :, :) )
-!!$ if ( lbudget_sv .and. nmom_c.ge.2) &
-!!$ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'R2C1', zccs(:, :, :) * prhodj(:, :, :) )
-!!$ if ( lbudget_sv .and. nmom_r.ge.2) &
-!!$ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'R2C1', zcrs(:, :, :) * prhodj(:, :, :) )
+!!$Z_RR_CVRC(:,:,:) = 0.
+!!$Z_CR_CVRC(:,:,:) = 0.
+!!$IF (NMOM_R.GE.2) THEN
+!!$ if( BUCONF%lbu_enable ) then
+!!$ if ( BUCONF%lbudget_rc ) call BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RC), 'R2C1', zrcs(:, :, :) * prhodj(:, :, :) )
+!!$ if ( BUCONF%lbudget_rr ) call BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RR), 'R2C1', zrrs(:, :, :) * prhodj(:, :, :) )
+!!$ if ( BUCONF%lbudget_sv .and. nmom_c.ge.2) &
+!!$ call BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + nsv_lima_nc), 'R2C1', zccs(:, :, :) * prhodj(:, :, :) )
+!!$ if ( BUCONF%lbudget_sv .and. nmom_r.ge.2) &
+!!$ call BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + nsv_lima_nr), 'R2C1', zcrs(:, :, :) * prhodj(:, :, :) )
!!$ end if
!!$
!!$ CALL LIMA_DROPS_TO_DROPLETS_CONV(PRHODREF, ZRCS*PTSTEP, ZRRS*PTSTEP, ZCCS*PTSTEP, ZCRS*PTSTEP, &
@@ -794,13 +763,13 @@ END IF
!!$ ZCCS(:,:,:) = ZCCS(:,:,:) - Z_CR_CVRC(:,:,:)/PTSTEP
!!$ ZCRS(:,:,:) = ZCRS(:,:,:) + Z_CR_CVRC(:,:,:)/PTSTEP
!!$
-!!$ if( lbu_enable ) then
-!!$ if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'R2C1', zrcs(:, :, :) * prhodj(:, :, :) )
-!!$ if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'R2C1', zrrs(:, :, :) * prhodj(:, :, :) )
-!!$ if ( lbudget_sv .and. nmom_c.ge.2) &
-!!$ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'R2C1', zccs(:, :, :) * prhodj(:, :, :) )
-!!$ if ( lbudget_sv .and. nmom_r.ge.2) &
-!!$ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'R2C1', zcrs(:, :, :) * prhodj(:, :, :) )
+!!$ if( BUCONF%lbu_enable ) then
+!!$ if ( BUCONF%lbudget_rc ) call BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_RC), 'R2C1', zrcs(:, :, :) * prhodj(:, :, :) )
+!!$ if ( BUCONF%lbudget_rr ) call BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_RR), 'R2C1', zrrs(:, :, :) * prhodj(:, :, :) )
+!!$ if ( BUCONF%lbudget_sv .and. nmom_c.ge.2) &
+!!$ call BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + nsv_lima_nc), 'R2C1', zccs(:, :, :) * prhodj(:, :, :) )
+!!$ if ( BUCONF%lbudget_sv .and. nmom_r.ge.2) &
+!!$ call BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + nsv_lima_nr), 'R2C1', zcrs(:, :, :) * prhodj(:, :, :) )
!!$ end if
!!$END IF
!
@@ -816,19 +785,19 @@ IF ( KRR .GE. 5 ) ZRST(:,:,:) = ZRSS(:,:,:) * PTSTEP
IF ( KRR .GE. 6 ) ZRGT(:,:,:) = ZRGS(:,:,:) * PTSTEP
IF ( KRR .GE. 7 ) ZRHT(:,:,:) = ZRHS(:,:,:) * PTSTEP
!
-IF ( LWARM .AND. NMOM_C.GE.2 ) ZCCT(:,:,:) = ZCCS(:,:,:) * PTSTEP
-IF ( LWARM .AND. LRAIN .AND. NMOM_R.GE.2 ) ZCRT(:,:,:) = ZCRS(:,:,:) * PTSTEP
-IF ( LCOLD .AND. NMOM_I.GE.2 ) ZCIT(:,:,:) = ZCIS(:,:,:) * PTSTEP
-IF ( LCOLD .AND. NMOM_S.GE.2 ) ZCST(:,:,:) = ZCSS(:,:,:) * PTSTEP
-IF ( LCOLD .AND. NMOM_G.GE.2 ) ZCGT(:,:,:) = ZCGS(:,:,:) * PTSTEP
-IF ( LCOLD .AND. NMOM_H.GE.2 ) ZCHT(:,:,:) = ZCHS(:,:,:) * PTSTEP
+IF ( NMOM_C.GE.2 ) ZCCT(:,:,:) = ZCCS(:,:,:) * PTSTEP
+IF ( NMOM_R.GE.2 ) ZCRT(:,:,:) = ZCRS(:,:,:) * PTSTEP
+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
!
!-------------------------------------------------------------------------------
!
!* 2. Compute cloud, ice and precipitation fractions
! ----------------------------------------------
!
-CALL LIMA_COMPUTE_CLOUD_FRACTIONS (IIB, IIE, IJB, IJE, IKB, IKE, KKL, &
+CALL LIMA_COMPUTE_CLOUD_FRACTIONS (D, &
ZCCT, ZRCT, &
ZCRT, ZRRT, &
ZCIT, ZRIT, &
@@ -842,9 +811,10 @@ CALL LIMA_COMPUTE_CLOUD_FRACTIONS (IIB, IIE, IJB, IJE, IKB, IKE, KKL, &
!* 2. Nucleation processes
! --------------------
!
-CALL LIMA_NUCLEATION_PROCS (PTSTEP, TPFILE, PRHODJ, &
+CALL LIMA_NUCLEATION_PROCS (D, CST, BUCONF, TBUDGETS, KBUDGETS, &
+ PTSTEP, PRHODJ, &
PRHODREF, ZEXN, PPABST, ZT, PDTHRAD, PW_NU, &
- ZTHT, ZRVT, ZRCT, ZRRT, ZRIT, ZRST, ZRGT, &
+ ZTHT, ZRVT, ZRCT, ZRRT, ZRIT, ZRST, ZRGT, ZRHT, &
ZCCT, ZCRT, ZCIT, &
ZCCNFT, ZCCNAT, ZIFNFT, ZIFNNT, ZIMMNT, ZHOMFT, &
PCLDFR, PICEFR, PPRCFR )
@@ -898,7 +868,7 @@ ZTIME(:,:,:)=0. ! Current integration time (all points may have a different inte
ZRT_SUM(:,:,:) = ZRCT(:,:,:) + ZRRT(:,:,:) + ZRIT(:,:,:) + ZRST(:,:,:) + ZRGT(:,:,:) + ZRHT(:,:,:)
WHERE (ZRT_SUM(:,:,:)<XRTMIN(2)) ZTIME(:,:,:)=PTSTEP ! no need to treat hydrometeor-free point
!
-DO WHILE(ANY(ZTIME(IIB:IIE,IJB:IJE,IKTB:IKTE)<PTSTEP))
+DO WHILE(ANY(ZTIME(D%NIB:D%NIE,D%NJB:D%NJE,D%NKTB:D%NKTE)<PTSTEP))
!
IF(XMRSTEP/=0.) THEN
! In this case we need to remember the mixing ratios used to compute the tendencies
@@ -919,7 +889,7 @@ DO WHILE(ANY(ZTIME(IIB:IIE,IJB:IJE,IKTB:IKTE)<PTSTEP))
ENDIF
!
LLCOMPUTE(:,:,:)=.FALSE.
- LLCOMPUTE(IIB:IIE,IJB:IJE,IKTB:IKTE) = ZTIME(IIB:IIE,IJB:IJE,IKTB:IKTE)<PTSTEP ! Compuation only for points for which integration time has not reached the timestep
+ LLCOMPUTE(D%NIB:D%NIE,D%NJB:D%NJE,D%NKTB:D%NKTE) = ZTIME(D%NIB:D%NIE,D%NJB:D%NJE,D%NKTB:D%NKTE)<PTSTEP ! Compuation only for points for which integration time has not reached the timestep
WHERE(LLCOMPUTE(:,:,:))
IITER(:,:,:)=IITER(:,:,:)+1
END WHERE
@@ -1233,13 +1203,13 @@ DO WHILE(ANY(ZTIME(IIB:IIE,IJB:IJE,IKTB:IKTE)<PTSTEP))
! We need to adjust tendencies when temperature reaches 0
IF(LFEEDBACKT) THEN
!Is ZB_TH enough to change temperature sign?
- WHERE( ((ZTHT1D(:) - XTT/ZEXN1D(:)) * (ZTHT1D(:) + ZB_TH(:) - XTT/ZEXN1D(:))) < 0. )
+ WHERE( ((ZTHT1D(:) - CST%XTT/ZEXN1D(:)) * (ZTHT1D(:) + ZB_TH(:) - CST%XTT/ZEXN1D(:))) < 0. )
ZMAXTIME(:)=0.
ENDWHERE
!Can ZA_TH make temperature change of sign?
ZTIME_THRESHOLD(:)=-1.
WHERE(ABS(ZA_TH(:))>1.E-20)
- ZTIME_THRESHOLD(:)=(XTT/ZEXN1D(:) - ZB_TH(:) - ZTHT1D(:))/ZA_TH(:)
+ ZTIME_THRESHOLD(:)=(CST%XTT/ZEXN1D(:) - ZB_TH(:) - ZTHT1D(:))/ZA_TH(:)
ENDWHERE
WHERE(ZTIME_THRESHOLD(:)>0.)
ZMAXTIME(:)=MIN(ZMAXTIME(:), ZTIME_THRESHOLD(:))
@@ -1455,7 +1425,7 @@ DO WHILE(ANY(ZTIME(IIB:IIE,IJB:IJE,IKTB:IKTE)<PTSTEP))
!
!*** 4.4 Unpacking for budgets
!
- IF(LBU_ENABLE) THEN
+ IF(BUCONF%LBU_ENABLE) THEN
ZTOT_RR_CVRC(:,:,:) = ZTOT_RR_CVRC(:,:,:) + Z_RR_CVRC(:,:,:)
ZTOT_CR_CVRC(:,:,:) = ZTOT_CR_CVRC(:,:,:) + Z_CR_CVRC(:,:,:)
@@ -1803,248 +1773,248 @@ IF ( KRR .GE. 5 ) PRS(:,:,:,5) = ZRST(:,:,:) *ZINV_TSTEP
IF ( KRR .GE. 6 ) PRS(:,:,:,6) = ZRGT(:,:,:) *ZINV_TSTEP
IF ( KRR .GE. 7 ) PRS(:,:,:,7) = ZRHT(:,:,:) *ZINV_TSTEP
!
-IF ( LWARM .AND. NMOM_C.GE.2 ) PSVS(:,:,:,NSV_LIMA_NC) = ZCCT(:,:,:) *ZINV_TSTEP
-IF ( LWARM .AND. LRAIN .AND. NMOM_R.GE.2 ) PSVS(:,:,:,NSV_LIMA_NR) = ZCRT(:,:,:) *ZINV_TSTEP
-IF ( LCOLD .AND. NMOM_I.GE.2 ) PSVS(:,:,:,NSV_LIMA_NI) = ZCIT(:,:,:) *ZINV_TSTEP
-IF ( LCOLD .AND. NMOM_S.GE.2 ) PSVS(:,:,:,NSV_LIMA_NS) = ZCST(:,:,:) *ZINV_TSTEP
-IF ( LCOLD .AND. NMOM_G.GE.2 ) PSVS(:,:,:,NSV_LIMA_NG) = ZCGT(:,:,:) *ZINV_TSTEP
-IF ( LCOLD .AND. NMOM_H.GE.2 ) PSVS(:,:,:,NSV_LIMA_NH) = ZCHT(:,:,:) *ZINV_TSTEP
+IF ( NMOM_C.GE.2 ) PSVS(:,:,:,ISV_LIMA_NC) = ZCCT(:,:,:) *ZINV_TSTEP
+IF ( NMOM_R.GE.2 ) PSVS(:,:,:,ISV_LIMA_NR) = ZCRT(:,:,:) *ZINV_TSTEP
+IF ( NMOM_I.GE.2 ) PSVS(:,:,:,ISV_LIMA_NI) = ZCIT(:,:,:) *ZINV_TSTEP
+IF ( NMOM_S.GE.2 ) PSVS(:,:,:,ISV_LIMA_NS) = ZCST(:,:,:) *ZINV_TSTEP
+IF ( NMOM_G.GE.2 ) PSVS(:,:,:,ISV_LIMA_NG) = ZCGT(:,:,:) *ZINV_TSTEP
+IF ( NMOM_H.GE.2 ) PSVS(:,:,:,ISV_LIMA_NH) = ZCHT(:,:,:) *ZINV_TSTEP
!
-IF ( NMOD_CCN .GE. 1 ) PSVS(:,:,:,NSV_LIMA_CCN_FREE:NSV_LIMA_CCN_FREE+NMOD_CCN-1) = ZCCNFT(:,:,:,:) *ZINV_TSTEP
-IF ( NMOD_CCN .GE. 1 ) PSVS(:,:,:,NSV_LIMA_CCN_ACTI:NSV_LIMA_CCN_ACTI+NMOD_CCN-1) = ZCCNAT(:,:,:,:) *ZINV_TSTEP
-IF ( NMOD_IFN .GE. 1 ) PSVS(:,:,:,NSV_LIMA_IFN_FREE:NSV_LIMA_IFN_FREE+NMOD_IFN-1) = ZIFNFT(:,:,:,:) *ZINV_TSTEP
-IF ( NMOD_IFN .GE. 1 ) PSVS(:,:,:,NSV_LIMA_IFN_NUCL:NSV_LIMA_IFN_NUCL+NMOD_IFN-1) = ZIFNNT(:,:,:,:) *ZINV_TSTEP
-IF ( NMOD_IMM .GE. 1 ) PSVS(:,:,:,NSV_LIMA_IMM_NUCL:NSV_LIMA_IMM_NUCL+NMOD_IMM-1) = ZIMMNT(:,:,:,:) *ZINV_TSTEP
-IF ( LCOLD .AND. LHHONI) PSVS(:,:,:,NSV_LIMA_HOM_HAZE) = ZHOMFT(:,:,:) *ZINV_TSTEP
+IF ( NMOD_CCN .GE. 1 ) PSVS(:,:,:,ISV_LIMA_CCN_FREE:ISV_LIMA_CCN_FREE+NMOD_CCN-1) = ZCCNFT(:,:,:,:) *ZINV_TSTEP
+IF ( NMOD_CCN .GE. 1 ) PSVS(:,:,:,ISV_LIMA_CCN_ACTI:ISV_LIMA_CCN_ACTI+NMOD_CCN-1) = ZCCNAT(:,:,:,:) *ZINV_TSTEP
+IF ( NMOD_IFN .GE. 1 ) PSVS(:,:,:,ISV_LIMA_IFN_FREE:ISV_LIMA_IFN_FREE+NMOD_IFN-1) = ZIFNFT(:,:,:,:) *ZINV_TSTEP
+IF ( NMOD_IFN .GE. 1 ) PSVS(:,:,:,ISV_LIMA_IFN_NUCL:ISV_LIMA_IFN_NUCL+NMOD_IFN-1) = ZIFNNT(:,:,:,:) *ZINV_TSTEP
+IF ( NMOD_IMM .GE. 1 ) PSVS(:,:,:,ISV_LIMA_IMM_NUCL:ISV_LIMA_IMM_NUCL+NMOD_IMM-1) = ZIMMNT(:,:,:,:) *ZINV_TSTEP
+IF ( LHHONI) PSVS(:,:,:,ISV_LIMA_HOM_HAZE) = ZHOMFT(:,:,:) *ZINV_TSTEP
!
!
!
! Call budgets
!
-if ( lbu_enable ) then
+if ( BUCONF%lbu_enable ) then
allocate( zrhodjontstep(size( prhodj, 1), size( prhodj, 2), size( prhodj, 3) ) )
zrhodjontstep(:, :, :) = zinv_tstep * prhodj(:, :, :)
- if ( lbudget_th ) then
- call Budget_store_add( tbudgets(NBUDGET_TH), 'REVA', ztot_th_evap (:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_TH), 'HONC', ztot_th_honc (:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_TH), 'HONR', ztot_th_honr (:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_TH), 'DEPS', ztot_th_deps (:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_TH), 'DEPI', ztot_th_depi (:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_TH), 'DEPG', ztot_th_depg (:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_TH), 'IMLT', ztot_th_imlt (:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_TH), 'BERFI', ztot_th_berfi(:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_TH), 'RIM', ztot_th_rim (:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_TH), 'ACC', ztot_th_acc (:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_TH), 'CFRZ', ztot_th_cfrz (:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_TH), 'WETG', ztot_th_wetg (:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_TH), 'DRYG', ztot_th_dryg (:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_TH), 'GMLT', ztot_th_gmlt (:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_TH), 'DEPH', ztot_th_deph (:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_TH), 'WETH', ztot_th_weth (:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_TH), 'HMLT', ztot_th_hmlt (:, :, :) * zrhodjontstep(:, :, :) )
+ if ( BUCONF%lbudget_th ) then
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_TH), 'REVA', ztot_th_evap (:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_TH), 'HONC', ztot_th_honc (:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_TH), 'HONR', ztot_th_honr (:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_TH), 'DEPS', ztot_th_deps (:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_TH), 'DEPI', ztot_th_depi (:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_TH), 'DEPG', ztot_th_depg (:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_TH), 'IMLT', ztot_th_imlt (:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_TH), 'BERFI', ztot_th_berfi(:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_TH), 'RIM', ztot_th_rim (:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_TH), 'ACC', ztot_th_acc (:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_TH), 'CFRZ', ztot_th_cfrz (:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_TH), 'WETG', ztot_th_wetg (:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_TH), 'DRYG', ztot_th_dryg (:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_TH), 'GMLT', ztot_th_gmlt (:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_TH), 'DEPH', ztot_th_deph (:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_TH), 'WETH', ztot_th_weth (:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_TH), 'HMLT', ztot_th_hmlt (:, :, :) * zrhodjontstep(:, :, :) )
end if
- if ( lbudget_rv ) then
- call Budget_store_add( tbudgets(NBUDGET_RV), 'REVA', -ztot_rr_evap (:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_RV), 'DEPS', -ztot_rs_deps (:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_RV), 'DEPI', -ztot_ri_depi (:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_RV), 'DEPG', -ztot_rg_depg (:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_RV), 'CORR2', ztot_rv_corr2(:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_RV), 'DEPH', -ztot_rh_deph (:, :, :) * zrhodjontstep(:, :, :) )
+ if ( BUCONF%lbudget_rv ) then
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RV), 'REVA', -ztot_rr_evap (:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RV), 'DEPS', -ztot_rs_deps (:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RV), 'DEPI', -ztot_ri_depi (:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RV), 'DEPG', -ztot_rg_depg (:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RV), 'CORR2', ztot_rv_corr2(:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RV), 'DEPH', -ztot_rh_deph (:, :, :) * zrhodjontstep(:, :, :) )
end if
- if ( lbudget_rc ) then
- call Budget_store_add( tbudgets(NBUDGET_RC), 'AUTO', ztot_rc_auto (:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_RC), 'ACCR', ztot_rc_accr (:, :, :) * zrhodjontstep(:, :, :) )
- !call Budget_store_add( tbudgets(NBUDGET_RC), 'REVA', 0. )
- call Budget_store_add( tbudgets(NBUDGET_RC), 'HONC', ztot_rc_honc (:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_RC), 'IMLT', ztot_rc_imlt (:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_RC), 'BERFI', ztot_rc_berfi(:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_RC), 'RIM', ztot_rc_rim (:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_RC), 'WETG', ztot_rc_wetg (:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_RC), 'DRYG', ztot_rc_dryg (:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_RC), 'CVRC', -ztot_rr_cvrc (:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_RC), 'CORR2', ztot_rc_corr2(:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_RC), 'WETH', ztot_rc_weth(:, :, :) * zrhodjontstep(:, :, :) )
+ if ( BUCONF%lbudget_rc ) then
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RC), 'AUTO', ztot_rc_auto (:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RC), 'ACCR', ztot_rc_accr (:, :, :) * zrhodjontstep(:, :, :) )
+ !call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RC), 'REVA', 0. )
+ 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), '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(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RC), 'CORR2', ztot_rc_corr2(:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RC), 'WETH', ztot_rc_weth(:, :, :) * zrhodjontstep(:, :, :) )
end if
- if ( lbudget_rr ) then
- call Budget_store_add( tbudgets(NBUDGET_RR), 'AUTO', -ztot_rc_auto(:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_RR), 'ACCR', -ztot_rc_accr(:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_RR), 'REVA', ztot_rr_evap(:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_RR), 'HONR', ztot_rr_honr(:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_RR), 'ACC', ztot_rr_acc (:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_RR), 'CFRZ', ztot_rr_cfrz(:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_RR), 'WETG', ztot_rr_wetg(:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_RR), 'DRYG', ztot_rr_dryg(:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_RR), 'GMLT', ztot_rr_gmlt(:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_RR), 'CVRC', ztot_rr_cvrc(:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_RR), 'CORR2', ztot_rr_corr2(:, :, :)* zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_RR), 'WETH', ztot_rr_weth(:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_RR), 'HMLT', ztot_rr_hmlt(:, :, :) * zrhodjontstep(:, :, :) )
+ if ( BUCONF%lbudget_rr ) then
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RR), 'AUTO', -ztot_rc_auto(:, :, :) * zrhodjontstep(:, :, :) )
+ 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), '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(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RR), 'GMLT', ztot_rr_gmlt(:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RR), 'CVRC', ztot_rr_cvrc(:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RR), 'CORR2', ztot_rr_corr2(:, :, :)* zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RR), 'WETH', ztot_rr_weth(:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RR), 'HMLT', ztot_rr_hmlt(:, :, :) * zrhodjontstep(:, :, :) )
end if
- if ( lbudget_ri ) then
- call Budget_store_add( tbudgets(NBUDGET_RI), 'HONC', -ztot_rc_honc (:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_RI), 'CNVI', ztot_ri_cnvi (:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_RI), 'CNVS', ztot_ri_cnvs (:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_RI), 'AGGS', ztot_ri_aggs (:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_RI), 'IMLT', -ztot_rc_imlt (:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_RI), 'BERFI', -ztot_rc_berfi(:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_RI), 'HMS', ztot_ri_hms (:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_RI), 'CFRZ', ztot_ri_cfrz (:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_RI), 'DEPI', ztot_ri_depi (:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_RI), 'CIBU', ztot_ri_cibu (:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_RI), 'RDSF', ztot_ri_rdsf (:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_RI), 'WETG', ztot_ri_wetg (:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_RI), 'DRYG', ztot_ri_dryg (:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_RI), 'HMG', ztot_ri_hmg (:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_RI), 'CORR2', ztot_ri_corr2(:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_RI), 'WETH', ztot_ri_weth (:, :, :) * zrhodjontstep(:, :, :) )
+ if ( BUCONF%lbudget_ri ) then
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RI), 'HONC', -ztot_rc_honc (:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RI), 'CNVI', ztot_ri_cnvi (:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RI), 'CNVS', ztot_ri_cnvs (:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RI), 'AGGS', ztot_ri_aggs (:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RI), 'IMLT', -ztot_rc_imlt (:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RI), 'BERFI', -ztot_rc_berfi(:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RI), 'HMS', ztot_ri_hms (:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RI), 'CFRZ', ztot_ri_cfrz (:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RI), 'DEPI', ztot_ri_depi (:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RI), 'CIBU', ztot_ri_cibu (:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RI), 'RDSF', ztot_ri_rdsf (:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RI), 'WETG', ztot_ri_wetg (:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RI), 'DRYG', ztot_ri_dryg (:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RI), 'HMG', ztot_ri_hmg (:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RI), 'CORR2', ztot_ri_corr2(:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RI), 'WETH', ztot_ri_weth (:, :, :) * zrhodjontstep(:, :, :) )
end if
- if ( lbudget_rs ) then
- call Budget_store_add( tbudgets(NBUDGET_RS), 'CNVI', -ztot_ri_cnvi(:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_RS), 'DEPS', ztot_rs_deps(:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_RS), 'CNVS', -ztot_ri_cnvs(:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_RS), 'AGGS', -ztot_ri_aggs(:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_RS), 'RIM', ztot_rs_rim (:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_RS), 'HMS', ztot_rs_hms (:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_RS), 'ACC', ztot_rs_acc (:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_RS), 'CMEL', ztot_rs_cmel(:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_RS), 'CIBU', -ztot_ri_cibu(:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_RS), 'WETG', ztot_rs_wetg(:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_RS), 'DRYG', ztot_rs_dryg(:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_RS), 'WETH', ztot_rs_weth(:, :, :) * zrhodjontstep(:, :, :) )
+ if ( BUCONF%lbudget_rs ) then
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RS), 'CNVI', -ztot_ri_cnvi(:, :, :) * zrhodjontstep(:, :, :) )
+ 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), '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), '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(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RS), 'DRYG', ztot_rs_dryg(:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RS), 'WETH', ztot_rs_weth(:, :, :) * zrhodjontstep(:, :, :) )
end if
- if ( lbudget_rg ) then
- call Budget_store_add( tbudgets(NBUDGET_RG), 'HONR', -ztot_rr_honr(:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_RG), 'DEPG', ztot_rg_depg(:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_RG), 'RIM', ztot_rg_rim (:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_RG), 'ACC', ztot_rg_acc (:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_RG), 'CMEL', -ztot_rs_cmel(:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_RG), 'CFRZ', ( -ztot_rr_cfrz(:, :, :) - ztot_ri_cfrz(:, :, :) ) &
+ 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), 'CMEL', -ztot_rs_cmel(:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RG), 'CFRZ', ( -ztot_rr_cfrz(:, :, :) - ztot_ri_cfrz(:, :, :) ) &
* zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_RG), 'RDSF', -ztot_ri_rdsf(:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_RG), 'WETG', ztot_rg_wetg(:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_RG), 'DRYG', ztot_rg_dryg(:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_RG), 'HMG', ztot_rg_hmg (:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_RG), 'GMLT', -ztot_rr_gmlt(:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_RG), 'WETH', ztot_rg_weth(:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_RG), 'COHG', ztot_rg_cohg(:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RG), 'RDSF', -ztot_ri_rdsf(:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RG), 'WETG', ztot_rg_wetg(:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RG), 'DRYG', ztot_rg_dryg(:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RG), 'HMG', ztot_rg_hmg (:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RG), 'GMLT', -ztot_rr_gmlt(:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RG), 'WETH', ztot_rg_weth(:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RG), 'COHG', ztot_rg_cohg(:, :, :) * zrhodjontstep(:, :, :) )
end if
- if ( lbudget_rh ) then
- call Budget_store_add( tbudgets(NBUDGET_RH), 'WETG', ztot_rh_wetg(:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_RH), 'DEPH', ztot_rh_deph(:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_RH), 'WETH', ztot_rh_weth(:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_RH), 'COHG', -ztot_rg_cohg(:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_RH), 'HMLT', -ztot_rr_hmlt(:, :, :) * zrhodjontstep(:, :, :) )
+ if ( BUCONF%lbudget_rh ) then
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RH), 'WETG', ztot_rh_wetg(:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RH), 'DEPH', ztot_rh_deph(:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RH), 'WETH', ztot_rh_weth(:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RH), 'COHG', -ztot_rg_cohg(:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RH), 'HMLT', -ztot_rr_hmlt(:, :, :) * zrhodjontstep(:, :, :) )
end if
- if ( lbudget_sv ) then
+ if ( BUCONF%lbudget_sv ) then
!
! Cloud droplets
!
if (nmom_c.ge.2) then
idx = NBUDGET_SV1 - 1 + nsv_lima_nc
- call Budget_store_add( tbudgets(idx), 'SELF', ztot_cc_self (:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(idx), 'AUTO', ztot_cc_auto (:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(idx), 'ACCR', ztot_cc_accr (:, :, :) * zrhodjontstep(:, :, :) )
- !call Budget_store_add( tbudgets(idx), 'REVA', 0. )
- call Budget_store_add( tbudgets(idx), 'HONC', ztot_cc_honc (:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(idx), 'IMLT', ztot_cc_imlt (:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(idx), 'RIM', ztot_cc_rim (:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(idx), 'WETG', ztot_cc_wetg (:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(idx), 'DRYG', ztot_cc_dryg (:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(idx), 'CVRC', -ztot_cr_cvrc (:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(idx), 'CORR2', ztot_cc_corr2(:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(idx), 'WETH', ztot_cc_weth (:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(idx), 'SELF', ztot_cc_self (:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(idx), 'AUTO', ztot_cc_auto (:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(idx), 'ACCR', ztot_cc_accr (:, :, :) * zrhodjontstep(:, :, :) )
+ !call BUDGET_STORE_ADD_PHY(D, TBUDGETS(idx), 'REVA', 0. )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(idx), 'HONC', ztot_cc_honc (:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(idx), 'IMLT', ztot_cc_imlt (:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(idx), 'RIM', ztot_cc_rim (:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(idx), 'WETG', ztot_cc_wetg (:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(idx), 'DRYG', ztot_cc_dryg (:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(idx), 'CVRC', -ztot_cr_cvrc (:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(idx), 'CORR2', ztot_cc_corr2(:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(idx), 'WETH', ztot_cc_weth (:, :, :) * zrhodjontstep(:, :, :) )
end if
!
! Rain drops
!
if (nmom_r.ge.2) then
idx = NBUDGET_SV1 - 1 + nsv_lima_nr
- call Budget_store_add( tbudgets(idx), 'AUTO', ztot_cr_auto(:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(idx), 'SCBU', ztot_cr_scbu(:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(idx), 'REVA', ztot_cr_evap(:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(idx), 'BRKU', ztot_cr_brku(:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(idx), 'HONR', ztot_cr_honr(:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(idx), 'ACC', ztot_cr_acc (:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(idx), 'CFRZ', ztot_cr_cfrz(:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(idx), 'WETG', ztot_cr_wetg(:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(idx), 'DRYG', ztot_cr_dryg(:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(idx), 'GMLT', ztot_cr_gmlt(:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(idx), 'CVRC', ztot_cr_cvrc(:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(idx), 'CORR2', ztot_cr_corr2(:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(idx), 'WETH', ztot_cr_weth(:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(idx), 'HMLT', ztot_cr_hmlt(:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(idx), 'AUTO', ztot_cr_auto(:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(idx), 'SCBU', ztot_cr_scbu(:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(idx), 'REVA', ztot_cr_evap(:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(idx), 'BRKU', ztot_cr_brku(:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(idx), 'HONR', ztot_cr_honr(:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(idx), 'ACC', ztot_cr_acc (:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(idx), 'CFRZ', ztot_cr_cfrz(:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(idx), 'WETG', ztot_cr_wetg(:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(idx), 'DRYG', ztot_cr_dryg(:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(idx), 'GMLT', ztot_cr_gmlt(:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(idx), 'CVRC', ztot_cr_cvrc(:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(idx), 'CORR2', ztot_cr_corr2(:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(idx), 'WETH', ztot_cr_weth(:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(idx), 'HMLT', ztot_cr_hmlt(:, :, :) * zrhodjontstep(:, :, :) )
end if
!
! Ice crystals
!
if (nmom_i.ge.2) then
idx = NBUDGET_SV1 - 1 + nsv_lima_ni
- call Budget_store_add( tbudgets(idx), 'HONC', -ztot_cc_honc (:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(idx), 'CNVI', ztot_ci_cnvi (:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(idx), 'CNVS', ztot_ci_cnvs (:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(idx), 'AGGS', ztot_ci_aggs (:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(idx), 'IMLT', -ztot_cc_imlt (:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(idx), 'HMS', ztot_ci_hms (:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(idx), 'CFRZ', ztot_ci_cfrz (:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(idx), 'CIBU', ztot_ci_cibu (:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(idx), 'RDSF', ztot_ci_rdsf (:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(idx), 'WETG', ztot_ci_wetg (:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(idx), 'DRYG', ztot_ci_dryg (:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(idx), 'HMG', ztot_ci_hmg (:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(idx), 'CORR2', ztot_ci_corr2(:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(idx), 'WETH', ztot_ci_weth (:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(idx), 'HONC', -ztot_cc_honc (:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(idx), 'CNVI', ztot_ci_cnvi (:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(idx), 'CNVS', ztot_ci_cnvs (:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(idx), 'AGGS', ztot_ci_aggs (:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(idx), 'IMLT', -ztot_cc_imlt (:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(idx), 'HMS', ztot_ci_hms (:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(idx), 'CFRZ', ztot_ci_cfrz (:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(idx), 'CIBU', ztot_ci_cibu (:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(idx), 'RDSF', ztot_ci_rdsf (:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(idx), 'WETG', ztot_ci_wetg (:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(idx), 'DRYG', ztot_ci_dryg (:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(idx), 'HMG', ztot_ci_hmg (:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(idx), 'CORR2', ztot_ci_corr2(:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(idx), 'WETH', ztot_ci_weth (:, :, :) * zrhodjontstep(:, :, :) )
end if
!
! Snow
!
if (nmom_s.ge.2) then
idx = NBUDGET_SV1 - 1 + nsv_lima_ns
- call Budget_store_add( tbudgets(idx), 'CNVI', -ztot_ci_cnvi(:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(idx), 'CNVS', -ztot_ci_cnvs(:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(idx), 'RIM', ztot_cs_rim(:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(idx), 'ACC', ztot_cs_acc(:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(idx), 'CMEL', ztot_cs_cmel(:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(idx), 'SSC', ztot_cs_ssc(:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(idx), 'WETG', ztot_cs_wetg(:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(idx), 'DRYG', ztot_cs_dryg(:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(idx), 'WETH', ztot_cs_weth(:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(idx), 'CNVI', -ztot_ci_cnvi(:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(idx), 'CNVS', -ztot_ci_cnvs(:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(idx), 'RIM', ztot_cs_rim(:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(idx), 'ACC', ztot_cs_acc(:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(idx), 'CMEL', ztot_cs_cmel(:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(idx), 'SSC', ztot_cs_ssc(:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(idx), 'WETG', ztot_cs_wetg(:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(idx), 'DRYG', ztot_cs_dryg(:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(idx), 'WETH', ztot_cs_weth(:, :, :) * zrhodjontstep(:, :, :) )
end if
!
! Graupel
!
if (nmom_g.ge.2) then
idx = NBUDGET_SV1 - 1 + nsv_lima_ng
- call Budget_store_add( tbudgets(idx), 'RIM', -ztot_cs_rim(:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(idx), 'ACC', -ztot_cs_acc(:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(idx), 'CMEL', -ztot_cs_cmel(:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(idx), 'CFRZ', -ztot_cr_cfrz(:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(idx), 'WETG', ztot_cg_wetg(:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(idx), 'GMLT', ztot_cg_gmlt(:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(idx), 'WETH', ztot_cg_weth(:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(idx), 'COHG', ztot_cg_cohg(:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(idx), 'RIM', -ztot_cs_rim(:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(idx), 'ACC', -ztot_cs_acc(:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(idx), 'CMEL', -ztot_cs_cmel(:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(idx), 'CFRZ', -ztot_cr_cfrz(:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(idx), 'WETG', ztot_cg_wetg(:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(idx), 'GMLT', ztot_cg_gmlt(:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(idx), 'WETH', ztot_cg_weth(:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(idx), 'COHG', ztot_cg_cohg(:, :, :) * zrhodjontstep(:, :, :) )
end if
!
! Hail
!
if (nmom_h.ge.2) then
idx = NBUDGET_SV1 - 1 + nsv_lima_nh
- call Budget_store_add( tbudgets(idx), 'WETG', -ztot_cg_wetg(:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(idx), 'COHG', -ztot_cg_cohg(:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(idx), 'HMLT', ztot_ch_hmlt(:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(idx), 'WETG', -ztot_cg_wetg(:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(idx), 'COHG', -ztot_cg_cohg(:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(idx), 'HMLT', ztot_ch_hmlt(:, :, :) * zrhodjontstep(:, :, :) )
end if
do ii = 1, nmod_ifn
idx = NBUDGET_SV1 - 1 + nsv_lima_ifn_nucl + ii - 1
- call Budget_store_add( tbudgets(idx), 'IMLT', ztot_ifnn_imlt(:, :, :, ii) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(idx), 'IMLT', ztot_ifnn_imlt(:, :, :, ii) * zrhodjontstep(:, :, :) )
end do
end if
diff --git a/src/PHYEX/micro/lima_adjust.f90 b/src/PHYEX/micro/lima_adjust.f90
index 54b749e8be0e1166ef23eda588f09ffb95cc164b..abfe49fb7ebc640c3de1588cc78a245db2e6745a 100644
--- a/src/PHYEX/micro/lima_adjust.f90
+++ b/src/PHYEX/micro/lima_adjust.f90
@@ -168,8 +168,8 @@ use mode_tools, only: Countjv
!
USE MODI_CONDENS
USE MODI_CONDENSATION
-USE MODI_LIMA_FUNCTIONS
-USE MODI_LIMA_CCN_ACTIVATION
+USE MODE_LIMA_FUNCTIONS
+USE MODE_LIMA_CCN_ACTIVATION, ONLY: LIMA_CCN_ACTIVATION
!
IMPLICIT NONE
!
@@ -357,22 +357,22 @@ PCIT(:,:,:) = 0.
PCCS(:,:,:) = 0.
PCIS(:,:,:) = 0.
!
-IF ( LWARM ) PCCT(:,:,:) = PSVT(:,:,:,NSV_LIMA_NC)
-IF ( LCOLD ) PCIT(:,:,:) = PSVT(:,:,:,NSV_LIMA_NI)
+IF ( NMOM_C.GE.2 ) PCCT(:,:,:) = PSVT(:,:,:,NSV_LIMA_NC)
+IF ( NMOM_I.GE.2 ) PCIT(:,:,:) = PSVT(:,:,:,NSV_LIMA_NI)
!
-IF ( LWARM ) PCCS(:,:,:) = PSVS(:,:,:,NSV_LIMA_NC)
-IF ( LCOLD ) PCIS(:,:,:) = PSVS(:,:,:,NSV_LIMA_NI)
+IF ( NMOM_C.GE.2 ) PCCS(:,:,:) = PSVS(:,:,:,NSV_LIMA_NC)
+IF ( NMOM_I.GE.2 ) PCIS(:,:,:) = PSVS(:,:,:,NSV_LIMA_NI)
!
IF ( LSCAV .AND. LAERO_MASS ) PMAS(:,:,:) = PSVS(:,:,:,NSV_LIMA_SCAVMASS)
!
-IF ( LWARM .AND. NMOD_CCN.GE.1 ) THEN
+IF ( NMOM_C.GE.2 .AND. NMOD_CCN.GE.1 ) THEN
ALLOCATE( PNFS(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3),NMOD_CCN) )
ALLOCATE( PNAS(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3),NMOD_CCN) )
PNFS(:,:,:,:) = PSVS(:,:,:,NSV_LIMA_CCN_FREE:NSV_LIMA_CCN_FREE+NMOD_CCN-1)
PNAS(:,:,:,:) = PSVS(:,:,:,NSV_LIMA_CCN_ACTI:NSV_LIMA_CCN_ACTI+NMOD_CCN-1)
END IF
!
-IF ( LCOLD .AND. NMOD_IFN .GE. 1 ) THEN
+IF ( NMOM_I.GE.2 .AND. NMOD_IFN.GE.1 ) THEN
ALLOCATE( PIFS(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3),NMOD_IFN) )
ALLOCATE( PINS(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3),NMOD_IFN) )
PIFS(:,:,:,:) = PSVS(:,:,:,NSV_LIMA_IFN_FREE:NSV_LIMA_IFN_FREE+NMOD_IFN-1)
@@ -390,13 +390,13 @@ if ( nbumod == kmi .and. lbu_enable ) then
if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'CEDS', prcs(:, :, :) * prhodj(:, :, :) )
if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'CEDS', pris(:, :, :) * prhodj(:, :, :) )
if ( lbudget_sv ) then
- if ( lwarm .and. nmom_c.ge.2) &
+ if ( nmom_c.ge.2) &
call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'CEDS', pccs(:, :, :) * prhodj(:, :, :) )
- if ( lcold .and. nmom_i.ge.2) &
+ if ( nmom_i.ge.2) &
call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'CEDS', pcis(:, :, :) * prhodj(:, :, :) )
if ( lscav .and. laero_mass ) &
call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_scavmass), 'CEDS', pmas(:, :, :) * prhodj(:, :, :) )
- if ( lwarm ) then
+ if ( nmom_c.ge.2 ) then
do jl = 1, nmod_ccn
idx = NBUDGET_SV1 - 1 + nsv_lima_ccn_free - 1 + jl
call Budget_store_init( tbudgets(idx), 'CEDS', pnfs(:, :, :, jl) * prhodj(:, :, :) )
@@ -404,7 +404,7 @@ if ( nbumod == kmi .and. lbu_enable ) then
call Budget_store_init( tbudgets(idx), 'CEDS', pnas(:, :, :, jl) * prhodj(:, :, :) )
end do
end if
- if ( lcold ) then
+ if ( nmom_i.ge.2 ) then
do jl = 1, nmod_ifn
idx = NBUDGET_SV1 - 1 + nsv_lima_ifn_free - 1 + jl
call Budget_store_init( tbudgets(idx), 'CEDS', pifs(:, :, :, jl) * prhodj(:, :, :) )
@@ -1096,7 +1096,7 @@ WHERE (PRIS(:,:,:) <= ZRTMIN(4) .OR. PCIS(:,:,:) <= ZCTMIN(4))
PCIS(:,:,:) = 0.0
END WHERE
!
-IF (LCOLD .AND. (NMOD_IFN .GE. 1 .OR. NMOD_IMM .GE. 1)) THEN
+IF (NMOM_I.GE.2 .AND. (NMOD_IFN .GE. 1 .OR. NMOD_IMM .GE. 1)) THEN
ZW1(:,:,:) = 0.
IF (NMOD_IFN .GE. 1) ZW1(:,:,:) = ZW1(:,:,:) + SUM(PINS,DIM=4)
IF (NMOD_IMM .GE. 1) ZW1(:,:,:) = ZW1(:,:,:) + SUM(PNIS,DIM=4)
@@ -1108,7 +1108,7 @@ IF (LCOLD .AND. (NMOD_IFN .GE. 1 .OR. NMOD_IMM .GE. 1)) THEN
ENDWHERE
END IF
!
-IF (LCOLD .AND. NMOD_IFN.GE.1) THEN
+IF (NMOM_I.GE.2 .AND. NMOD_IFN.GE.1) THEN
DO JMOD_IFN = 1, NMOD_IFN
PIFS(:,:,:,JMOD_IFN) = PIFS(:,:,:,JMOD_IFN) + &
ZMASK(:,:,:) * PINS(:,:,:,JMOD_IFN) * ZW2(:,:,:)
@@ -1118,7 +1118,7 @@ IF (LCOLD .AND. NMOD_IFN.GE.1) THEN
ENDDO
END IF
!
-IF (LCOLD .AND. NMOD_IMM.GE.1) THEN
+IF (NMOM_I.GE.2 .AND. NMOD_IMM.GE.1) THEN
JMOD_IMM = 0
DO JMOD = 1, NMOD_CCN
IF (NIMM(JMOD) == 1) THEN
@@ -1145,7 +1145,7 @@ WHERE (PRCS(:,:,:) <= ZRTMIN(2) .OR. PCCS(:,:,:) <= ZCTMIN(2))
END WHERE
!
ZW1(:,:,:) = 0.
-IF (LWARM .AND. NMOD_CCN.GE.1) ZW1(:,:,:) = SUM(PNAS,DIM=4)
+IF (NMOM_C.GE.2 .AND. NMOD_CCN.GE.1) ZW1(:,:,:) = SUM(PNAS,DIM=4)
ZW (:,:,:) = MIN( ZW(:,:,:), ZW1(:,:,:) )
ZW2(:,:,:) = 0.
WHERE ( ZW(:,:,:) > 0. )
@@ -1153,7 +1153,7 @@ WHERE ( ZW(:,:,:) > 0. )
ZW2(:,:,:) = ZW(:,:,:) / ZW1(:,:,:)
ENDWHERE
!
-IF (LWARM .AND. NMOD_CCN.GE.1) THEN
+IF (NMOM_C.GE.2 .AND. NMOD_CCN.GE.1) THEN
DO JMOD = 1, NMOD_CCN
PNFS(:,:,:,JMOD) = PNFS(:,:,:,JMOD) + &
ZMASK(:,:,:) * PNAS(:,:,:,JMOD) * ZW2(:,:,:)
@@ -1230,22 +1230,22 @@ IF ( KRR .GE. 6 ) PRS(:,:,:,6) = PRGS(:,:,:)
!
! Prepare 3D number concentrations
!
-IF ( LWARM ) PSVS(:,:,:,NSV_LIMA_NC) = PCCS(:,:,:)
-IF ( LCOLD ) PSVS(:,:,:,NSV_LIMA_NI) = PCIS(:,:,:)
+IF ( NMOM_C.GE.2 ) PSVS(:,:,:,NSV_LIMA_NC) = PCCS(:,:,:)
+IF ( NMOM_I.GE.2 ) PSVS(:,:,:,NSV_LIMA_NI) = PCIS(:,:,:)
!
IF ( LSCAV .AND. LAERO_MASS ) PSVS(:,:,:,NSV_LIMA_SCAVMASS) = PMAS(:,:,:)
!
-IF ( LWARM .AND. NMOD_CCN .GE. 1 ) THEN
+IF ( NMOM_C.GE.2 .AND. NMOD_CCN.GE.1 ) THEN
PSVS(:,:,:,NSV_LIMA_CCN_FREE:NSV_LIMA_CCN_FREE+NMOD_CCN-1) = PNFS(:,:,:,:)
PSVS(:,:,:,NSV_LIMA_CCN_ACTI:NSV_LIMA_CCN_ACTI+NMOD_CCN-1) = PNAS(:,:,:,:)
END IF
!
-IF ( LCOLD .AND. NMOD_IFN .GE. 1 ) THEN
+IF ( NMOM_I.GE.2 .AND. NMOD_IFN.GE.1 ) THEN
PSVS(:,:,:,NSV_LIMA_IFN_FREE:NSV_LIMA_IFN_FREE+NMOD_IFN-1) = PIFS(:,:,:,:)
PSVS(:,:,:,NSV_LIMA_IFN_NUCL:NSV_LIMA_IFN_NUCL+NMOD_IFN-1) = PINS(:,:,:,:)
END IF
!
-IF ( LCOLD .AND. NMOD_IMM .GE. 1 ) THEN
+IF ( NMOM_I.GE.2 .AND. NMOD_IMM.GE.1 ) THEN
PSVS(:,:,:,NSV_LIMA_IMM_NUCL:NSV_LIMA_IMM_NUCL+NMOD_IMM-1) = PNIS(:,:,:,:)
END IF
!
@@ -1281,13 +1281,13 @@ if ( nbumod == kmi .and. lbu_enable ) then
if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'CEDS', prcs(:, :, :) * prhodj(:, :, :) )
if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'CEDS', pris(:, :, :) * prhodj(:, :, :) )
if ( lbudget_sv ) then
- if ( lwarm .and. nmom_c.ge.2) &
+ if ( nmom_c.ge.2) &
call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'CEDS', pccs(:, :, :) * prhodj(:, :, :) )
- if ( lcold .and. nmom_i.ge.2) &
+ if ( nmom_i.ge.2) &
call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'CEDS', pcis(:, :, :) * prhodj(:, :, :) )
if ( lscav .and. laero_mass ) &
call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_scavmass), 'CEDS', pmas(:, :, :) * prhodj(:, :, :) )
- if ( lwarm ) then
+ if ( nmom_c.ge.2 ) then
do jl = 1, nmod_ccn
idx = NBUDGET_SV1 - 1 + nsv_lima_ccn_free - 1 + jl
call Budget_store_end( tbudgets(idx), 'CEDS', pnfs(:, :, :, jl) * prhodj(:, :, :) )
@@ -1295,7 +1295,7 @@ if ( nbumod == kmi .and. lbu_enable ) then
call Budget_store_end( tbudgets(idx), 'CEDS', pnas(:, :, :, jl) * prhodj(:, :, :) )
end do
end if
- if ( lcold ) then
+ if ( nmom_i.ge.2 ) then
do jl = 1, nmod_ifn
idx = NBUDGET_SV1 - 1 + nsv_lima_ifn_free - 1 + jl
call Budget_store_end( tbudgets(idx), 'CEDS', pifs(:, :, :, jl) * prhodj(:, :, :) )
diff --git a/src/PHYEX/micro/lima_adjust_split.f90 b/src/PHYEX/micro/lima_adjust_split.f90
index d0b3425d8f83bec8cf9010ace6fe2dfab4e71acd..e5d164e8b825675385fa1f301ef88dd305706440 100644
--- a/src/PHYEX/micro/lima_adjust_split.f90
+++ b/src/PHYEX/micro/lima_adjust_split.f90
@@ -3,76 +3,9 @@
!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_ADJUST_SPLIT
-! #############################
-!
-INTERFACE
-!
- SUBROUTINE LIMA_ADJUST_SPLIT(D, KRR, KMI, TPFILE, HCONDENS, HLAMBDA3, &
- OSUBG_COND, OSIGMAS, PTSTEP, PSIGQSAT, &
- PRHODREF, PRHODJ, PEXNREF, PSIGS, PMFCONV, &
- PPABST, PPABSTT, PZZ, PDTHRAD, PW_NU, &
- PRT, PRS, PSVT, PSVS, &
- PTHS, PSRCS, PCLDFR, PICEFR, PRC_MF, PRI_MF, PCF_MF)
-!
-USE MODD_IO, ONLY: TFILEDATA
-USE MODD_NSV, only: NSV_LIMA_BEG
-USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
-!
-TYPE(DIMPHYEX_t), INTENT(IN) :: D
-INTEGER, INTENT(IN) :: KRR ! Number of moist variables
-INTEGER, INTENT(IN) :: KMI ! Model index
-TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
-CHARACTER(len=80), INTENT(IN) :: HCONDENS
-CHARACTER(len=4), INTENT(IN) :: HLAMBDA3 ! formulation for lambda3 coeff
-LOGICAL, INTENT(IN) :: OSUBG_COND ! Switch for Subgrid
- ! Condensation
-LOGICAL, INTENT(IN) :: OSIGMAS ! Switch for Sigma_s:
- ! use values computed in CONDENSATION
- ! or that from turbulence scheme
-REAL, INTENT(IN) :: PTSTEP ! Time step
-REAL, INTENT(IN) :: PSIGQSAT ! coeff applied to qsat variance contribution
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Dry density of the
- ! reference state
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSIGS ! Sigma_s at time t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PMFCONV !
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! Absolute Pressure at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABSTT ! Absolute Pressure at t+dt
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ !
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDTHRAD ! Radiative temperature tendency
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PW_NU ! updraft velocity used for
-!
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT ! m.r. at t
-!
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRS ! m.r. source
-!
-REAL, DIMENSION(:,:,:,NSV_LIMA_BEG:), INTENT(IN) :: PSVT ! Concentrations at time t
-!
-REAL, DIMENSION(:,:,:,NSV_LIMA_BEG:), INTENT(INOUT) :: PSVS ! Concentration sources
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source
-!
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSRCS ! Second-order flux
- ! s'rc'/2Sigma_s2 at time t+1
- ! multiplied by Lambda_3
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCLDFR ! Cloud fraction
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PICEFR ! Cloud fraction
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRC_MF! Convective Mass Flux liquid mixing ratio
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRI_MF! Convective Mass Flux ice mixing ratio
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PCF_MF! Convective Mass Flux Cloud fraction
-!
-END SUBROUTINE LIMA_ADJUST_SPLIT
-!
-END INTERFACE
-!
-END MODULE MODI_LIMA_ADJUST_SPLIT
-!
! ###########################################################################
- SUBROUTINE LIMA_ADJUST_SPLIT(D, KRR, KMI, TPFILE, HCONDENS, HLAMBDA3, &
+SUBROUTINE LIMA_ADJUST_SPLIT(D, CST, BUCONF, TBUDGETS, KBUDGETS, &
+ KRR, KMI, HCONDENS, HLAMBDA3, &
OSUBG_COND, OSIGMAS, PTSTEP, PSIGQSAT, &
PRHODREF, PRHODJ, PEXNREF, PSIGS, PMFCONV, &
PPABST, PPABSTT, PZZ, PDTHRAD, PW_NU, &
@@ -152,15 +85,13 @@ END MODULE MODI_LIMA_ADJUST_SPLIT
!* 0. DECLARATIONS
! ------------
!
-use modd_budget, only: lbu_enable, nbumod, &
- lbudget_th, lbudget_rv, lbudget_rc, lbudget_ri, lbudget_sv, &
- NBUDGET_TH, NBUDGET_RV, NBUDGET_RC, NBUDGET_RI, NBUDGET_SV1, &
- tbudgets
+USE MODD_BUDGET, ONLY: TBUDGETDATA, TBUDGETCONF_t, NBUDGET_TH, NBUDGET_RV, &
+ NBUDGET_RC, NBUDGET_RI, NBUDGET_RV, NBUDGET_SV1, NBUMOD
+USE MODD_CST, ONLY: CST_t
USE MODD_CONF
-USE MODD_CST
-use modd_field, only: TFIELDMETADATA, TYPEREAL
-USE MODD_IO, ONLY: TFILEDATA
-USE MODD_LUNIT_n, ONLY: TLUOUT
+!use modd_field, only: TFIELDDATA, TYPEREAL
+!USE MODD_IO, ONLY: TFILEDATA
+!USE MODD_LUNIT_n, ONLY: TLUOUT
USE MODD_NSV
USE MODD_PARAMETERS
USE MODD_PARAM_LIMA
@@ -172,15 +103,13 @@ USE MODD_NEB, ONLY: NEB
USE MODD_TURB_n, ONLY: TURBN
USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
!
-use mode_budget, only: Budget_store_init, Budget_store_end
-USE MODE_IO_FIELD_WRITE, only: IO_Field_write
+USE MODE_BUDGET_PHY, ONLY: BUDGET_STORE_INIT_PHY, BUDGET_STORE_END_PHY
+!USE MODE_IO_FIELD_WRITE, only: IO_Field_write
use mode_msg
use mode_tools, only: Countjv
!
-USE MODI_CONDENS
USE MODI_CONDENSATION
-USE MODI_LIMA_FUNCTIONS
-USE MODI_LIMA_CCN_ACTIVATION
+USE MODE_LIMA_CCN_ACTIVATION, ONLY: LIMA_CCN_ACTIVATION
!
IMPLICIT NONE
!
@@ -188,9 +117,13 @@ IMPLICIT NONE
!
!
TYPE(DIMPHYEX_t), INTENT(IN) :: D
+TYPE(CST_t), INTENT(IN) :: CST
+TYPE(TBUDGETCONF_t), INTENT(IN) :: BUCONF
+TYPE(TBUDGETDATA), DIMENSION(KBUDGETS), INTENT(INOUT) :: TBUDGETS
+INTEGER, INTENT(IN) :: KBUDGETS
+!
INTEGER, INTENT(IN) :: KRR ! Number of moist variables
INTEGER, INTENT(IN) :: KMI ! Model index
-TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
CHARACTER(len=80), INTENT(IN) :: HCONDENS
CHARACTER(len=4), INTENT(IN) :: HLAMBDA3 ! formulation for lambda3 coeff
LOGICAL, INTENT(IN) :: OSUBG_COND ! Switch for Subgrid
@@ -217,9 +150,9 @@ REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT ! m.r. at t
!
REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRS ! m.r. source
!
-REAL, DIMENSION(:,:,:,NSV_LIMA_BEG:), INTENT(IN) :: PSVT ! Concentrations at time t
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVT ! Concentrations at time t
!
-REAL, DIMENSION(:,:,:,NSV_LIMA_BEG:), INTENT(INOUT) :: PSVS ! Concentration sources
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVS ! Concentration sources
!
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source
!
@@ -244,6 +177,7 @@ REAL, DIMENSION(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3)) &
PRIT, & ! Cloud ice m.r. at t
PRST, & ! Aggregate m.r. at t
PRGT, & ! Graupel m.r. at t
+ PRHT, & ! Hail m.r. at t
!
PRVS, & ! Water vapor m.r. source
PRCS, & ! Cloud water m.r. source
@@ -251,6 +185,7 @@ REAL, DIMENSION(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3)) &
PRIS, & ! Cloud ice m.r. source
PRSS, & ! Aggregate m.r. source
PRGS, & ! Graupel m.r. source
+ PRHS, & ! Hail m.r. source
!
PCCT, & ! Cloud water conc. at t
PCIT, & ! Cloud ice conc. at t
@@ -287,19 +222,19 @@ REAL, DIMENSION(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3)) &
ZRI, ZRI_IN, &
Z_SIGS, Z_SRCS, &
ZW_MF, &
- ZCND, ZS, ZVEC1,ZDUM
+ ZCND, ZS, ZVEC1, ZDUM
REAL, DIMENSION(SIZE(PRHODJ,1),SIZE(PRHODJ,2)) :: ZSIGQSAT2D
!
INTEGER, DIMENSION(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3)) :: IVEC1
!
-INTEGER :: IRESP ! Return code of FM routines
+!INTEGER :: IRESP ! Return code of FM routines
INTEGER :: IIU,IJU,IKU! dimensions of dummy arrays
INTEGER :: IKB ! K index value of the first inner mass point
INTEGER :: IKE ! K index value of the last inner mass point
INTEGER :: IIB,IJB ! Horz index values of the first inner mass points
INTEGER :: IIE,IJE ! Horz index values of the last inner mass points
INTEGER :: JITER,ITERMAX ! iterative loop for first order adjustment
-INTEGER :: ILUOUT ! Logical unit of output listing
+!INTEGER :: ILUOUT ! Logical unit of output listing
!
INTEGER :: ISIZE
LOGICAL :: G_SIGMAS, GUSERI
@@ -310,26 +245,34 @@ integer :: idx
integer :: JI, JJ, JK, jl
INTEGER :: JMOD, JMOD_IFN, JMOD_IMM
!
-TYPE(TFIELDMETADATA) :: TZFIELD
+!!$TYPE(TFIELDMETADATA) :: TZFIELD
+!
+INTEGER :: ISV_LIMA_NC
+INTEGER :: ISV_LIMA_CCN_FREE
+INTEGER :: ISV_LIMA_CCN_ACTI
+INTEGER :: ISV_LIMA_SCAVMASS
+INTEGER :: ISV_LIMA_NI
+INTEGER :: ISV_LIMA_IFN_FREE
+INTEGER :: ISV_LIMA_IFN_NUCL
+INTEGER :: ISV_LIMA_IMM_NUCL
!
!-------------------------------------------------------------------------------
!
!* 1. PRELIMINARIES
! -------------
!
-ILUOUT = TLUOUT%NLU
+ISV_LIMA_NC = NSV_LIMA_NC - NSV_LIMA_BEG + 1
+ISV_LIMA_CCN_FREE = NSV_LIMA_CCN_FREE - NSV_LIMA_BEG + 1
+ISV_LIMA_CCN_ACTI = NSV_LIMA_CCN_ACTI - NSV_LIMA_BEG + 1
+ISV_LIMA_SCAVMASS = NSV_LIMA_SCAVMASS - NSV_LIMA_BEG + 1
+ISV_LIMA_NI = NSV_LIMA_NI - NSV_LIMA_BEG + 1
+ISV_LIMA_IFN_FREE = NSV_LIMA_IFN_FREE - NSV_LIMA_BEG + 1
+ISV_LIMA_IFN_NUCL = NSV_LIMA_IFN_NUCL - NSV_LIMA_BEG + 1
+ISV_LIMA_IMM_NUCL = NSV_LIMA_IMM_NUCL - NSV_LIMA_BEG + 1
!
-IIU = SIZE(PEXNREF,1)
-IJU = SIZE(PEXNREF,2)
-IKU = SIZE(PEXNREF,3)
-IIB = 1 + JPHEXT
-IIE = SIZE(PRHODJ,1) - JPHEXT
-IJB = 1 + JPHEXT
-IJE = SIZE(PRHODJ,2) - JPHEXT
-IKB = 1 + JPVEXT
-IKE = SIZE(PRHODJ,3) - JPVEXT
+!ILUOUT = TLUOUT%NLU
!
-ZEPS= XMV / XMD
+ZEPS= CST%XMV / CST%XMD
!
IF (OSUBG_COND) THEN
ITERMAX=1
@@ -363,6 +306,8 @@ PRST(:,:,:) = 0.
PRSS(:,:,:) = 0.
PRGT(:,:,:) = 0.
PRGS(:,:,:) = 0.
+PRHT(:,:,:) = 0.
+PRHS(:,:,:) = 0.
!
IF ( KRR .GE. 2 ) PRCT(:,:,:) = PRS(:,:,:,2)*PTSTEP
IF ( KRR .GE. 2 ) PRCS(:,:,:) = PRS(:,:,:,2)
@@ -374,6 +319,8 @@ IF ( KRR .GE. 5 ) PRST(:,:,:) = PRT(:,:,:,5)
IF ( KRR .GE. 5 ) PRSS(:,:,:) = PRS(:,:,:,5)
IF ( KRR .GE. 6 ) PRGT(:,:,:) = PRT(:,:,:,6)
IF ( KRR .GE. 6 ) PRGS(:,:,:) = PRS(:,:,:,6)
+IF ( KRR .GE. 7 ) PRHT(:,:,:) = PRT(:,:,:,7)
+IF ( KRR .GE. 7 ) PRHS(:,:,:) = PRS(:,:,:,7)
!
! Prepare 3D number concentrations
PCCT(:,:,:) = 0.
@@ -381,68 +328,68 @@ PCIT(:,:,:) = 0.
PCCS(:,:,:) = 0.
! PCIS(:,:,:) = 0.
!
-IF ( LWARM .AND. NMOM_C.GE.2 ) PCCT(:,:,:) = PSVS(:,:,:,NSV_LIMA_NC)*PTSTEP
-IF ( LCOLD .AND. NMOM_I.GE.2 ) PCIT(:,:,:) = PSVT(:,:,:,NSV_LIMA_NI)
+IF ( NMOM_C.GE.2 ) PCCT(:,:,:) = PSVS(:,:,:,ISV_LIMA_NC)*PTSTEP
+IF ( NMOM_I.GE.2 ) PCIT(:,:,:) = PSVT(:,:,:,ISV_LIMA_NI)
!
-IF ( LWARM .AND. NMOM_C.GE.2 ) PCCS(:,:,:) = PSVS(:,:,:,NSV_LIMA_NC)
-! IF ( LCOLD .AND. NMOM_I.GE.2 ) PCIS(:,:,:) = PSVS(:,:,:,NSV_LIMA_NI)
+IF ( NMOM_C.GE.2 ) PCCS(:,:,:) = PSVS(:,:,:,ISV_LIMA_NC)
+! IF ( NMOM_I.GE.2 ) PCIS(:,:,:) = PSVS(:,:,:,ISV_LIMA_NI)
!
-IF ( LSCAV .AND. LAERO_MASS ) PMAS(:,:,:) = PSVS(:,:,:,NSV_LIMA_SCAVMASS)
+IF ( LSCAV .AND. LAERO_MASS ) PMAS(:,:,:) = PSVS(:,:,:,ISV_LIMA_SCAVMASS)
!
-IF ( LWARM .AND. NMOD_CCN.GE.1 ) THEN
+IF ( NMOM_C.GE.1 .AND. NMOD_CCN.GE.1 ) THEN
ALLOCATE( PNFS(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3),NMOD_CCN) )
ALLOCATE( PNAS(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3),NMOD_CCN) )
ALLOCATE( PNFT(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3),NMOD_CCN) )
ALLOCATE( PNAT(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3),NMOD_CCN) )
- PNFS(:,:,:,:) = PSVS(:,:,:,NSV_LIMA_CCN_FREE:NSV_LIMA_CCN_FREE+NMOD_CCN-1)
- PNAS(:,:,:,:) = PSVS(:,:,:,NSV_LIMA_CCN_ACTI:NSV_LIMA_CCN_ACTI+NMOD_CCN-1)
- PNFT(:,:,:,:) = PSVS(:,:,:,NSV_LIMA_CCN_FREE:NSV_LIMA_CCN_FREE+NMOD_CCN-1)*PTSTEP
- PNAT(:,:,:,:) = PSVS(:,:,:,NSV_LIMA_CCN_ACTI:NSV_LIMA_CCN_ACTI+NMOD_CCN-1)*PTSTEP
+ PNFS(:,:,:,:) = PSVS(:,:,:,ISV_LIMA_CCN_FREE:ISV_LIMA_CCN_FREE+NMOD_CCN-1)
+ PNAS(:,:,:,:) = PSVS(:,:,:,ISV_LIMA_CCN_ACTI:ISV_LIMA_CCN_ACTI+NMOD_CCN-1)
+ PNFT(:,:,:,:) = PSVS(:,:,:,ISV_LIMA_CCN_FREE:ISV_LIMA_CCN_FREE+NMOD_CCN-1)*PTSTEP
+ PNAT(:,:,:,:) = PSVS(:,:,:,ISV_LIMA_CCN_ACTI:ISV_LIMA_CCN_ACTI+NMOD_CCN-1)*PTSTEP
END IF
!
-! IF ( LCOLD .AND. NMOD_IFN .GE. 1 ) THEN
+! IF ( NMOM_I.GE.1 .AND. NMOD_IFN .GE. 1 ) THEN
! ALLOCATE( PIFS(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3),NMOD_IFN) )
! ALLOCATE( PINS(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3),NMOD_IFN) )
-! PIFS(:,:,:,:) = PSVS(:,:,:,NSV_LIMA_IFN_FREE:NSV_LIMA_IFN_FREE+NMOD_IFN-1)
-! PINS(:,:,:,:) = PSVS(:,:,:,NSV_LIMA_IFN_NUCL:NSV_LIMA_IFN_NUCL+NMOD_IFN-1)
+! PIFS(:,:,:,:) = PSVS(:,:,:,ISV_LIMA_IFN_FREE:ISV_LIMA_IFN_FREE+NMOD_IFN-1)
+! PINS(:,:,:,:) = PSVS(:,:,:,ISV_LIMA_IFN_NUCL:ISV_LIMA_IFN_NUCL+NMOD_IFN-1)
! END IF
!
! IF ( NMOD_IMM .GE. 1 ) THEN
! ALLOCATE( PNIS(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3),NMOD_IMM) )
-! PNIS(:,:,:,:) = PSVS(:,:,:,NSV_LIMA_IMM_NUCL:NSV_LIMA_IMM_NUCL+NMOD_IMM-1)
+! PNIS(:,:,:,:) = PSVS(:,:,:,ISV_LIMA_IMM_NUCL:ISV_LIMA_IMM_NUCL+NMOD_IMM-1)
! END IF
!
!
-if ( nbumod == kmi .and. lbu_enable ) then
- if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'CEDS', pths(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rv ) call Budget_store_init( tbudgets(NBUDGET_RV), 'CEDS', prvs(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'CEDS', prcs(:, :, :) * prhodj(:, :, :) )
+if ( nbumod == kmi .and. BUCONF%lbu_enable ) then
+ if ( BUCONF%lbudget_th ) call BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_TH), 'CEDS', pths(:, :, :) * prhodj(:, :, :) )
+ if ( BUCONF%lbudget_rv ) call BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RV), 'CEDS', prvs(:, :, :) * prhodj(:, :, :) )
+ if ( BUCONF%lbudget_rc ) call BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RC), 'CEDS', prcs(:, :, :) * prhodj(:, :, :) )
!Remark: PRIS is not modified but source term kept for better coherence with lima_adjust and lima_notadjust
- if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'CEDS', pris(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_sv ) then
- if ( lwarm .and. nmom_c.ge.2) &
- call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'CEDS', pccs(:, :, :) * prhodj(:, :, :) )
+ if ( BUCONF%lbudget_ri ) call BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RI), 'CEDS', pris(:, :, :) * prhodj(:, :, :) )
+ if ( BUCONF%lbudget_sv ) then
+ if ( nmom_c.ge.2) &
+ call BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + nsv_lima_nc), 'CEDS', pccs(:, :, :) * prhodj(:, :, :) )
if ( lscav .and. laero_mass ) &
- call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_scavmass), 'CEDS', pmas(:, :, :) * prhodj(:, :, :) )
- if ( lwarm ) then
+ call BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + nsv_lima_scavmass), 'CEDS', pmas(:, :, :) * prhodj(:, :, :) )
+ if ( nmom_c.ge.1 ) then
do jl = 1, nmod_ccn
idx = NBUDGET_SV1 - 1 + nsv_lima_ccn_free - 1 + jl
- call Budget_store_init( tbudgets(idx), 'CEDS', pnfs(:, :, :, jl) * prhodj(:, :, :) )
+ call BUDGET_STORE_INIT_PHY(D, TBUDGETS(idx), 'CEDS', pnfs(:, :, :, jl) * prhodj(:, :, :) )
idx = NBUDGET_SV1 - 1 + nsv_lima_ccn_acti - 1 + jl
- call Budget_store_init( tbudgets(idx), 'CEDS', pnas(:, :, :, jl) * prhodj(:, :, :) )
+ call BUDGET_STORE_INIT_PHY(D, TBUDGETS(idx), 'CEDS', pnas(:, :, :, jl) * prhodj(:, :, :) )
end do
end if
-! if ( lcold ) then
-! call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'CEDS', pcis(:, :, :) * prhodj(:, :, :) )
+! if ( nmom_i.ge.2 ) then
+! call BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + nsv_lima_ni), 'CEDS', pcis(:, :, :) * prhodj(:, :, :) )
! do jl = 1, nmod_ifn
! idx = NBUDGET_SV1 - 1 + nsv_lima_ifn_free - 1 + jl
-! call Budget_store_init( tbudgets(idx), 'CEDS', pifs(:, :, :, jl) * prhodj(:, :, :) )
+! call BUDGET_STORE_INIT_PHY(D, TBUDGETS(idx), 'CEDS', pifs(:, :, :, jl) * prhodj(:, :, :) )
! idx = NBUDGET_SV1 - 1 + nsv_lima_ifn_nucl - 1 + jl
-! call Budget_store_init( tbudgets(idx), 'CEDS', pins(:, :, :, jl) * prhodj(:, :, :) )
+! call BUDGET_STORE_INIT_PHY(D, TBUDGETS(idx), 'CEDS', pins(:, :, :, jl) * prhodj(:, :, :) )
! end do
! do jl = 1, nmod_imm
! idx = NBUDGET_SV1 - 1 + nsv_lima_imm_nucl - 1 + jl
-! call Budget_store_init( tbudgets(idx), 'CEDS', pnis(:, :, :, jl) * prhodj(:, :, :) )
+! call BUDGET_STORE_INIT_PHY(D, TBUDGETS(idx), 'CEDS', pnis(:, :, :, jl) * prhodj(:, :, :) )
! end do
! end if
end if
@@ -457,11 +404,11 @@ end if
!* 2.1 remove negative non-precipitating negative water
! ------------------------------------------------
!
-IF (ANY(PRVS(:,:,:)+PRCS(:,:,:)+PRIS(:,:,:) < 0.) .AND. NVERB>5) THEN
- WRITE(ILUOUT,*) 'LIMA_ADJUST: negative values of total water (reset to zero)'
- WRITE(ILUOUT,*) ' location of minimum PRVS+PRCS+PRIS:',MINLOC(PRVS+PRCS+PRIS)
- WRITE(ILUOUT,*) ' value of minimum PRVS+PRCS+PRIS:',MINVAL(PRVS+PRCS+PRIS)
-END IF
+!IF (ANY(PRVS(:,:,:)+PRCS(:,:,:)+PRIS(:,:,:) < 0.) .AND. NVERB>5) THEN
+! WRITE(ILUOUT,*) 'LIMA_ADJUST: negative values of total water (reset to zero)'
+! WRITE(ILUOUT,*) ' location of minimum PRVS+PRCS+PRIS:',MINLOC(PRVS+PRCS+PRIS)
+! WRITE(ILUOUT,*) ' value of minimum PRVS+PRCS+PRIS:',MINVAL(PRVS+PRCS+PRIS)
+!END IF
!
WHERE ( PRVS(:,:,:)+PRCS(:,:,:)+PRIS(:,:,:) < 0.)
PRVS(:,:,:) = - PRCS(:,:,:) - PRIS(:,:,:)
@@ -469,7 +416,7 @@ END WHERE
!
!* 2.2 estimate the Exner function at t+1
!
-ZEXNS(:,:,:) = ( PPABSTT(:,:,:) / XP00 ) ** (XRD/XCPD)
+ZEXNS(:,:,:) = ( PPABSTT(:,:,:) / CST%XP00 ) ** (CST%XRD/CST%XCPD)
!
! beginning of the iterative loop
!
@@ -482,15 +429,15 @@ DO JITER =1,ITERMAX
!
!* 2.4 compute the specific heat for moist air (Cph) at t+1
!
- ZCPH(:,:,:) = XCPD + XCPV *ZDT* PRVS(:,:,:) &
- + XCL *ZDT* ( PRCS(:,:,:) + PRRS(:,:,:) ) &
- + XCI *ZDT* ( PRIS(:,:,:) + PRSS(:,:,:) + PRGS(:,:,:) )
+ ZCPH(:,:,:) = CST%XCPD + CST%XCPV *ZDT* PRVS(:,:,:) &
+ + CST%XCL *ZDT* ( PRCS(:,:,:) + PRRS(:,:,:) ) &
+ + CST%XCI *ZDT* ( PRIS(:,:,:) + PRSS(:,:,:) + PRGS(:,:,:) + PRHS(:,:,:) )
!
!* 2.5 compute the latent heat of vaporization Lv(T*) at t+1
! and of sublimation Ls(T*) at t+1
!
- ZLV(:,:,:) = XLVTT + ( XCPV - XCL ) * ( ZT(:,:,:) -XTT )
- ZLS(:,:,:) = XLSTT + ( XCPV - XCI ) * ( ZT(:,:,:) -XTT )
+ ZLV(:,:,:) = CST%XLVTT + ( CST%XCPV - CST%XCL ) * ( ZT(:,:,:) -CST%XTT )
+ ZLS(:,:,:) = CST%XLSTT + ( CST%XCPV - CST%XCI ) * ( ZT(:,:,:) -CST%XTT )
!
!
!-------------------------------------------------------------------------------
@@ -498,12 +445,10 @@ DO JITER =1,ITERMAX
!* 3. FIRST ORDER SUBGRID CONDENSATION SCHEME
! ---------------------------------------
!
- ZRV=PRVS*PTSTEP
- ZRC=PRCS*PTSTEP
+ ZRV_IN=PRVS*PTSTEP
ZRV2=PRVT
+ ZRC_IN=PRCS*PTSTEP
ZRC2=PRCT
- ZRV_IN=ZRV
- ZRC_IN=ZRC
IF (NMOM_I.EQ.1) THEN
ZRI_IN=PRIS*PTSTEP
GUSERI=.TRUE.
@@ -533,7 +478,7 @@ DO JITER =1,ITERMAX
IF (OSUBG_COND .AND. NMOM_C.GE.2 .AND. LACTI) THEN
PSRCS=Z_SRCS
ZW_MF=0.
- CALL LIMA_CCN_ACTIVATION (TPFILE, &
+ CALL LIMA_CCN_ACTIVATION (CST, &
PRHODREF, PEXNREF, PPABST, ZT2, PDTHRAD, PW_NU+ZW_MF, &
PTHT, ZRV2, ZRC2, PCCT, PRRT, PNFT, PNAT, &
PCLDFR )
@@ -564,7 +509,7 @@ ELSE
ZVEC1(JI,JJ,JK) = MAX( 1.0001, MIN( FLOAT(NAHEN)-0.0001, XAHENINTP1 * ZT(JI,JJ,JK) + XAHENINTP2 ) )
IVEC1(JI,JJ,JK) = INT( ZVEC1(JI,JJ,JK) )
ZVEC1(JI,JJ,JK) = ZVEC1(JI,JJ,JK) - FLOAT( IVEC1(JI,JJ,JK) )
- ZW(JI,JJ,JK)=EXP( XALPW - XBETAW/ZT(JI,JJ,JK) - XGAMW*ALOG(ZT(JI,JJ,JK) ) ) ! es_w
+ ZW(JI,JJ,JK)=EXP( CST%XALPW - CST%XBETAW/ZT(JI,JJ,JK) - CST%XGAMW*ALOG(ZT(JI,JJ,JK) ) ) ! es_w
ZW(JI,JJ,JK)=ZEPS*ZW(JI,JJ,JK) / ( PPABST(JI,JJ,JK)-ZW(JI,JJ,JK) )
ZS(JI,JJ,JK) = PRVS(JI,JJ,JK)*PTSTEP / ZW(JI,JJ,JK) - 1.
ZW(JI,JJ,JK) = PCCS(JI,JJ,JK)*PTSTEP/(XLBC*PCCS(JI,JJ,JK)/PRCS(JI,JJ,JK))**XLBEXC
@@ -652,7 +597,7 @@ IF (NMOM_C .GE. 2) THEN
END IF
!
ZW1(:,:,:) = 0.
-IF (LWARM .AND. NMOD_CCN.GE.1) ZW1(:,:,:) = SUM(PNAS,DIM=4)
+IF (NMOM_C.GE.1 .AND. NMOD_CCN.GE.1) ZW1(:,:,:) = SUM(PNAS,DIM=4)
ZW (:,:,:) = MIN( ZW(:,:,:), ZW1(:,:,:) )
ZW2(:,:,:) = 0.
WHERE ( ZW(:,:,:) > 0. )
@@ -660,7 +605,7 @@ WHERE ( ZW(:,:,:) > 0. )
ZW2(:,:,:) = ZW(:,:,:) / ZW1(:,:,:)
ENDWHERE
!
-IF (LWARM .AND. NMOD_CCN.GE.1) THEN
+IF (NMOM_C.GE.1 .AND. NMOD_CCN.GE.1) THEN
DO JMOD = 1, NMOD_CCN
PNFS(:,:,:,JMOD) = PNFS(:,:,:,JMOD) + &
ZMASK(:,:,:) * PNAS(:,:,:,JMOD) * ZW2(:,:,:)
@@ -681,20 +626,20 @@ ELSE
WHERE(PICEFR(:,:,:)<1.E-10 .AND. PRIT(:,:,:)>XRTMIN(4) .AND. PCIT(:,:,:)>XCTMIN(4)) PICEFR(:,:,:)=1.
END IF
!
-IF ( tpfile%lopened ) THEN
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'NEB', &
- CSTDNAME = '', &
- CLONGNAME = 'NEB', &
- CUNITS = '1', &
- CDIR = 'XY', &
- CCOMMENT = 'X_Y_Z_NEB', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- LTIMEDEP = .TRUE. )
- CALL IO_Field_write(TPFILE,TZFIELD,PCLDFR)
-END IF
+!!$IF ( tpfile%lopened ) THEN
+!!$ TZFIELD = TFIELDMETADATA( &
+!!$ CMNHNAME = 'NEB', &
+!!$ CSTDNAME = '', &
+!!$ CLONGNAME = 'NEB', &
+!!$ CUNITS = '1', &
+!!$ CDIR = 'XY', &
+!!$ CCOMMENT = 'X_Y_Z_NEB', &
+!!$ NGRID = 1, &
+!!$ NTYPE = TYPEREAL, &
+!!$ NDIMS = 3, &
+!!$ LTIMEDEP = .TRUE. )
+!!$ CALL IO_Field_write(TPFILE,TZFIELD,PCLDFR)
+!!$END IF
!
!
!* 6. SAVE CHANGES IN PRS AND PSVS
@@ -707,83 +652,84 @@ IF ( KRR .GE. 3 ) PRS(:,:,:,3) = PRRS(:,:,:)
IF ( KRR .GE. 4 ) PRS(:,:,:,4) = PRIS(:,:,:)
IF ( KRR .GE. 5 ) PRS(:,:,:,5) = PRSS(:,:,:)
IF ( KRR .GE. 6 ) PRS(:,:,:,6) = PRGS(:,:,:)
+IF ( KRR .GE. 7 ) PRS(:,:,:,7) = PRHS(:,:,:)
!
! Prepare 3D number concentrations
!
-IF ( LWARM .AND. NMOM_C.GE.2 ) PSVS(:,:,:,NSV_LIMA_NC) = PCCS(:,:,:)
-! IF ( LCOLD .AND. NMOM_I.GE.2 ) PSVS(:,:,:,NSV_LIMA_NI) = PCIS(:,:,:)
+IF ( NMOM_C.GE.2 ) PSVS(:,:,:,ISV_LIMA_NC) = PCCS(:,:,:)
+! IF ( NMOM_I.GE.2 ) PSVS(:,:,:,ISV_LIMA_NI) = PCIS(:,:,:)
!
-IF ( LSCAV .AND. LAERO_MASS ) PSVS(:,:,:,NSV_LIMA_SCAVMASS) = PMAS(:,:,:)
+IF ( LSCAV .AND. LAERO_MASS ) PSVS(:,:,:,ISV_LIMA_SCAVMASS) = PMAS(:,:,:)
!
-IF ( LWARM .AND. NMOD_CCN .GE. 1 ) THEN
- PSVS(:,:,:,NSV_LIMA_CCN_FREE:NSV_LIMA_CCN_FREE+NMOD_CCN-1) = PNFS(:,:,:,:)
- PSVS(:,:,:,NSV_LIMA_CCN_ACTI:NSV_LIMA_CCN_ACTI+NMOD_CCN-1) = PNAS(:,:,:,:)
+IF ( NMOM_C.GE.1 .AND. NMOD_CCN.GE.1 ) THEN
+ PSVS(:,:,:,ISV_LIMA_CCN_FREE:ISV_LIMA_CCN_FREE+NMOD_CCN-1) = PNFS(:,:,:,:)
+ PSVS(:,:,:,ISV_LIMA_CCN_ACTI:ISV_LIMA_CCN_ACTI+NMOD_CCN-1) = PNAS(:,:,:,:)
END IF
!
-! IF ( LCOLD .AND. NMOD_IFN .GE. 1 ) THEN
-! PSVS(:,:,:,NSV_LIMA_IFN_FREE:NSV_LIMA_IFN_FREE+NMOD_IFN-1) = PIFS(:,:,:,:)
-! PSVS(:,:,:,NSV_LIMA_IFN_NUCL:NSV_LIMA_IFN_NUCL+NMOD_IFN-1) = PINS(:,:,:,:)
+! IF ( NMOM_I.GE.1 .AND. NMOD_IFN .GE. 1 ) THEN
+! PSVS(:,:,:,ISV_LIMA_IFN_FREE:ISV_LIMA_IFN_FREE+NMOD_IFN-1) = PIFS(:,:,:,:)
+! PSVS(:,:,:,ISV_LIMA_IFN_NUCL:ISV_LIMA_IFN_NUCL+NMOD_IFN-1) = PINS(:,:,:,:)
! END IF
!
-! IF ( LCOLD .AND. NMOD_IMM .GE. 1 ) THEN
-! PSVS(:,:,:,NSV_LIMA_IMM_NUCL:NSV_LIMA_IMM_NUCL+NMOD_IMM-1) = PNIS(:,:,:,:)
+! IF ( NMOM_I.GE.1 .AND. NMOD_IMM .GE. 1 ) THEN
+! PSVS(:,:,:,ISV_LIMA_IMM_NUCL:ISV_LIMA_IMM_NUCL+NMOD_IMM-1) = PNIS(:,:,:,:)
! END IF
!
! write SSI in LFI
!
-IF ( tpfile%lopened ) THEN
- ZT(:,:,:) = ( PTHS(:,:,:) * ZDT ) * ZEXNS(:,:,:)
- ZW(:,:,:) = EXP( XALPI - XBETAI/ZT(:,:,:) - XGAMI*ALOG(ZT(:,:,:) ) )
- ZW1(:,:,:)= PPABSTT(:,:,:)
- ZW(:,:,:) = PRVT(:,:,:)*( ZW1(:,:,:)-ZW(:,:,:) ) / ( (XMV/XMD) * ZW(:,:,:) ) - 1.0
-
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'SSI', &
- CSTDNAME = '', &
- CLONGNAME = 'SSI', &
- CUNITS = '', &
- CDIR = 'XY', &
- CCOMMENT = 'X_Y_Z_SSI', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- LTIMEDEP = .TRUE. )
- CALL IO_Field_write(TPFILE,TZFIELD,ZW)
-END IF
+!!$IF ( tpfile%lopened ) THEN
+!!$ ZT(:,:,:) = ( PTHS(:,:,:) * ZDT ) * ZEXNS(:,:,:)
+!!$ ZW(:,:,:) = EXP( XALPI - XBETAI/ZT(:,:,:) - XGAMI*ALOG(ZT(:,:,:) ) )
+!!$ ZW1(:,:,:)= PPABSTT(:,:,:)
+!!$ ZW(:,:,:) = PRVT(:,:,:)*( ZW1(:,:,:)-ZW(:,:,:) ) / ( (XMV/XMD) * ZW(:,:,:) ) - 1.0
+!!$
+!!$ TZFIELD = TFIELDMETADATA( &
+!!$ CMNHNAME = 'SSI', &
+!!$ CSTDNAME = '', &
+!!$ CLONGNAME = 'SSI', &
+!!$ CUNITS = '', &
+!!$ CDIR = 'XY', &
+!!$ CCOMMENT = 'X_Y_Z_SSI', &
+!!$ NGRID = 1, &
+!!$ NTYPE = TYPEREAL, &
+!!$ NDIMS = 3, &
+!!$ LTIMEDEP = .TRUE. )
+!!$ CALL IO_Field_write(TPFILE,TZFIELD,ZW)
+!!$END IF
!
!
!* 7. STORE THE BUDGET TERMS
! ----------------------
!
-if ( nbumod == kmi .and. lbu_enable ) then
- if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'CEDS', pths(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rv ) call Budget_store_end( tbudgets(NBUDGET_RV), 'CEDS', prvs(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'CEDS', prcs(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'CEDS', pris(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_sv ) then
- if ( lwarm .and. nmom_c.ge.2) &
- call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'CEDS', pccs(:, :, :) * prhodj(:, :, :) )
+if ( nbumod == kmi .and. BUCONF%lbu_enable ) then
+ if ( BUCONF%lbudget_th ) call BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_TH), 'CEDS', pths(:, :, :) * prhodj(:, :, :) )
+ if ( BUCONF%lbudget_rv ) call BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_RV), 'CEDS', prvs(:, :, :) * prhodj(:, :, :) )
+ if ( BUCONF%lbudget_rc ) call BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_RC), 'CEDS', prcs(:, :, :) * prhodj(:, :, :) )
+ if ( BUCONF%lbudget_ri ) call BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_RI), 'CEDS', pris(:, :, :) * prhodj(:, :, :) )
+ if ( BUCONF%lbudget_sv ) then
+ if ( nmom_c.ge.2) &
+ call BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + nsv_lima_nc), 'CEDS', pccs(:, :, :) * prhodj(:, :, :) )
if ( lscav .and. laero_mass ) &
- call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_scavmass), 'CEDS', pmas(:, :, :) * prhodj(:, :, :) )
- if ( lwarm ) then
+ call BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + nsv_lima_scavmass), 'CEDS', pmas(:, :, :) * prhodj(:, :, :) )
+ if ( nmom_c.ge.1 ) then
do jl = 1, nmod_ccn
idx = NBUDGET_SV1 - 1 + nsv_lima_ccn_free - 1 + jl
- call Budget_store_end( tbudgets(idx), 'CEDS', pnfs(:, :, :, jl) * prhodj(:, :, :) )
+ call BUDGET_STORE_END_PHY(D, TBUDGETS(idx), 'CEDS', pnfs(:, :, :, jl) * prhodj(:, :, :) )
idx = NBUDGET_SV1 - 1 + nsv_lima_ccn_acti - 1 + jl
- call Budget_store_end( tbudgets(idx), 'CEDS', pnas(:, :, :, jl) * prhodj(:, :, :) )
+ call BUDGET_STORE_END_PHY(D, TBUDGETS(idx), 'CEDS', pnas(:, :, :, jl) * prhodj(:, :, :) )
end do
end if
-! if ( lcold ) then
-! call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'CEDS', pcis(:, :, :) * prhodj(:, :, :) )
+! if ( nmom_i.ge.2 ) then
+! call BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + nsv_lima_ni), 'CEDS', pcis(:, :, :) * prhodj(:, :, :) )
! do jl = 1, nmod_ifn
! idx = NBUDGET_SV1 - 1 + nsv_lima_ifn_free - 1 + jl
-! call Budget_store_end( tbudgets(idx), 'CEDS', pifs(:, :, :, jl) * prhodj(:, :, :) )
+! call BUDGET_STORE_END_PHY(D, TBUDGETS(idx), 'CEDS', pifs(:, :, :, jl) * prhodj(:, :, :) )
! idx = NBUDGET_SV1 - 1 + nsv_lima_ifn_nucl - 1 + jl
-! call Budget_store_end( tbudgets(idx), 'CEDS', pins(:, :, :, jl) * prhodj(:, :, :) )
+! call BUDGET_STORE_END_PHY(D, TBUDGETS(idx), 'CEDS', pins(:, :, :, jl) * prhodj(:, :, :) )
! end do
! do jl = 1, nmod_imm
! idx = NBUDGET_SV1 - 1 + nsv_lima_imm_nucl - 1 + jl
-! call Budget_store_init( tbudgets(idx), 'CEDS', pnis(:, :, :, jl) * prhodj(:, :, :) )
+! call BUDGET_STORE_INIT_PHY(D, TBUDGETS(idx), 'CEDS', pnis(:, :, :, jl) * prhodj(:, :, :) )
! end do
! end if
end if
diff --git a/src/PHYEX/micro/lima_cold.f90 b/src/PHYEX/micro/lima_cold.f90
index 56ee422eb7a119cf64698742900da317719b4c39..b4c6b16540847310eea1d18a38e22c5713e339d0 100644
--- a/src/PHYEX/micro/lima_cold.f90
+++ b/src/PHYEX/micro/lima_cold.f90
@@ -8,7 +8,7 @@
! #####################
!
INTERFACE
- SUBROUTINE LIMA_COLD (OSEDI, OHHONI, KSPLITG, PTSTEP, KMI, &
+ SUBROUTINE LIMA_COLD (CST, OSEDI, OHHONI, KSPLITG, PTSTEP, KMI, &
KRR, PZZ, PRHODJ, &
PRHODREF, PEXNREF, PPABST, PW_NU, &
PTHT, PRT, PSVT, &
@@ -16,6 +16,9 @@ INTERFACE
PINPRS, PINPRG, PINPRH)
!
USE MODD_NSV, only: NSV_LIMA_BEG
+USE MODD_CST, ONLY: CST_t
+!
+TYPE(CST_t), INTENT(IN) :: CST
!
LOGICAL, INTENT(IN) :: OSEDI ! switch to activate the
! cloud ice sedimentation
@@ -52,7 +55,7 @@ END INTERFACE
END MODULE MODI_LIMA_COLD
!
! ######################################################################
- SUBROUTINE LIMA_COLD (OSEDI, OHHONI, KSPLITG, PTSTEP, KMI, &
+ SUBROUTINE LIMA_COLD (CST, OSEDI, OHHONI, KSPLITG, PTSTEP, KMI, &
KRR, PZZ, PRHODJ, &
PRHODREF, PEXNREF, PPABST, PW_NU, &
PTHT, PRT, PSVT, &
@@ -111,6 +114,7 @@ END MODULE MODI_LIMA_COLD
!* 0. DECLARATIONS
! ------------
+USE MODD_CST, ONLY: CST_t
use modd_budget, only: lbu_enable, &
lbudget_ri, lbudget_rs, lbudget_rg, lbudget_rh, lbudget_sv, &
NBUDGET_RI, NBUDGET_RS, NBUDGET_RG, NBUDGET_RH, NBUDGET_SV1, &
@@ -131,6 +135,8 @@ IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
!
+TYPE(CST_t), INTENT(IN) :: CST
+!
LOGICAL, INTENT(IN) :: OSEDI ! switch to activate the
! cloud ice sedimentation
LOGICAL, INTENT(IN) :: OHHONI ! enable haze freezing
@@ -261,16 +267,16 @@ PCSS(:,:,:) = 0.
PCGS(:,:,:) = 0.
PCHS(:,:,:) = 0.
!
-IF ( LWARM ) PCCT(:,:,:) = PSVT(:,:,:,NSV_LIMA_NC)
-IF ( LWARM .AND. LRAIN ) PCRT(:,:,:) = PSVT(:,:,:,NSV_LIMA_NR)
-IF ( LCOLD ) PCIT(:,:,:) = PSVT(:,:,:,NSV_LIMA_NI)
+IF ( NMOM_C.GE.2 ) PCCT(:,:,:) = PSVT(:,:,:,NSV_LIMA_NC)
+IF ( NMOM_R.GE.2 ) PCRT(:,:,:) = PSVT(:,:,:,NSV_LIMA_NR)
+IF ( NMOM_I.GE.2 ) PCIT(:,:,:) = PSVT(:,:,:,NSV_LIMA_NI)
IF ( NMOM_S.GE.2 ) PCST(:,:,:) = PSVT(:,:,:,NSV_LIMA_NS)
IF ( NMOM_G.GE.2 ) PCGT(:,:,:) = PSVT(:,:,:,NSV_LIMA_NG)
IF ( NMOM_H.GE.2 ) PCHT(:,:,:) = PSVT(:,:,:,NSV_LIMA_NH)
!
-IF ( LWARM ) PCCS(:,:,:) = PSVS(:,:,:,NSV_LIMA_NC)
-IF ( LWARM .AND. LRAIN ) PCRS(:,:,:) = PSVS(:,:,:,NSV_LIMA_NR)
-IF ( LCOLD ) PCIS(:,:,:) = PSVS(:,:,:,NSV_LIMA_NI)
+IF ( NMOM_C.GE.2 ) PCCS(:,:,:) = PSVS(:,:,:,NSV_LIMA_NC)
+IF ( NMOM_R.GE.2 ) PCRS(:,:,:) = PSVS(:,:,:,NSV_LIMA_NR)
+IF ( NMOM_I.GE.2 ) PCIS(:,:,:) = PSVS(:,:,:,NSV_LIMA_NI)
IF ( NMOM_S.GE.2 ) PCSS(:,:,:) = PSVS(:,:,:,NSV_LIMA_NS)
IF ( NMOM_G.GE.2 ) PCGS(:,:,:) = PSVS(:,:,:,NSV_LIMA_NG)
IF ( NMOM_H.GE.2 ) PCHS(:,:,:) = PSVS(:,:,:,NSV_LIMA_NH)
@@ -323,9 +329,9 @@ END IF
!
if ( lbu_enable ) then
if ( lbudget_ri .and. osedi ) call Budget_store_init( tbudgets(NBUDGET_RI), 'SEDI', pris(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rs .and. lsnow ) call Budget_store_init( tbudgets(NBUDGET_RS), 'SEDI', prss(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rg .and. lsnow ) call Budget_store_init( tbudgets(NBUDGET_RG), 'SEDI', prgs(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rh .and. lhail ) call Budget_store_init( tbudgets(NBUDGET_RH), 'SEDI', prhs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rs ) call Budget_store_init( tbudgets(NBUDGET_RS), 'SEDI', prss(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_init( tbudgets(NBUDGET_RG), 'SEDI', prgs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rh ) call Budget_store_init( tbudgets(NBUDGET_RH), 'SEDI', prhs(:, :, :) * prhodj(:, :, :) )
if ( lbudget_sv .and. osedi ) &
call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'SEDI', pcis(:, :, :) * prhodj(:, :, :) )
if (NMOM_S.GE.2) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ns), 'SEDI', pcss(:, :, :) * prhodj(:, :, :) )
@@ -341,9 +347,9 @@ CALL LIMA_COLD_SEDIMENTATION (OSEDI, KSPLITG, PTSTEP, KMI, &
PCSS=PCSS, PCGS=PCGS, PCHS=PCHS )
if ( lbu_enable ) then
if ( lbudget_ri .and. osedi ) call Budget_store_end( tbudgets(NBUDGET_RI), 'SEDI', pris(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rs .and. lsnow ) call Budget_store_end( tbudgets(NBUDGET_RS), 'SEDI', prss(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rg .and. lsnow ) call Budget_store_end( tbudgets(NBUDGET_RG), 'SEDI', prgs(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rh .and. lhail ) call Budget_store_end( tbudgets(NBUDGET_RH), 'SEDI', prhs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rs ) call Budget_store_end( tbudgets(NBUDGET_RS), 'SEDI', prss(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG), 'SEDI', prgs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rh ) call Budget_store_end( tbudgets(NBUDGET_RH), 'SEDI', prhs(:, :, :) * prhodj(:, :, :) )
if ( lbudget_sv .and. osedi ) &
call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'SEDI', pcis(:, :, :) * prhodj(:, :, :) )
if (NMOM_S.GE.2) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ns), 'SEDI', pcss(:, :, :) * prhodj(:, :, :) )
@@ -367,7 +373,7 @@ IF (LNUCL) THEN
PTHS, PRVS, PRCS, PRIS, &
PCCS, PCIS, PINS )
ELSE
- CALL LIMA_PHILLIPS (OHHONI, PTSTEP, KMI, &
+ CALL LIMA_PHILLIPS (CST, OHHONI, PTSTEP, KMI, &
PZZ, PRHODJ, PRHODREF, PEXNREF, PPABST, &
PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
PTHS, PRVS, PRCS, PRIS, &
@@ -375,7 +381,7 @@ IF (LNUCL) THEN
PNAS, PIFS, PINS, PNIS )
END IF
!
- IF (LWARM .OR. (LHHONI .AND. NMOD_CCN.GE.1)) THEN
+ IF (NMOM_C.GE.1 .OR. (LHHONI .AND. NMOD_CCN.GE.1)) THEN
CALL LIMA_COLD_HOM_NUCL (OHHONI, PTSTEP, KMI, &
PZZ, PRHODJ, &
PRHODREF, PEXNREF, PPABST, PW_NU, &
@@ -393,7 +399,7 @@ END IF
!* 4. SLOW PROCESSES: depositions, aggregation
! ----------------------------------------
!
-IF (LSNOW) THEN
+IF (NMOM_S.GE.1) THEN
!
IF(NMOM_S.GE.2) THEN
CALL LIMA_COLD_SLOW_PROCESSES(PTSTEP, KMI, PZZ, PRHODJ, &
@@ -449,9 +455,9 @@ IF ( KRR .GE. 7 ) PRS(:,:,:,7) = PRHS(:,:,:)
!
! Prepare 3D number concentrations
!
-IF ( LWARM ) PSVS(:,:,:,NSV_LIMA_NC) = PCCS(:,:,:)
-IF ( LWARM .AND. LRAIN ) PSVS(:,:,:,NSV_LIMA_NR) = PCRS(:,:,:)
-IF ( LCOLD ) PSVS(:,:,:,NSV_LIMA_NI) = PCIS(:,:,:)
+IF ( NMOM_C.GE.2 ) PSVS(:,:,:,NSV_LIMA_NC) = PCCS(:,:,:)
+IF ( NMOM_R.GE.2 ) PSVS(:,:,:,NSV_LIMA_NR) = PCRS(:,:,:)
+IF ( NMOM_I.GE.2 ) PSVS(:,:,:,NSV_LIMA_NI) = PCIS(:,:,:)
IF ( NMOM_S.GE.2 ) PSVS(:,:,:,NSV_LIMA_NS) = PCSS(:,:,:)
IF ( NMOM_G.GE.2 ) PSVS(:,:,:,NSV_LIMA_NG) = PCGS(:,:,:)
IF ( NMOM_H.GE.2 ) PSVS(:,:,:,NSV_LIMA_NH) = PCHS(:,:,:)
diff --git a/src/PHYEX/micro/lima_cold_hom_nucl.f90 b/src/PHYEX/micro/lima_cold_hom_nucl.f90
index 407ae868d0a8dc3de26edbc0c024a60fe0c4ba79..cf9fbfe5898328b4b9f941a15c5a8b6fcefbb910 100644
--- a/src/PHYEX/micro/lima_cold_hom_nucl.f90
+++ b/src/PHYEX/micro/lima_cold_hom_nucl.f90
@@ -104,7 +104,7 @@ USE MODD_CST, ONLY: XP00, XRD, XRV, XMV, XMD, XCPD, XCPV, XCL, XCI,
XG
USE MODD_NSV
USE MODD_PARAMETERS, ONLY: JPHEXT, JPVEXT
-USE MODD_PARAM_LIMA, ONLY: NMOD_CCN, NMOD_IMM, XRTMIN, XCTMIN, XNUC, LWARM, LRAIN
+USE MODD_PARAM_LIMA, ONLY: NMOD_CCN, NMOD_IMM, XRTMIN, XCTMIN, XNUC, NMOM_C, NMOM_R
USE MODD_PARAM_LIMA_COLD, ONLY: XRCOEF_HONH, XCEXP_DIFVAP_HONH, XCOEF_DIFVAP_HONH,&
XCRITSAT1_HONH, XCRITSAT2_HONH, XTMAX_HONH, &
XTMIN_HONH, XC1_HONH, XC2_HONH, XC3_HONH, &
@@ -485,7 +485,7 @@ IF (INEGT.GT.0) THEN
! Compute the droplet homogeneous nucleation source: RCHONI
! -> Pruppacher(1995)
!
-IF (LWARM) THEN
+IF (NMOM_C.GE.2) THEN
if ( nbumod == kmi .and. lbu_enable ) then
if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'HONC', &
Unpack( zths(:), mask = gnegt(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) )
@@ -547,7 +547,7 @@ END IF
!
! Compute the drop homogeneous nucleation source: RRHONG
!
-IF (LWARM .AND. LRAIN) THEN
+IF (NMOM_R.GE.2) THEN
if ( nbumod == kmi .and. lbu_enable ) then
if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'HONR', &
Unpack( zths(:), mask = gnegt(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) )
diff --git a/src/PHYEX/micro/lima_cold_slow_processes.f90 b/src/PHYEX/micro/lima_cold_slow_processes.f90
index 0f74d6562a71c2d67b28f644df40dd449eb50bdd..64917a92a27c4bc1f32425e3d931f9919750fd89 100644
--- a/src/PHYEX/micro/lima_cold_slow_processes.f90
+++ b/src/PHYEX/micro/lima_cold_slow_processes.f90
@@ -98,7 +98,7 @@ USE MODD_CST, ONLY: XP00, XRD, XRV, XMV, XMD, XCPD, XCPV, &
XCL, XCI, XTT, XLSTT, XALPI, XBETAI, XGAMI
USE MODD_NSV, ONLY: NSV_LIMA_NI, NSV_LIMA_NS
USE MODD_PARAMETERS, ONLY: JPHEXT, JPVEXT
-USE MODD_PARAM_LIMA, ONLY: LSNOW, LSNOW_T, XRTMIN, XCTMIN, &
+USE MODD_PARAM_LIMA, ONLY: LSNOW_T, XRTMIN, XCTMIN, &
XALPHAI, XALPHAS, XNUI, XNUS, NMOM_S
USE MODD_PARAM_LIMA_COLD, ONLY: XLBI, XLBEXI, XLBS, XLBEXS, XNS, XBI, XCXS, XCCS, &
XLBDAS_MAX, XDSCNVI_LIM, XLBDASCNVI_MAX, &
diff --git a/src/PHYEX/micro/lima_mixed.f90 b/src/PHYEX/micro/lima_mixed.f90
index 400969656b513327addf6ebc070bff61d2e22fce..96fa6513876b27137b222d8b68de552fa8b65c9a 100644
--- a/src/PHYEX/micro/lima_mixed.f90
+++ b/src/PHYEX/micro/lima_mixed.f90
@@ -104,9 +104,9 @@ USE MODD_CST, ONLY: XP00, XRD, XRV, XMV, XMD, XCPD, XCPV, &
XALPI, XBETAI, XGAMI
USE MODD_NSV
USE MODD_PARAMETERS, ONLY: JPHEXT, JPVEXT
-USE MODD_PARAM_LIMA, ONLY: NMOD_IFN, XRTMIN, XCTMIN, LWARM, LCOLD, &
- NMOD_CCN, NMOD_IMM, LRAIN, LSNOW, LHAIL, LSNOW_T, &
- NMOM_S, NMOM_G, NMOM_H
+USE MODD_PARAM_LIMA, ONLY: NMOD_IFN, XRTMIN, XCTMIN, &
+ NMOD_CCN, NMOD_IMM, LSNOW_T, &
+ NMOM_C, NMOM_R, NMOM_I, NMOM_S, NMOM_G, NMOM_H
USE MODD_PARAM_LIMA_WARM, ONLY: XLBC, XLBEXC, XLBR, XLBEXR
USE MODD_PARAM_LIMA_COLD, ONLY: XLBI, XLBEXI, XLBS, XLBEXS, XSCFAC, &
XLBDAS_MAX, XLBDAS_MIN, XTRANS_MP_GAMMAS, &
@@ -316,16 +316,16 @@ PCSS(:,:,:) = 0.
PCGS(:,:,:) = 0.
PCHS(:,:,:) = 0.
!
-IF ( LWARM ) PCCT(:,:,:) = PSVT(:,:,:,NSV_LIMA_NC)
-IF ( LWARM .AND. LRAIN ) PCRT(:,:,:) = PSVT(:,:,:,NSV_LIMA_NR)
-IF ( LCOLD ) PCIT(:,:,:) = PSVT(:,:,:,NSV_LIMA_NI)
+IF ( NMOM_C.GE.2 ) PCCT(:,:,:) = PSVT(:,:,:,NSV_LIMA_NC)
+IF ( NMOM_R.GE.2 ) PCRT(:,:,:) = PSVT(:,:,:,NSV_LIMA_NR)
+IF ( NMOM_I.GE.2 ) PCIT(:,:,:) = PSVT(:,:,:,NSV_LIMA_NI)
IF ( NMOM_S.GE.2 ) PCST(:,:,:) = PSVT(:,:,:,NSV_LIMA_NS)
IF ( NMOM_G.GE.2 ) PCGT(:,:,:) = PSVT(:,:,:,NSV_LIMA_NG)
IF ( NMOM_H.GE.2 ) PCHT(:,:,:) = PSVT(:,:,:,NSV_LIMA_NH)
!
-IF ( LWARM ) PCCS(:,:,:) = PSVS(:,:,:,NSV_LIMA_NC)
-IF ( LWARM .AND. LRAIN ) PCRS(:,:,:) = PSVS(:,:,:,NSV_LIMA_NR)
-IF ( LCOLD ) PCIS(:,:,:) = PSVS(:,:,:,NSV_LIMA_NI)
+IF ( NMOM_C.GE.2 ) PCCS(:,:,:) = PSVS(:,:,:,NSV_LIMA_NC)
+IF ( NMOM_R.GE.2 ) PCRS(:,:,:) = PSVS(:,:,:,NSV_LIMA_NR)
+IF ( NMOM_I.GE.2 ) PCIS(:,:,:) = PSVS(:,:,:,NSV_LIMA_NI)
IF ( NMOM_S.GE.2 ) PCSS(:,:,:) = PSVS(:,:,:,NSV_LIMA_NS)
IF ( NMOM_G.GE.2 ) PCGS(:,:,:) = PSVS(:,:,:,NSV_LIMA_NG)
IF ( NMOM_H.GE.2 ) PCHS(:,:,:) = PSVS(:,:,:,NSV_LIMA_NH)
@@ -608,7 +608,7 @@ IF( IMICRO >= 0 ) THEN
! 3. Compute the fast RS and RG processes
! ------------------------------------
!
-IF (LSNOW) THEN
+IF (NMOM_S.GE.1) THEN
CALL LIMA_MIXED_FAST_PROCESSES(ZRHODREF, ZZT, ZPRES, PTSTEP, &
ZLSFACT, ZLVFACT, ZKA, ZDV, ZCJ, &
ZRVT, ZRCT, ZRRT, ZRIT, ZRST, ZRGT, &
@@ -749,12 +749,12 @@ IF ( KRR .GE. 7 ) PRS(:,:,:,7) = PRHS(:,:,:)
!
! Prepare 3D number concentrations
!
-PSVS(:,:,:,NSV_LIMA_NC) = PCCS(:,:,:)
-IF ( LRAIN ) PSVS(:,:,:,NSV_LIMA_NR) = PCRS(:,:,:)
+IF ( NMOM_C.GE.2 ) PSVS(:,:,:,NSV_LIMA_NC) = PCCS(:,:,:)
+IF ( NMOM_R.GE.2 ) PSVS(:,:,:,NSV_LIMA_NR) = PCRS(:,:,:)
+IF ( NMOM_I.GE.2 ) PSVS(:,:,:,NSV_LIMA_NI) = PCIS(:,:,:)
IF ( NMOM_S.GE.2 ) PSVS(:,:,:,NSV_LIMA_NS) = PCSS(:,:,:)
IF ( NMOM_G.GE.2 ) PSVS(:,:,:,NSV_LIMA_NG) = PCGS(:,:,:)
IF ( NMOM_H.GE.2 ) PSVS(:,:,:,NSV_LIMA_NH) = PCHS(:,:,:)
-PSVS(:,:,:,NSV_LIMA_NI) = PCIS(:,:,:)
!
IF ( NMOD_CCN .GE. 1 ) THEN
PSVS(:,:,:,NSV_LIMA_CCN_FREE:NSV_LIMA_CCN_FREE+NMOD_CCN-1) = PNFS(:,:,:,:)
diff --git a/src/PHYEX/micro/lima_mixed_fast_processes.f90 b/src/PHYEX/micro/lima_mixed_fast_processes.f90
index 6537474b4c65b126bd6e1052f844cd77d45c2e8b..fbd6f4262aeee15270085e26359d1cf0939daf31 100644
--- a/src/PHYEX/micro/lima_mixed_fast_processes.f90
+++ b/src/PHYEX/micro/lima_mixed_fast_processes.f90
@@ -309,13 +309,13 @@ LOGICAL :: M2_ICE
!-------------------------------------------------------------------------------
!
M2_ICE = NMOM_S.GE.2 .AND. NMOM_G.GE.2
-IF (LHAIL) M2_ICE = M2_ICE .AND. NMOM_H.GE.2
+IF (NMOM_H.GE.1) M2_ICE = M2_ICE .AND. NMOM_H.GE.2
!
! #################
! FAST RS PROCESSES
! #################
!
-SNOW: IF (LSNOW) THEN
+SNOW: IF (NMOM_S.GE.1) THEN
!
!
!* 1.1 Cloud droplet riming of the aggregates
@@ -832,7 +832,7 @@ ZZW1(:,2:3) = 0.0
GACC(:) = (PRRT1D(:)>XRTMIN(3)) .AND. (PRST1D(:)>XRTMIN(5)) .AND. (PRRS1D(:)>XRTMIN(3)/PTSTEP) .AND. (PZT(:)<XTT)
IGACC = COUNT( GACC(:) )
!
-IF( IGACC>0 .AND. LRAIN) THEN
+IF( IGACC>0 .AND. NMOM_R.GE.2) THEN
! Budget storage
if ( nbumod == kmi .and. lbu_enable ) then
if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'ACC', &
@@ -1269,7 +1269,7 @@ if ( nbumod == kmi .and. lbu_enable ) then
Unpack( pcss1d(:), mask = gmicro(:, :, :), field = pcss(:, :, :) ) * prhodj(:, :, :) )
call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ng), 'WETG', &
Unpack( pcgs1d(:), mask = gmicro(:, :, :), field = pcgs(:, :, :) ) * prhodj(:, :, :) )
- if (LHAIL) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nh), 'WETG', &
+ if (NMOM_H.GE.2) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nh), 'WETG', &
Unpack( pchs1d(:), mask = gmicro(:, :, :), field = pchs(:, :, :) ) * prhodj(:, :, :) )
end if
end if
@@ -1506,7 +1506,7 @@ END WHERE
!
ZZW(:) = 0.0
NHAIL = 0.
-IF (LHAIL) NHAIL = 1.
+IF (NMOM_H.GE.1) NHAIL = 1.
DO JJ=1, SIZE(PRGT1D)
IF ( PRGT1D(JJ)>XRTMIN(6) .AND. PZT(JJ)<XTT .AND. &
(ZRDRYG(JJ)-ZZW1(JJ,2)-ZZW1(JJ,3))>(ZRWETG(JJ)-ZZW1(JJ,5)-ZZW1(JJ,6)) .AND. (ZRWETG(JJ)-ZZW1(JJ,5)-ZZW1(JJ,6))>0.0 ) THEN
@@ -1576,7 +1576,7 @@ if ( nbumod == kmi .and. lbu_enable ) then
Unpack( pcss1d(:), mask = gmicro(:, :, :), field = pcss(:, :, :) ) * prhodj(:, :, :) )
call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ng), 'WETG', &
Unpack( pcgs1d(:), mask = gmicro(:, :, :), field = pcgs(:, :, :) ) * prhodj(:, :, :) )
- if (LHAIL) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nh), 'WETG', &
+ if (NMOM_H.GE.2) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nh), 'WETG', &
Unpack( pchs1d(:), mask = gmicro(:, :, :), field = pchs(:, :, :) ) * prhodj(:, :, :) )
end if
end if
@@ -1767,7 +1767,7 @@ end if
! #################
!
!
-HAIL: IF (LHAIL) THEN
+HAIL: IF (NMOM_H.GE.1) THEN
!
GHAIL(:) = PRHT1D(:)>XRTMIN(7)
IHAIL = COUNT(GHAIL(:))
diff --git a/src/PHYEX/micro/lima_mixed_slow_processes.f90 b/src/PHYEX/micro/lima_mixed_slow_processes.f90
index 1daf983b673fe3e601bdfe4ccd33a7a5f7f93304..609f54dd8d8f6d0a7ca7af505805ca7b9be8083f 100644
--- a/src/PHYEX/micro/lima_mixed_slow_processes.f90
+++ b/src/PHYEX/micro/lima_mixed_slow_processes.f90
@@ -132,7 +132,7 @@ use modd_budget, only: lbu_enable, nbumod,
USE MODD_CST, ONLY : XTT, XALPI, XBETAI, XGAMI, &
XALPW, XBETAW, XGAMW
USE MODD_NSV
-USE MODD_PARAM_LIMA, ONLY : XRTMIN, XCTMIN, NMOD_IFN, LSNOW, LHAIL, NMOM_S, NMOM_G, NMOM_H
+USE MODD_PARAM_LIMA, ONLY : XRTMIN, XCTMIN, NMOD_IFN, NMOM_S, NMOM_G, NMOM_H
USE MODD_PARAM_LIMA_COLD, ONLY : XDI, X0DEPI, X2DEPI, XSCFAC
USE MODD_PARAM_LIMA_MIXED, ONLY : XLBG, XLBEXG, XLBDAG_MAX, XCCG, XCXG, &
X0DEPG, XEX0DEPG, X1DEPG, XEX1DEPG, &
@@ -202,7 +202,7 @@ INTEGER :: JMOD_IFN
! ---------------------------------------------
!
!
-IF (LSNOW) THEN
+IF (NMOM_S.GE.1) THEN
ZZW(:) = 0.0
WHERE ( (ZRGT(:)>XRTMIN(6)) .AND. (ZRGS(:)>XRTMIN(6)/PTSTEP) )
ZZW(:) = ( ZSSI(:)/ZAI(:)/ZRHODREF(:) ) * ZCGT(:) * &
@@ -230,7 +230,7 @@ END IF
! ---------------------------------------------
!
!
-IF (LHAIL .AND. NMOM_H.GE.2) THEN
+IF (NMOM_H.GE.2) THEN
ZZW(:) = 0.0
WHERE ( (ZRHT(:)>XRTMIN(7)) .AND. (ZRHS(:)>XRTMIN(7)/PTSTEP) )
ZZW(:) = ( ZSSI(:)/(ZAI(:)) ) * ZCHT(:) * &
diff --git a/src/PHYEX/micro/lima_notadjust.f90 b/src/PHYEX/micro/lima_notadjust.f90
index ddd221297382b329637fea4589002845dcf4a696..255eaa618018099ffbd634f2e738f5541e0a4479 100644
--- a/src/PHYEX/micro/lima_notadjust.f90
+++ b/src/PHYEX/micro/lima_notadjust.f90
@@ -14,6 +14,7 @@ INTERFACE
PTHT,PRT, PSVT, PTHS, PRS,PSVS, PCLDFR, PICEFR, PRAINFR, PSRCS )
!
USE MODD_IO, ONLY: TFILEDATA
+USE MODD_NSV, only: NSV_LIMA_BEG
!
INTEGER, INTENT(IN) :: KMI ! Model index
TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
@@ -30,10 +31,10 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Reference density
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta
REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT ! m.r. at t
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVT ! Concentrations source
+REAL, DIMENSION(:,:,:,NSV_LIMA_BEG:), INTENT(IN) :: PSVT ! Concentrations at t
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source
REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRS ! m.r. source
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVS ! Concentrations source
+REAL, DIMENSION(:,:,:,NSV_LIMA_BEG:), INTENT(INOUT) :: PSVS ! Concentrations source
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSRCS ! Second-order flux
! s'rc'/2Sigma_s2 at time t+1
! multiplied by Lambda_3
@@ -120,10 +121,10 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Reference density
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta
REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT ! m.r. at t
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVT ! Concentrations source
+REAL, DIMENSION(:,:,:,NSV_LIMA_BEG:), INTENT(IN) :: PSVT ! Concentrations at t
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source
REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRS ! m.r. source
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVS ! Concentrations source
+REAL, DIMENSION(:,:,:,NSV_LIMA_BEG:), INTENT(INOUT) :: PSVS ! Concentrations source
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSRCS ! Second-order flux
! s'rc'/2Sigma_s2 at time t+1
! multiplied by Lambda_3
@@ -192,7 +193,7 @@ if ( nbumod == kmi .and. lbu_enable ) then
if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'CEDS', prs(:, :, :, 2) * prhodj(:, :, :) )
if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'CEDS', prs(:, :, :, 4) * prhodj(:, :, :) )
if ( lbudget_sv ) then
- if ( lwarm .and. nmom_c.ge.2) then
+ if ( nmom_c.ge.2) then
call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'CEDS', psvs(:, :, :, nsv_lima_nc) * prhodj(:, :, :) )
do jl = nsv_lima_ccn_free, nsv_lima_ccn_free + nmod_ccn - 1
idx = NBUDGET_SV1 - 1 + jl
@@ -206,7 +207,7 @@ if ( nbumod == kmi .and. lbu_enable ) then
! if ( lscav .and. laero_mass ) &
! call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_scavmass), 'CEDS', psvs(:, :, :, nsv_lima_scavmass) &
! * prhodj(:, :, :) )
-! if ( lcold ) then
+! if ( nmom_i.ge.2 ) then
! call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'CEDS', psvs(:, :, :, nsv_lima_ni) * prhodj(:, :, :) )
! do jl = 1, nsv_lima_ifn_free, nsv_lima_ifn_free + nmod_ifn - 1
! idx = NBUDGET_SV1 - 1 + jl
@@ -611,7 +612,7 @@ if ( nbumod == kmi .and. lbu_enable ) then
if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'CEDS', prs(:, :, :, 2) * prhodj(:, :, :) )
if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'CEDS', prs(:, :, :, 4) * prhodj(:, :, :) )
if ( lbudget_sv ) then
- if ( lwarm .and. nmom_c.ge.2) then
+ if (nmom_c.ge.2) then
call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'CEDS', psvs(:, :, :, nsv_lima_nc) * prhodj(:, :, :) )
do jl = nsv_lima_ccn_free, nsv_lima_ccn_free + nmod_ccn - 1
idx = NBUDGET_SV1 - 1 + jl
@@ -625,7 +626,7 @@ if ( nbumod == kmi .and. lbu_enable ) then
! if ( lscav .and. laero_mass ) &
! call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_scavmass), 'CEDS', psvs(:, :, :, nsv_lima_scavmass) &
! * prhodj(:, :, :) )
-! if ( lcold ) then
+! if ( nmom_i.ge.2 ) then
! call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'CEDS', psvs(:, :, :, nsv_lima_ni) * prhodj(:, :, :) )
! do jl = 1, nsv_lima_ifn_free, nsv_lima_ifn_free + nmod_ifn - 1
! idx = NBUDGET_SV1 - 1 + jl
diff --git a/src/PHYEX/micro/lima_phillips.f90 b/src/PHYEX/micro/lima_phillips.f90
index 1ca330e353e142451acd53c6bec902cae233b4b8..2374f6725e657d915e3dce6501dab6ff527b0025 100644
--- a/src/PHYEX/micro/lima_phillips.f90
+++ b/src/PHYEX/micro/lima_phillips.f90
@@ -8,13 +8,16 @@
! #########################
!
INTERFACE
- SUBROUTINE LIMA_PHILLIPS (OHHONI, PTSTEP, KMI, &
+ SUBROUTINE LIMA_PHILLIPS (CST, OHHONI, PTSTEP, KMI, &
PZZ, PRHODJ, PRHODREF, PEXNREF, PPABST, &
PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
PTHS, PRVS, PRCS, PRIS, &
PCIT, PCCS, PCIS, &
PNAS, PIFS, PINS, PNIS )
!
+USE MODD_CST, ONLY: CST_t
+TYPE(CST_t), INTENT(IN) :: CST
+!
LOGICAL, INTENT(IN) :: OHHONI ! enable haze freezing
REAL, INTENT(IN) :: PTSTEP ! Time step
INTEGER, INTENT(IN) :: KMI ! Model index
@@ -59,7 +62,7 @@ END INTERFACE
END MODULE MODI_LIMA_PHILLIPS
!
! #####################################################################
- SUBROUTINE LIMA_PHILLIPS (OHHONI, PTSTEP, KMI, &
+ SUBROUTINE LIMA_PHILLIPS (CST, OHHONI, PTSTEP, KMI, &
PZZ, PRHODJ, PRHODREF, PEXNREF, PPABST, &
PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
PTHS, PRVS, PRCS, PRIS, &
@@ -128,9 +131,7 @@ use modd_budget, only: lbu_enable, nbumod,
lbudget_th, lbudget_rv, lbudget_rc, lbudget_ri, lbudget_sv, &
NBUDGET_TH, NBUDGET_RV, NBUDGET_RC, NBUDGET_RI, NBUDGET_SV1, &
tbudgets
-USE MODD_CST, ONLY : XP00, XRD, XMV, XMD, XCPD, XCPV, XCL, XCI, &
- XTT, XLSTT, XLVTT, XALPI, XBETAI, XGAMI, &
- XALPW, XBETAW, XGAMW, XPI
+USE MODD_CST, ONLY : CST_t
USE MODD_NSV, ONLY : NSV_LIMA_NC, NSV_LIMA_NI, NSV_LIMA_CCN_ACTI, NSV_LIMA_IFN_FREE, NSV_LIMA_IFN_NUCL, NSV_LIMA_IMM_NUCL
USE MODD_PARAMETERS, ONLY : JPHEXT, JPVEXT
USE MODD_PARAM_LIMA, ONLY : NMOD_IFN, NSPECIE, XFRAC, &
@@ -141,13 +142,15 @@ USE MODD_PARAM_LIMA_COLD, ONLY : XMNU0
use mode_budget, only: Budget_store_init, Budget_store_end
use mode_tools, only: Countjv
-USE MODI_LIMA_PHILLIPS_INTEG
-USE MODI_LIMA_PHILLIPS_REF_SPECTRUM
+USE MODE_LIMA_PHILLIPS_INTEG, ONLY: LIMA_PHILLIPS_INTEG
+USE MODE_LIMA_PHILLIPS_REF_SPECTRUM, ONLY: LIMA_PHILLIPS_REF_SPECTRUM
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
!
+TYPE(CST_t), INTENT(IN) :: CST
+!
LOGICAL, INTENT(IN) :: OHHONI ! enable haze freezing
REAL, INTENT(IN) :: PTSTEP ! Time step
INTEGER, INTENT(IN) :: KMI ! Model index
@@ -273,12 +276,12 @@ ZCTMIN(:) = XCTMIN(:) / PTSTEP
!
! Temperature
!
-ZT(:,:,:) = PTHT(:,:,:) * ( PPABST(:,:,:)/XP00 ) ** (XRD/XCPD)
+ZT(:,:,:) = PTHT(:,:,:) * ( PPABST(:,:,:)/CST%XP00 ) ** (CST%XRD/CST%XCPD)
!
! Saturation over ice
!
-ZW(:,:,:) = EXP( XALPI - XBETAI/ZT(:,:,:) - XGAMI*ALOG(ZT(:,:,:) ) )
-ZW(:,:,:) = PRVT(:,:,:)*( PPABST(:,:,:)-ZW(:,:,:) ) / ( (XMV/XMD) * ZW(:,:,:) )
+ZW(:,:,:) = EXP( CST%XALPI - CST%XBETAI/ZT(:,:,:) - CST%XGAMI*ALOG(ZT(:,:,:) ) )
+ZW(:,:,:) = PRVT(:,:,:)*( PPABST(:,:,:)-ZW(:,:,:) ) / ( (CST%XMV/CST%XMD) * ZW(:,:,:) )
!
!
!-------------------------------------------------------------------------------
@@ -289,7 +292,7 @@ ZW(:,:,:) = PRVT(:,:,:)*( PPABST(:,:,:)-ZW(:,:,:) ) / ( (XMV/XMD) * ZW(:,:,:) )
!
!
GNEGT(:,:,:) = .FALSE.
-GNEGT(IIB:IIE,IJB:IJE,IKB:IKE) = ZT(IIB:IIE,IJB:IJE,IKB:IKE)<XTT-2.0 .AND. &
+GNEGT(IIB:IIE,IJB:IJE,IKB:IKE) = ZT(IIB:IIE,IJB:IJE,IKB:IKE)<CST%XTT-2.0 .AND. &
ZW(IIB:IIE,IJB:IJE,IKB:IKE)>0.95
INEGT = COUNTJV( GNEGT(:,:,:),I1(:),I2(:),I3(:))
!
@@ -384,17 +387,17 @@ ALLOCATE( ZZY (INEGT) ) ; ZZY(:) = 0.0
! -----------------------------------------
!
!
-ZTCELSIUS(:) = ZZT(:)-XTT ! T [°C]
-ZZW(:) = ZEXNREF(:)*( XCPD+XCPV*ZRVT(:)+XCL*(ZRCT(:)+ZRRT(:)) &
- +XCI*(ZRIT(:)+ZRST(:)+ZRGT(:)) )
-ZLSFACT(:) = (XLSTT+(XCPV-XCI)*ZTCELSIUS(:))/ZZW(:) ! L_s/(Pi_ref*C_ph)
-ZLVFACT(:) = (XLVTT+(XCPV-XCL)*ZTCELSIUS(:))/ZZW(:) ! L_v/(Pi_ref*C_ph)
+ZTCELSIUS(:) = ZZT(:)-CST%XTT ! T [°C]
+ZZW(:) = ZEXNREF(:)*( CST%XCPD+CST%XCPV*ZRVT(:)+CST%XCL*(ZRCT(:)+ZRRT(:)) &
+ +CST%XCI*(ZRIT(:)+ZRST(:)+ZRGT(:)) )
+ZLSFACT(:) = (CST%XLSTT+(CST%XCPV-CST%XCI)*ZTCELSIUS(:))/ZZW(:) ! L_s/(Pi_ref*C_ph)
+ZLVFACT(:) = (CST%XLVTT+(CST%XCPV-CST%XCL)*ZTCELSIUS(:))/ZZW(:) ! L_v/(Pi_ref*C_ph)
!
-ZZW(:) = EXP( XALPI - XBETAI/ZZT(:) - XGAMI*ALOG(ZZT(:) ) ) ! es_i
-ZSI(:) = ZRVT(:)*(ZPRES(:)-ZZW(:))/((XMV/XMD)*ZZW(:)) ! Saturation over ice
+ZZW(:) = EXP( CST%XALPI - CST%XBETAI/ZZT(:) - CST%XGAMI*ALOG(ZZT(:) ) ) ! es_i
+ZSI(:) = ZRVT(:)*(ZPRES(:)-ZZW(:))/((CST%XMV/CST%XMD)*ZZW(:)) ! Saturation over ice
!
-ZZY(:) = EXP( XALPW - XBETAW/ZZT(:) - XGAMW*ALOG(ZZT(:) ) ) ! es_w
-ZSW(:) = ZRVT(:)*(ZPRES(:)-ZZY(:))/((XMV/XMD)*ZZY(:)) ! Saturation over water
+ZZY(:) = EXP( CST%XALPW - CST%XBETAW/ZZT(:) - CST%XGAMW*ALOG(ZZT(:) ) ) ! es_w
+ZSW(:) = ZRVT(:)*(ZPRES(:)-ZZY(:))/((CST%XMV/CST%XMD)*ZZY(:)) ! Saturation over water
!
ZSI_W(:)= ZZY(:)/ZZW(:) ! Saturation over ice at water saturation: es_w/es_i
!
@@ -423,12 +426,12 @@ END IF
!
! Computation of the reference activity spectrum ( ZZY = N_{IN,1,*} )
!
-CALL LIMA_PHILLIPS_REF_SPECTRUM(ZZT, ZSI, ZSI_W, ZZY)
+CALL LIMA_PHILLIPS_REF_SPECTRUM(CST, ZZT, ZSI, ZSI_W, ZZY)
!
! For each aerosol species (DM1, DM2, BC, O), compute the fraction that may be activated
! Z_FRAC_ACT(INEGT,NSPECIE) = fraction of each species that may be activated
!
-CALL LIMA_PHILLIPS_INTEG(ZZT, ZSI, ZSI0, ZSW, ZZY, Z_FRAC_ACT)
+CALL LIMA_PHILLIPS_INTEG(CST, ZZT, ZSI, ZSI0, ZSW, ZZY, Z_FRAC_ACT)
!
!
!-------------------------------------------------------------------------------
diff --git a/src/PHYEX/micro/lima_precip_scavenging.f90 b/src/PHYEX/micro/lima_precip_scavenging.f90
index aaabf3f298cc30a22fab869f8602151d82e12897..ef8e03cf87cab141c05eeff43dd1aa52a02206bd 100644
--- a/src/PHYEX/micro/lima_precip_scavenging.f90
+++ b/src/PHYEX/micro/lima_precip_scavenging.f90
@@ -3,42 +3,10 @@
!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_PRECIP_SCAVENGING
-! ##################################
-!
-INTERFACE
- SUBROUTINE LIMA_PRECIP_SCAVENGING (HCLOUD, KLUOUT, KTCOUNT, PTSTEP, &
- PRRT, PRHODREF, PRHODJ, PZZ, &
- PPABST, PTHT, PSVT, PRSVS, PINPAP )
-
-use modd_nsv, only: nsv_lima_beg
-
-CHARACTER(LEN=4), INTENT(IN) :: HCLOUD ! cloud paramerization
-INTEGER, INTENT(IN) :: KLUOUT ! unit for output listing
-INTEGER, INTENT(IN) :: KTCOUNT ! iteration count
-REAL, INTENT(IN) :: PTSTEP ! Double timestep except
- ! for the first time step
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Rain mixing ratio at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Air Density [kg/m**3]
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry Density [kg]
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Altitude
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! Absolute pressure at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta at time t
-!
-REAL, DIMENSION(:,:,:,NSV_LIMA_BEG:), INTENT(IN) :: PSVT ! Particle Concentration [kg-1]
-REAL, DIMENSION(:,:,:,NSV_LIMA_BEG:), INTENT(INOUT) :: PRSVS ! Total Number Scavenging Rate
-!
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPAP
-!
-END SUBROUTINE LIMA_PRECIP_SCAVENGING
-END INTERFACE
-END MODULE MODI_LIMA_PRECIP_SCAVENGING
-!
!########################################################################
- SUBROUTINE LIMA_PRECIP_SCAVENGING (HCLOUD, KLUOUT, KTCOUNT, PTSTEP, &
- PRRT, PRHODREF, PRHODJ, PZZ, &
+ SUBROUTINE LIMA_PRECIP_SCAVENGING (D, CST, BUCONF, TBUDGETS, KBUDGETS, &
+ HCLOUD, KLUOUT, KTCOUNT, PTSTEP, &
+ PRRT, PRHODREF, PRHODJ, PZZ, &
PPABST, PTHT, PSVT, PRSVS, PINPAP )
!########################################################################x
!
@@ -109,8 +77,9 @@ END MODULE MODI_LIMA_PRECIP_SCAVENGING
!* 0.DECLARATIONS
! --------------
!
-use modd_budget, only: lbudget_sv, NBUDGET_SV1, tbudgets
-USE MODD_CST
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+use modd_budget, only: TBUDGETDATA, TBUDGETCONF_t, NBUDGET_SV1
+USE MODD_CST, ONLY: CST_t
USE MODD_NSV
USE MODD_PARAMETERS
USE MODD_PARAM_LIMA, ONLY: NMOD_IFN, NSPECIE, XFRAC, &
@@ -122,17 +91,22 @@ USE MODD_PARAM_LIMA, ONLY: NMOD_IFN, NSPECIE, XFRAC,
XRTMIN, XCTMIN
USE MODD_PARAM_LIMA_WARM, ONLY: XCR, XDR
-use mode_budget, only: Budget_store_init, Budget_store_end
+USE MODE_BUDGET_PHY, ONLY: Budget_store_init_phy, Budget_store_end_phy
use mode_tools, only: Countjv
USE MODI_GAMMA
-USE MODI_INI_NSV
-USE MODI_LIMA_FUNCTIONS
+USE MODE_LIMA_FUNCTIONS, ONLY: GAUHER, GAULAG
IMPLICIT NONE
!
!* 0.1 declarations of dummy arguments :
!
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+TYPE(CST_t), INTENT(IN) :: CST
+TYPE(TBUDGETCONF_t), INTENT(IN) :: BUCONF
+TYPE(TBUDGETDATA), DIMENSION(KBUDGETS), INTENT(INOUT) :: TBUDGETS
+INTEGER, INTENT(IN) :: KBUDGETS
+!
CHARACTER(LEN=4), INTENT(IN) :: HCLOUD ! cloud paramerization
INTEGER, INTENT(IN) :: KLUOUT ! unit for output listing
INTEGER, INTENT(IN) :: KTCOUNT ! iteration count
@@ -146,8 +120,8 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Altitude
REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! Absolute pressure at t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta at time t
!
-REAL, DIMENSION(:,:,:,NSV_LIMA_BEG:), INTENT(IN) :: PSVT ! Particle Concentration [/m**3]
-REAL, DIMENSION(:,:,:,NSV_LIMA_BEG:), INTENT(INOUT) :: PRSVS ! Total Number Scavenging Rate
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVT ! Particle Concentration [/m**3]
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRSVS ! Total Number Scavenging Rate
!
REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPAP
!
@@ -252,21 +226,24 @@ REAL :: XSIGMAP
REAL :: XRHOP
REAL :: XFRACP
!
-!
+INTEGER :: ISV_LIMA_NR
+INTEGER :: ISV_LIMA_SCAVMASS
!
!------------------------------------------------------------------------------
+ISV_LIMA_NR = NSV_LIMA_NR - NSV_LIMA_BEG + 1
+ISV_LIMA_SCAVMASS = NSV_LIMA_SCAVMASS - NSV_LIMA_BEG + 1
-if ( lbudget_sv ) then
+if ( BUCONF%lbudget_sv ) then
do jl = 1, nmod_ccn
idx = nsv_lima_ccn_free - 1 + jl
- call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + idx), 'SCAV', prsvs(:, :, :, idx) )
+ call Budget_store_init_phy(D, tbudgets(NBUDGET_SV1 - 1 + idx), 'SCAV', prsvs(:, :, :, idx) )
end do
do jl = 1, nmod_ifn
idx = nsv_lima_ifn_free - 1 + jl
- call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + idx), 'SCAV', prsvs(:, :, :, idx) )
+ call Budget_store_init_phy(D, tbudgets(NBUDGET_SV1 - 1 + idx), 'SCAV', prsvs(:, :, :, idx) )
end do
if ( laero_mass ) then
- call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_scavmass), 'SCAV', prsvs(:, :, :, nsv_lima_scavmass) )
+ call Budget_store_init_phy(D, tbudgets(NBUDGET_SV1 - 1 + nsv_lima_scavmass), 'SCAV', prsvs(:, :, :, nsv_lima_scavmass) )
end if
end if
!
@@ -282,7 +259,7 @@ IKB=1+JPVEXT
IKE=SIZE(PRHODREF,3) - JPVEXT
!
! PCRT
-PCRT(:,:,:)=PSVT(:,:,:,NSV_LIMA_NR)
+PCRT(:,:,:)=PSVT(:,:,:,ISV_LIMA_NR)
!
! Rain mask
GRAIN(:,:,:) = .FALSE.
@@ -313,19 +290,19 @@ ZSHAPE_FACTOR = GAMMA_X0D(XNUR+3./XALPHAR)/GAMMA_X0D(XNUR)
!
WHERE ( GRAIN(:,:,:) )
!
- ZT_3D(:,:,:) = PTHT(:,:,:) * ( PPABST(:,:,:)/XP00 )**(XRD/XCPD)
+ ZT_3D(:,:,:) = PTHT(:,:,:) * ( PPABST(:,:,:)/CST%XP00 )**(CST%XRD/CST%XCPD)
ZCONCR_3D(:,:,:) = PCRT(:,:,:) * PRHODREF(:,:,:) ![/m3]
! Sutherland law for viscosity of air
ZVISCA_3D(:,:,:) = XMUA0*(ZT_3D(:,:,:)/XTREF)**1.5*(XTREF+XT_SUTH_A) &
/(XT_SUTH_A+ZT_3D(:,:,:))
! Air mean free path
- ZMFPA_3D(:,:,:) = XMFPA0*(XP00*ZT_3D(:,:,:))/(PPABST(:,:,:)*XT0SCAV)
+ ZMFPA_3D(:,:,:) = XMFPA0*(CST%XP00*ZT_3D(:,:,:))/(PPABST(:,:,:)*XT0SCAV)
! Viscosity ratio
ZVISC_RATIO_3D(:,:,:) = ZVISCA_3D(:,:,:)/XVISCW !!!!! inversé par rapport à orig. !
! Rain drops parameters
- ZLAMBDAR_3D(:,:,:) = ( ((XPI/6.)*ZSHAPE_FACTOR*XRHOLW*ZCONCR_3D(:,:,:)) &
+ ZLAMBDAR_3D(:,:,:) = ( ((CST%XPI/6.)*ZSHAPE_FACTOR*CST%XRHOLW*ZCONCR_3D(:,:,:)) &
/(PRHODREF(:,:,:)*PRRT(:,:,:)) )**(1./3.) ![/m]
- FACTOR_3D(:,:,:) = XPI*0.25*ZCONCR_3D(:,:,:)*XCR*(XRHO00/PRHODREF(:,:,:))**(0.4)
+ FACTOR_3D(:,:,:) = CST%XPI*0.25*ZCONCR_3D(:,:,:)*XCR*(XRHO00/PRHODREF(:,:,:))**(0.4)
!
END WHERE
!
@@ -361,11 +338,11 @@ DO JSV = 1, NMOD_CCN+NMOD_IFN
!
IF (JSV .LE. NMOD_CCN) THEN
JMOD = JSV
- SV_VAR = NSV_LIMA_CCN_FREE -1 + JMOD ! Variable number in PSVT
+ SV_VAR = NSV_LIMA_CCN_FREE - NSV_LIMA_BEG + JMOD ! Variable number in PSVT
NM = 1 ! Number of species (for IFN int. mixing)
ELSE
JMOD = JSV - NMOD_CCN
- SV_VAR = NSV_LIMA_IFN_FREE -1 + JMOD
+ SV_VAR = NSV_LIMA_IFN_FREE - NSV_LIMA_BEG + JMOD
NM = NSPECIE
END IF
!
@@ -469,7 +446,7 @@ DO JSV = 1, NMOD_CCN+NMOD_IFN
ZKNUDSEN(:) = MIN( 20.,ZVOLDP(J1)/ZMFPA(:) )
ZCUNSLIP(:,J1) = 1.0+2.0/ZKNUDSEN(:)*(1.257+0.4*EXP(-0.55*ZKNUDSEN(:)))
! Diffusion coefficient
- ZDIFF(:,J1) = XBOLTZ*ZT(:)*ZCUNSLIP(:,J1)/(3.*XPI*ZVISCA(:)*ZVOLDP(J1))
+ ZDIFF(:,J1) = CST%XBOLTZ*ZT(:)*ZCUNSLIP(:,J1)/(3.*CST%XPI*ZVISCA(:)*ZVOLDP(J1))
! Schmidt number
ZSC(:,J1) = ZVISCA(:)/(ZRHODREF(:)*ZDIFF(:,J1))
ZSC_INV(:,J1) = 1./ZSC(:,J1)
@@ -478,7 +455,7 @@ DO JSV = 1, NMOD_CCN+NMOD_IFN
! Characteristic Time Required for reaching terminal velocity
ZRELT(:,J1) = (ZVOLDP(J1)**2)*ZCUNSLIP(:,J1)*XRHOP/(18.*ZVISCA(:))
! Density number
- ZDENS_RATIO = XRHOP/XRHOLW
+ ZDENS_RATIO = XRHOP/CST%XRHOLW
ZDENS_RATIO_SQRT = SQRT(ZDENS_RATIO)
! Initialisation
ZBC_SCAV_COEF(:,J1)=0.
@@ -487,7 +464,7 @@ DO JSV = 1, NMOD_CCN+NMOD_IFN
!
DO J2=1,NDIAMR
! Stokes number
- ZST(:,J1,J2) = 2.*ZRELT(:,J1)*(ZFVELR(:,J2)-ZRELT(1,J1)*XG) &
+ ZST(:,J1,J2) = 2.*ZRELT(:,J1)*(ZFVELR(:,J2)-ZRELT(1,J1)*CST%XG) &
*ZVOLDR_INV(:,J2)
! Size Ratio
ZSIZE_RATIO(:,J1,J2) = ZVOLDP(J1)*ZVOLDR_INV(:,J2)
@@ -508,7 +485,7 @@ DO JSV = 1, NMOD_CCN+NMOD_IFN
! Total MASS Scavenging Rate of aerosol [kg.m**-3.s**-1]
ZTOT_MASS_RATE(:) = ZTOT_MASS_RATE(:) + &
ZWEIGHTP(J1)*XFRACP*ZCONCP(:)*ZBC_SCAV_COEF(:,J1) &
- *XPI/6.*XRHOP*(ZVOLDP(J1)**3)
+ *CST%XPI/6.*XRHOP*(ZVOLDP(J1)**3)
END DO
! End of the loop over the drops diameters
!--------------------------------------------------------------------------
@@ -524,9 +501,9 @@ DO JSV = 1, NMOD_CCN+NMOD_IFN
PTOT_MASS_RATE(:,:,:) = PTOT_MASS_RATE(:,:,:) + &
UNPACK(ZTOT_MASS_RATE(:), MASK=GSCAV(:,:,:), FIELD=0.0)
CALL SCAV_MASS_SEDIMENTATION( HCLOUD, PTSTEP, KTCOUNT, PZZ, PRHODJ, &
- PRHODREF, PRRT, PSVT(:,:,:,NSV_LIMA_SCAVMASS),&
- PRSVS(:,:,:,NSV_LIMA_SCAVMASS), PINPAP )
- PRSVS(:,:,:,NSV_LIMA_SCAVMASS)=PRSVS(:,:,:,NSV_LIMA_SCAVMASS) + &
+ PRHODREF, PRRT, PSVT(:,:,:,ISV_LIMA_SCAVMASS),&
+ PRSVS(:,:,:,ISV_LIMA_SCAVMASS), PINPAP )
+ PRSVS(:,:,:,ISV_LIMA_SCAVMASS)=PRSVS(:,:,:,ISV_LIMA_SCAVMASS) + &
PTOT_MASS_RATE(:,:,:)*PRHODJ(:,:,:)/PRHODREF(:,:,:)
END IF
ENDDO
@@ -575,17 +552,17 @@ DO JSV = 1, NMOD_CCN+NMOD_IFN
ENDIF
ENDDO
!
-if ( lbudget_sv ) then
+if ( BUCONF%lbudget_sv ) then
do jl = 1, nmod_ccn
idx = nsv_lima_ccn_free - 1 + jl
- call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + idx), 'SCAV', prsvs(:, :, :, idx) )
+ call Budget_store_end_phy(D, tbudgets(NBUDGET_SV1 - 1 + idx), 'SCAV', prsvs(:, :, :, idx) )
end do
do jl = 1, nmod_ifn
idx = nsv_lima_ifn_free - 1 + jl
- call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + idx), 'SCAV', prsvs(:, :, :, idx) )
+ call Budget_store_end_phy(D, tbudgets(NBUDGET_SV1 - 1 + idx), 'SCAV', prsvs(:, :, :, idx) )
end do
if ( laero_mass ) then
- call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_scavmass), 'SCAV', prsvs(:, :, :, nsv_lima_scavmass) )
+ call Budget_store_end_phy(D, tbudgets(NBUDGET_SV1 - 1 + nsv_lima_scavmass), 'SCAV', prsvs(:, :, :, nsv_lima_scavmass) )
end if
end if
!------------------------------------------------------------------------------
diff --git a/src/PHYEX/micro/lima_warm.f90 b/src/PHYEX/micro/lima_warm.f90
index 97ff7edb8ce5000ddb47d67efbcde89932c74a91..4f954463b5071171871a778652241b6c1bc44738 100644
--- a/src/PHYEX/micro/lima_warm.f90
+++ b/src/PHYEX/micro/lima_warm.f90
@@ -262,11 +262,11 @@ PCRT(:,:,:) = 0.
PCCS(:,:,:) = 0.
PCRS(:,:,:) = 0.
!
-IF ( LWARM ) PCCT(:,:,:) = PSVT(:,:,:,NSV_LIMA_NC)
-IF ( LWARM .AND. LRAIN ) PCRT(:,:,:) = PSVT(:,:,:,NSV_LIMA_NR)
+IF ( NMOM_C.GE.2 ) PCCT(:,:,:) = PSVT(:,:,:,NSV_LIMA_NC)
+IF ( NMOM_R.GE.2 ) PCRT(:,:,:) = PSVT(:,:,:,NSV_LIMA_NR)
!
-IF ( LWARM ) PCCS(:,:,:) = PSVS(:,:,:,NSV_LIMA_NC)
-IF ( LWARM .AND. LRAIN ) PCRS(:,:,:) = PSVS(:,:,:,NSV_LIMA_NR)
+IF ( NMOM_C.GE.2 ) PCCS(:,:,:) = PSVS(:,:,:,NSV_LIMA_NC)
+IF ( NMOM_R.GE.2 ) PCRS(:,:,:) = PSVS(:,:,:,NSV_LIMA_NR)
!
IF ( NMOD_CCN .GE. 1 ) THEN
ALLOCATE( ZNFS(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3),NMOD_CCN) )
@@ -311,10 +311,10 @@ ZT(:,:,:) = PTHT(:,:,:) * (PPABST(:,:,:)/XP00)**(XRD/XCPD)
!
!
if ( lbudget_rc .and. osedc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'SEDI', prcs(:, :, :) * prhodj(:, :, :) )
-if ( lbudget_rr .and. orain ) call Budget_store_init( tbudgets(NBUDGET_RR), 'SEDI', prrs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rr .and. nmom_r.ge.1 ) call Budget_store_init( tbudgets(NBUDGET_RR), 'SEDI', prrs(:, :, :) * prhodj(:, :, :) )
if ( lbudget_sv ) then
if ( osedc ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'SEDI', pccs(:, :, :) * prhodj(:, :, :) )
- if ( orain ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'SEDI', pcrs(:, :, :) * prhodj(:, :, :) )
+ if ( nmom_r.ge.2 ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'SEDI', pcrs(:, :, :) * prhodj(:, :, :) )
end if
CALL LIMA_WARM_SEDIMENTATION (OSEDC, KSPLITR, PTSTEP, KMI, &
@@ -326,10 +326,10 @@ CALL LIMA_WARM_SEDIMENTATION (OSEDC, KSPLITR, PTSTEP, KMI, &
PINPRR3D )
if ( lbudget_rc .and. osedc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'SEDI', prcs(:, :, :) * prhodj(:, :, :) )
-if ( lbudget_rr .and. orain ) call Budget_store_end( tbudgets(NBUDGET_RR), 'SEDI', prrs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rr .and. nmom_r.ge.1 ) call Budget_store_end( tbudgets(NBUDGET_RR), 'SEDI', prrs(:, :, :) * prhodj(:, :, :) )
if ( lbudget_sv ) then
if ( osedc ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'SEDI', pccs(:, :, :) * prhodj(:, :, :) )
- if ( orain ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'SEDI', pcrs(:, :, :) * prhodj(:, :, :) )
+ if ( nmom_r.ge.2 ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'SEDI', pcrs(:, :, :) * prhodj(:, :, :) )
end if
!
! 2.bis Deposition at 1st level above ground
@@ -411,7 +411,7 @@ END IF ! LACTI
! ------------------------
!
!
-IF (ORAIN) THEN
+IF (NMOM_R.GE.2) THEN
if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'REVA', pths(:, :, :) * prhodj(:, :, :) )
if ( lbudget_rv ) call Budget_store_init( tbudgets(NBUDGET_RV), 'REVA', prvs(:, :, :) * prhodj(:, :, :) )
@@ -466,8 +466,8 @@ IF ( KRR .GE. 3 ) PRS(:,:,:,3) = PRRS(:,:,:)
!
! Prepare 3D number concentrations
!
-IF ( LWARM ) PSVS(:,:,:,NSV_LIMA_NC) = PCCS(:,:,:)
-IF ( LWARM .AND. LRAIN ) PSVS(:,:,:,NSV_LIMA_NR) = PCRS(:,:,:)
+IF ( NMOM_C.GE.2 ) PSVS(:,:,:,NSV_LIMA_NC) = PCCS(:,:,:)
+IF ( NMOM_R.GE.2 ) PSVS(:,:,:,NSV_LIMA_NR) = PCRS(:,:,:)
!
IF ( NMOD_CCN .GE. 1 ) THEN
PSVS(:,:,:,NSV_LIMA_CCN_FREE:NSV_LIMA_CCN_FREE+NMOD_CCN-1) = ZNFS(:,:,:,:)
diff --git a/src/PHYEX/micro/lima_warm_coal.f90 b/src/PHYEX/micro/lima_warm_coal.f90
index 1c264a8fd844abd9c9e484ab25f60fdd5cbc938f..01d0bd60c6ecccca42efa09722ba36e0fda446f0 100644
--- a/src/PHYEX/micro/lima_warm_coal.f90
+++ b/src/PHYEX/micro/lima_warm_coal.f90
@@ -244,7 +244,7 @@ IF( IMICRO >= 0 ) THEN
!
!-------------------------------------------------------------------------------
!
-IF (LRAIN) THEN
+IF (NMOM_R.GE.2) THEN
!
!* 2. Self-collection of cloud droplets
! ------------------------------------
@@ -445,7 +445,7 @@ IF (LRAIN) THEN
if ( lbudget_sv ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'SCBU', &
Unpack( zcrs(:), mask = gmicro(:, :, :), field = pcrs(:, :, :) ) * prhodj(:, :, :) )
END IF
-END IF ! LRAIN
+END IF
!
!
!-------------------------------------------------------------------------------
diff --git a/src/PHYEX/micro/minpack.f90 b/src/PHYEX/micro/minpack.f90
new file mode 100644
index 0000000000000000000000000000000000000000..c927712e40538d3f25197984d88e40d459f953e7
--- /dev/null
+++ b/src/PHYEX/micro/minpack.f90
@@ -0,0 +1,5780 @@
+!!$ Minpack Copyright Notice (1999) University of Chicago. All rights reserved
+!!$
+!!$ Redistribution and use in source and binary forms, with or
+!!$ without modification, are permitted provided that the
+!!$ following conditions are met:
+!!$
+!!$ 1. Redistributions of source code must retain the above
+!!$ copyright notice, this list of conditions and the following
+!!$ disclaimer.
+!!$
+!!$ 2. Redistributions in binary form must reproduce the above
+!!$ copyright notice, this list of conditions and the following
+!!$ disclaimer in the documentation and/or other materials
+!!$ provided with the distribution.
+!!$
+!!$ 3. The end-user documentation included with the
+!!$ redistribution, if any, must include the following
+!!$ acknowledgment:
+!!$
+!!$ "This product includes software developed by the
+!!$ University of Chicago, as Operator of Argonne National
+!!$ Laboratory."
+!!$
+!!$ Alternately, this acknowledgment may appear in the software
+!!$ itself, if and wherever such third-party acknowledgments
+!!$ normally appear.
+!!$
+!!$ 4. WARRANTY DISCLAIMER. THE SOFTWARE IS SUPPLIED "AS IS"
+!!$ WITHOUT WARRANTY OF ANY KIND. THE COPYRIGHT HOLDER, THE
+!!$ UNITED STATES, THE UNITED STATES DEPARTMENT OF ENERGY, AND
+!!$ THEIR EMPLOYEES: (1) DISCLAIM ANY WARRANTIES, EXPRESS OR
+!!$ IMPLIED, INCLUDING BUT NOT LIMITED TO ANY IMPLIED WARRANTIES
+!!$ OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE, TITLE
+!!$ OR NON-INFRINGEMENT, (2) DO NOT ASSUME ANY LEGAL LIABILITY
+!!$ OR RESPONSIBILITY FOR THE ACCURACY, COMPLETENESS, OR
+!!$ USEFULNESS OF THE SOFTWARE, (3) DO NOT REPRESENT THAT USE OF
+!!$ THE SOFTWARE WOULD NOT INFRINGE PRIVATELY OWNED RIGHTS, (4)
+!!$ DO NOT WARRANT THAT THE SOFTWARE WILL FUNCTION
+!!$ UNINTERRUPTED, THAT IT IS ERROR-FREE OR THAT ANY ERRORS WILL
+!!$ BE CORRECTED.
+!!$
+!!$ 5. LIMITATION OF LIABILITY. IN NO EVENT WILL THE COPYRIGHT
+!!$ HOLDER, THE UNITED STATES, THE UNITED STATES DEPARTMENT OF
+!!$ ENERGY, OR THEIR EMPLOYEES: BE LIABLE FOR ANY INDIRECT,
+!!$ INCIDENTAL, CONSEQUENTIAL, SPECIAL OR PUNITIVE DAMAGES OF
+!!$ ANY KIND OR NATURE, INCLUDING BUT NOT LIMITED TO LOSS OF
+!!$ PROFITS OR LOSS OF DATA, FOR ANY REASON WHATSOEVER, WHETHER
+!!$ SUCH LIABILITY IS ASSERTED ON THE BASIS OF CONTRACT, TORT
+!!$ (INCLUDING NEGLIGENCE OR STRICT LIABILITY), OR OTHERWISE,
+!!$ EVEN IF ANY OF SAID PARTIES HAS BEEN WARNED OF THE
+!!$ POSSIBILITY OF SUCH LOSS OR DAMAGES.
+
+subroutine chkder ( m, n, x, fvec, fjac, ldfjac, xp, fvecp, mode, err )
+
+!*****************************************************************************80
+!
+!! CHKDER checks the gradients of M functions of N variables.
+!
+! Discussion:
+!
+! CHKDER checks the gradients of M nonlinear functions in N variables,
+! evaluated at a point X, for consistency with the functions themselves.
+!
+! The user calls CHKDER twice, first with MODE = 1 and then with MODE = 2.
+!
+! MODE = 1.
+! On input,
+! X contains the point of evaluation.
+! On output,
+! XP is set to a neighboring point.
+!
+! Now the user must evaluate the function and gradients at X, and the
+! function at XP. Then the subroutine is called again:
+!
+! MODE = 2.
+! On input,
+! FVEC contains the function values at X,
+! FJAC contains the function gradients at X.
+! FVECP contains the functions evaluated at XP.
+! On output,
+! ERR contains measures of correctness of the respective gradients.
+!
+! The subroutine does not perform reliably if cancellation or
+! rounding errors cause a severe loss of significance in the
+! evaluation of a function. Therefore, none of the components
+! of X should be unusually small (in particular, zero) or any
+! other value which may cause loss of significance.
+!
+! Licensing:
+!
+! This code is distributed under the GNU LGPL license.
+!
+! Modified:
+!
+! 06 April 2010
+!
+! Author:
+!
+! Original FORTRAN77 version by Jorge More, Burton Garbow, Kenneth Hillstrom.
+! FORTRAN90 version by John Burkardt.
+!
+! Reference:
+!
+! Jorge More, Burton Garbow, Kenneth Hillstrom,
+! User Guide for MINPACK-1,
+! Technical Report ANL-80-74,
+! Argonne National Laboratory, 1980.
+!
+! Parameters:
+!
+! Input, integer ( kind = 4 ) M, is the number of functions.
+!
+! Input, integer ( kind = 4 ) N, is the number of variables.
+!
+! Input, real ( kind = 8 ) X(N), the point at which the jacobian is to be
+! evaluated.
+!
+! Input, real ( kind = 8 ) FVEC(M), is used only when MODE = 2.
+! In that case, it should contain the function values at X.
+!
+! Input, real ( kind = 8 ) FJAC(LDFJAC,N), an M by N array. When MODE = 2,
+! FJAC(I,J) should contain the value of dF(I)/dX(J).
+!
+! Input, integer ( kind = 4 ) LDFJAC, the leading dimension of FJAC.
+! LDFJAC must be at least M.
+!
+! Output, real ( kind = 8 ) XP(N), on output with MODE = 1, is a neighboring
+! point of X, at which the function is to be evaluated.
+!
+! Input, real ( kind = 8 ) FVECP(M), on input with MODE = 2, is the function
+! value at XP.
+!
+! Input, integer ( kind = 4 ) MODE, should be set to 1 on the first call, and
+! 2 on the second.
+!
+! Output, real ( kind = 8 ) ERR(M). On output when MODE = 2, ERR contains
+! measures of correctness of the respective gradients. If there is no
+! severe loss of significance, then if ERR(I):
+! = 1.0D+00, the I-th gradient is correct,
+! = 0.0D+00, the I-th gradient is incorrect.
+! > 0.5D+00, the I-th gradient is probably correct.
+! < 0.5D+00, the I-th gradient is probably incorrect.
+!
+ implicit none
+
+ integer ( kind = 4 ) ldfjac
+ integer ( kind = 4 ) m
+ integer ( kind = 4 ) n
+
+ real ( kind = 8 ) eps
+ real ( kind = 8 ) epsf
+ real ( kind = 8 ) epslog
+ real ( kind = 8 ) epsmch
+ real ( kind = 8 ) err(m)
+ real ( kind = 8 ) fjac(ldfjac,n)
+ real ( kind = 8 ) fvec(m)
+ real ( kind = 8 ) fvecp(m)
+ integer ( kind = 4 ) i
+ integer ( kind = 4 ) j
+ integer ( kind = 4 ) mode
+ real ( kind = 8 ) temp
+ real ( kind = 8 ) x(n)
+ real ( kind = 8 ) xp(n)
+
+ epsmch = epsilon ( epsmch )
+ eps = sqrt ( epsmch )
+!
+! MODE = 1.
+!
+ if ( mode == 1 ) then
+
+ do j = 1, n
+ temp = eps * abs ( x(j) )
+ if ( temp == 0.0D+00 ) then
+ temp = eps
+ end if
+ xp(j) = x(j) + temp
+ end do
+!
+! MODE = 2.
+!
+ else if ( mode == 2 ) then
+
+ epsf = 100.0D+00 * epsmch
+ epslog = log10 ( eps )
+
+ err = 0.0D+00
+
+ do j = 1, n
+ temp = abs ( x(j) )
+ if ( temp == 0.0D+00 ) then
+ temp = 1.0D+00
+ end if
+ err(1:m) = err(1:m) + temp * fjac(1:m,j)
+ end do
+
+ do i = 1, m
+
+ temp = 1.0D+00
+
+ if ( fvec(i) /= 0.0D+00 .and. fvecp(i) /= 0.0D+00 .and. &
+ abs ( fvecp(i)-fvec(i)) >= epsf * abs ( fvec(i) ) ) then
+ temp = eps * abs ( (fvecp(i)-fvec(i)) / eps - err(i) ) &
+ / ( abs ( fvec(i) ) + abs ( fvecp(i) ) )
+ end if
+
+ err(i) = 1.0D+00
+
+ if ( epsmch < temp .and. temp < eps ) then
+ err(i) = ( log10 ( temp ) - epslog ) / epslog
+ end if
+
+ if ( eps <= temp ) then
+ err(i) = 0.0D+00
+ end if
+
+ end do
+
+ end if
+
+ return
+end
+subroutine dogleg ( n, r, lr, diag, qtb, delta, x )
+
+!*****************************************************************************80
+!
+!! DOGLEG finds the minimizing combination of Gauss-Newton and gradient steps.
+!
+! Discussion:
+!
+! Given an M by N matrix A, an N by N nonsingular diagonal
+! matrix D, an M-vector B, and a positive number DELTA, the
+! problem is to determine the convex combination X of the
+! Gauss-Newton and scaled gradient directions that minimizes
+! (A*X - B) in the least squares sense, subject to the
+! restriction that the euclidean norm of D*X be at most DELTA.
+!
+! This subroutine completes the solution of the problem
+! if it is provided with the necessary information from the
+! QR factorization of A. That is, if A = Q*R, where Q has
+! orthogonal columns and R is an upper triangular matrix,
+! then DOGLEG expects the full upper triangle of R and
+! the first N components of Q'*B.
+!
+! Licensing:
+!
+! This code is distributed under the GNU LGPL license.
+!
+! Modified:
+!
+! 06 April 2010
+!
+! Author:
+!
+! Original FORTRAN77 version by Jorge More, Burton Garbow, Kenneth Hillstrom.
+! FORTRAN90 version by John Burkardt.
+!
+! Reference:
+!
+! Jorge More, Burton Garbow, Kenneth Hillstrom,
+! User Guide for MINPACK-1,
+! Technical Report ANL-80-74,
+! Argonne National Laboratory, 1980.
+!
+! Parameters:
+!
+! Input, integer ( kind = 4 ) N, the order of the matrix R.
+!
+! Input, real ( kind = 8 ) R(LR), the upper triangular matrix R stored
+! by rows.
+!
+! Input, integer ( kind = 4 ) LR, the size of the R array, which must be
+! no less than (N*(N+1))/2.
+!
+! Input, real ( kind = 8 ) DIAG(N), the diagonal elements of the matrix D.
+!
+! Input, real ( kind = 8 ) QTB(N), the first N elements of the vector Q'* B.
+!
+! Input, real ( kind = 8 ) DELTA, is a positive upper bound on the
+! euclidean norm of D*X(1:N).
+!
+! Output, real ( kind = 8 ) X(N), the desired convex combination of the
+! Gauss-Newton direction and the scaled gradient direction.
+!
+ implicit none
+
+ integer ( kind = 4 ) lr
+ integer ( kind = 4 ) n
+
+ real ( kind = 8 ) alpha
+ real ( kind = 8 ) bnorm
+ real ( kind = 8 ) delta
+ real ( kind = 8 ) diag(n)
+ real ( kind = 8 ) enorm
+ real ( kind = 8 ) epsmch
+ real ( kind = 8 ) gnorm
+ integer ( kind = 4 ) i
+ integer ( kind = 4 ) j
+ integer ( kind = 4 ) jj
+ integer ( kind = 4 ) k
+ integer ( kind = 4 ) l
+ real ( kind = 8 ) qnorm
+ real ( kind = 8 ) qtb(n)
+ real ( kind = 8 ) r(lr)
+ real ( kind = 8 ) sgnorm
+ real ( kind = 8 ) sum2
+ real ( kind = 8 ) temp
+ real ( kind = 8 ) wa1(n)
+ real ( kind = 8 ) wa2(n)
+ real ( kind = 8 ) x(n)
+
+ epsmch = epsilon ( epsmch )
+!
+! Calculate the Gauss-Newton direction.
+!
+ jj = ( n * ( n + 1 ) ) / 2 + 1
+
+ do k = 1, n
+
+ j = n - k + 1
+ jj = jj - k
+ l = jj + 1
+ sum2 = 0.0D+00
+
+ do i = j + 1, n
+ sum2 = sum2 + r(l) * x(i)
+ l = l + 1
+ end do
+
+ temp = r(jj)
+
+ if ( temp == 0.0D+00 ) then
+
+ l = j
+ do i = 1, j
+ temp = max ( temp, abs ( r(l)) )
+ l = l + n - i
+ end do
+
+ if ( temp == 0.0D+00 ) then
+ temp = epsmch
+ else
+ temp = epsmch * temp
+ end if
+
+ end if
+
+ x(j) = ( qtb(j) - sum2 ) / temp
+
+ end do
+!
+! Test whether the Gauss-Newton direction is acceptable.
+!
+ wa1(1:n) = 0.0D+00
+ wa2(1:n) = diag(1:n) * x(1:n)
+ qnorm = enorm ( n, wa2 )
+
+ if ( qnorm <= delta ) then
+ return
+ end if
+!
+! The Gauss-Newton direction is not acceptable.
+! Calculate the scaled gradient direction.
+!
+ l = 1
+ do j = 1, n
+ temp = qtb(j)
+ do i = j, n
+ wa1(i) = wa1(i) + r(l) * temp
+ l = l + 1
+ end do
+ wa1(j) = wa1(j) / diag(j)
+ end do
+!
+! Calculate the norm of the scaled gradient.
+! Test for the special case in which the scaled gradient is zero.
+!
+ gnorm = enorm ( n, wa1 )
+ sgnorm = 0.0D+00
+ alpha = delta / qnorm
+
+ if ( gnorm /= 0.0D+00 ) then
+!
+! Calculate the point along the scaled gradient which minimizes the quadratic.
+!
+ wa1(1:n) = ( wa1(1:n) / gnorm ) / diag(1:n)
+
+ l = 1
+ do j = 1, n
+ sum2 = 0.0D+00
+ do i = j, n
+ sum2 = sum2 + r(l) * wa1(i)
+ l = l + 1
+ end do
+ wa2(j) = sum2
+ end do
+
+ temp = enorm ( n, wa2 )
+ sgnorm = ( gnorm / temp ) / temp
+!
+! Test whether the scaled gradient direction is acceptable.
+!
+ alpha = 0.0D+00
+!
+! The scaled gradient direction is not acceptable.
+! Calculate the point along the dogleg at which the quadratic is minimized.
+!
+ if ( sgnorm < delta ) then
+
+ bnorm = enorm ( n, qtb )
+ temp = ( bnorm / gnorm ) * ( bnorm / qnorm ) * ( sgnorm / delta )
+ temp = temp - ( delta / qnorm ) * ( sgnorm / delta) ** 2 &
+ + sqrt ( ( temp - ( delta / qnorm ) ) ** 2 &
+ + ( 1.0D+00 - ( delta / qnorm ) ** 2 ) &
+ * ( 1.0D+00 - ( sgnorm / delta ) ** 2 ) )
+
+ alpha = ( ( delta / qnorm ) * ( 1.0D+00 - ( sgnorm / delta ) ** 2 ) ) &
+ / temp
+
+ end if
+
+ end if
+!
+! Form appropriate convex combination of the Gauss-Newton
+! direction and the scaled gradient direction.
+!
+ temp = ( 1.0D+00 - alpha ) * min ( sgnorm, delta )
+
+ x(1:n) = temp * wa1(1:n) + alpha * x(1:n)
+
+ return
+end
+function enorm ( n, x )
+
+!*****************************************************************************80
+!
+!! ENORM computes the Euclidean norm of a vector.
+!
+! Discussion:
+!
+! This is an extremely simplified version of the original ENORM
+! routine, which has been renamed to "ENORM2".
+!
+! Licensing:
+!
+! This code is distributed under the GNU LGPL license.
+!
+! Modified:
+!
+! 06 April 2010
+!
+! Author:
+!
+! Original FORTRAN77 version by Jorge More, Burton Garbow, Kenneth Hillstrom.
+! FORTRAN90 version by John Burkardt.
+!
+! Reference:
+!
+! Jorge More, Burton Garbow, Kenneth Hillstrom,
+! User Guide for MINPACK-1,
+! Technical Report ANL-80-74,
+! Argonne National Laboratory, 1980.
+!
+! Parameters:
+!
+! Input, integer ( kind = 4 ) N, is the length of the vector.
+!
+! Input, real ( kind = 8 ) X(N), the vector whose norm is desired.
+!
+! Output, real ( kind = 8 ) ENORM, the Euclidean norm of the vector.
+!
+ implicit none
+
+ integer ( kind = 4 ) n
+ real ( kind = 8 ) x(n)
+ real ( kind = 8 ) enorm
+
+ enorm = sqrt ( sum ( x(1:n) ** 2 ))
+
+ return
+end
+function enorm2 ( n, x )
+
+!*****************************************************************************80
+!
+!! ENORM2 computes the Euclidean norm of a vector.
+!
+! Discussion:
+!
+! This routine was named ENORM. It has been renamed "ENORM2",
+! and a simplified routine has been substituted.
+!
+! The Euclidean norm is computed by accumulating the sum of
+! squares in three different sums. The sums of squares for the
+! small and large components are scaled so that no overflows
+! occur. Non-destructive underflows are permitted. Underflows
+! and overflows do not occur in the computation of the unscaled
+! sum of squares for the intermediate components.
+!
+! The definitions of small, intermediate and large components
+! depend on two constants, RDWARF and RGIANT. The main
+! restrictions on these constants are that RDWARF^2 not
+! underflow and RGIANT^2 not overflow.
+!
+! Licensing:
+!
+! This code is distributed under the GNU LGPL license.
+!
+! Modified:
+!
+! 06 April 2010
+!
+! Author:
+!
+! Original FORTRAN77 version by Jorge More, Burton Garbow, Kenneth Hillstrom.
+! FORTRAN90 version by John Burkardt.
+!
+! Reference:
+!
+! Jorge More, Burton Garbow, Kenneth Hillstrom,
+! User Guide for MINPACK-1
+! Argonne National Laboratory,
+! Argonne, Illinois.
+!
+! Parameters:
+!
+! Input, integer ( kind = 4 ) N, is the length of the vector.
+!
+! Input, real ( kind = 8 ) X(N), the vector whose norm is desired.
+!
+! Output, real ( kind = 8 ) ENORM2, the Euclidean norm of the vector.
+!
+ implicit none
+
+ integer ( kind = 4 ) n
+
+ real ( kind = 8 ) agiant
+ real ( kind = 8 ) enorm2
+ integer ( kind = 4 ) i
+ real ( kind = 8 ) rdwarf
+ real ( kind = 8 ) rgiant
+ real ( kind = 8 ) s1
+ real ( kind = 8 ) s2
+ real ( kind = 8 ) s3
+ real ( kind = 8 ) x(n)
+ real ( kind = 8 ) xabs
+ real ( kind = 8 ) x1max
+ real ( kind = 8 ) x3max
+
+ rdwarf = sqrt ( tiny ( rdwarf ) )
+ rgiant = sqrt ( huge ( rgiant ) )
+
+ s1 = 0.0D+00
+ s2 = 0.0D+00
+ s3 = 0.0D+00
+ x1max = 0.0D+00
+ x3max = 0.0D+00
+ agiant = rgiant / real ( n, kind = 8 )
+
+ do i = 1, n
+
+ xabs = abs ( x(i) )
+
+ if ( xabs <= rdwarf ) then
+
+ if ( x3max < xabs ) then
+ s3 = 1.0D+00 + s3 * ( x3max / xabs ) ** 2
+ x3max = xabs
+ else if ( xabs /= 0.0D+00 ) then
+ s3 = s3 + ( xabs / x3max ) ** 2
+ end if
+
+ else if ( agiant <= xabs ) then
+
+ if ( x1max < xabs ) then
+ s1 = 1.0D+00 + s1 * ( x1max / xabs ) ** 2
+ x1max = xabs
+ else
+ s1 = s1 + ( xabs / x1max ) ** 2
+ end if
+
+ else
+
+ s2 = s2 + xabs ** 2
+
+ end if
+
+ end do
+!
+! Calculation of norm.
+!
+ if ( s1 /= 0.0D+00 ) then
+
+ enorm2 = x1max * sqrt ( s1 + ( s2 / x1max ) / x1max )
+
+ else if ( s2 /= 0.0D+00 ) then
+
+ if ( x3max <= s2 ) then
+ enorm2 = sqrt ( s2 * ( 1.0D+00 + ( x3max / s2 ) * ( x3max * s3 ) ) )
+ else
+ enorm2 = sqrt ( x3max * ( ( s2 / x3max ) + ( x3max * s3 ) ) )
+ end if
+
+ else
+
+ enorm2 = x3max * sqrt ( s3 )
+
+ end if
+
+ return
+end
+subroutine fdjac1 ( fcn, n, x, fvec, fjac, ldfjac, iflag, ml, mu, epsfcn )
+
+!*****************************************************************************80
+!
+!! FDJAC1 estimates an N by N jacobian matrix using forward differences.
+!
+! Discussion:
+!
+! This subroutine computes a forward-difference approximation
+! to the N by N jacobian matrix associated with a specified
+! problem of N functions in N variables. If the jacobian has
+! a banded form, then function evaluations are saved by only
+! approximating the nonzero terms.
+!
+! Licensing:
+!
+! This code is distributed under the GNU LGPL license.
+!
+! Modified:
+!
+! 06 April 2010
+!
+! Author:
+!
+! Original FORTRAN77 version by Jorge More, Burton Garbow, Kenneth Hillstrom.
+! FORTRAN90 version by John Burkardt.
+!
+! Reference:
+!
+! Jorge More, Burton Garbow, Kenneth Hillstrom,
+! User Guide for MINPACK-1,
+! Technical Report ANL-80-74,
+! Argonne National Laboratory, 1980.
+!
+! Parameters:
+!
+! Input, external FCN, the name of the user-supplied subroutine which
+! calculates the functions. The routine should have the form:
+! subroutine fcn ( n, x, fvec, iflag )
+! integer ( kind = 4 ) n
+! real ( kind = 8 ) fvec(n)
+! integer ( kind = 4 ) iflag
+! real ( kind = 8 ) x(n)
+! If IFLAG = 0 on input, then FCN is only being called to allow the user
+! to print out the current iterate.
+! If IFLAG = 1 on input, FCN should calculate the functions at X and
+! return this vector in FVEC.
+! To terminate the algorithm, FCN may set IFLAG negative on return.
+!
+! Input, integer ( kind = 4 ) N, the number of functions and variables.
+!
+! Input, real ( kind = 8 ) X(N), the point where the jacobian is evaluated.
+!
+! Input, real ( kind = 8 ) FVEC(N), the functions evaluated at X.
+!
+! Output, real ( kind = 8 ) FJAC(LDFJAC,N), the N by N approximate
+! jacobian matrix.
+!
+! Input, integer ( kind = 4 ) LDFJAC, the leading dimension of FJAC, which
+! must not be less than N.
+!
+! Output, integer ( kind = 4 ) IFLAG, is an error flag returned by FCN.
+! If FCN returns a nonzero value of IFLAG, then this routine returns
+! immediately to the calling program, with the value of IFLAG.
+!
+! Input, integer ( kind = 4 ) ML, MU, specify the number of subdiagonals and
+! superdiagonals within the band of the jacobian matrix. If the
+! jacobian is not banded, set ML and MU to N-1.
+!
+! Input, real ( kind = 8 ) EPSFCN, is used in determining a suitable step
+! length for the forward-difference approximation. This approximation
+! assumes that the relative errors in the functions are of the order of
+! EPSFCN. If EPSFCN is less than the machine precision, it is assumed that
+! the relative errors in the functions are of the order of the machine
+! precision.
+!
+ implicit none
+
+ integer ( kind = 4 ) ldfjac
+ integer ( kind = 4 ) n
+
+ real ( kind = 8 ) eps
+ real ( kind = 8 ) epsfcn
+ real ( kind = 8 ) epsmch
+ external fcn
+ real ( kind = 8 ) fjac(ldfjac,n)
+ real ( kind = 8 ) fvec(n)
+ real ( kind = 8 ) h
+ integer ( kind = 4 ) i
+ integer ( kind = 4 ) iflag
+ integer ( kind = 4 ) j
+ integer ( kind = 4 ) k
+ integer ( kind = 4 ) ml
+ integer ( kind = 4 ) msum
+ integer ( kind = 4 ) mu
+ real ( kind = 8 ) temp
+ real ( kind = 8 ) wa1(n)
+ real ( kind = 8 ) wa2(n)
+ real ( kind = 8 ) x(n)
+
+ epsmch = epsilon ( epsmch )
+
+ eps = sqrt ( max ( epsfcn, epsmch ) )
+ msum = ml + mu + 1
+!
+! Computation of dense approximate jacobian.
+!
+ if ( n <= msum ) then
+
+ do j = 1, n
+
+ temp = x(j)
+ h = eps * abs ( temp )
+ if ( h == 0.0D+00 ) then
+ h = eps
+ end if
+
+ iflag = 1
+ x(j) = temp + h
+ call fcn ( n, x, wa1, iflag )
+
+ if ( iflag < 0 ) then
+ exit
+ end if
+
+ x(j) = temp
+ fjac(1:n,j) = ( wa1(1:n) - fvec(1:n) ) / h
+
+ end do
+
+ else
+!
+! Computation of banded approximate jacobian.
+!
+ do k = 1, msum
+
+ do j = k, n, msum
+ wa2(j) = x(j)
+ h = eps * abs ( wa2(j) )
+ if ( h == 0.0D+00 ) then
+ h = eps
+ end if
+ x(j) = wa2(j) + h
+ end do
+
+ iflag = 1
+ call fcn ( n, x, wa1, iflag )
+
+ if ( iflag < 0 ) then
+ exit
+ end if
+
+ do j = k, n, msum
+
+ x(j) = wa2(j)
+
+ h = eps * abs ( wa2(j) )
+ if ( h == 0.0D+00 ) then
+ h = eps
+ end if
+
+ fjac(1:n,j) = 0.0D+00
+
+ do i = 1, n
+ if ( j - mu <= i .and. i <= j + ml ) then
+ fjac(i,j) = ( wa1(i) - fvec(i) ) / h
+ end if
+ end do
+
+ end do
+
+ end do
+
+ end if
+
+ return
+end
+subroutine fdjac2 ( fcn, m, n, x, fvec, fjac, ldfjac, iflag, epsfcn )
+
+!*****************************************************************************80
+!
+!! FDJAC2 estimates an M by N jacobian matrix using forward differences.
+!
+! Discussion:
+!
+! This subroutine computes a forward-difference approximation
+! to the M by N jacobian matrix associated with a specified
+! problem of M functions in N variables.
+!
+! Licensing:
+!
+! This code is distributed under the GNU LGPL license.
+!
+! Modified:
+!
+! 06 April 2010
+!
+! Author:
+!
+! Original FORTRAN77 version by Jorge More, Burton Garbow, Kenneth Hillstrom.
+! FORTRAN90 version by John Burkardt.
+!
+! Reference:
+!
+! Jorge More, Burton Garbow, Kenneth Hillstrom,
+! User Guide for MINPACK-1,
+! Technical Report ANL-80-74,
+! Argonne National Laboratory, 1980.
+!
+! Parameters:
+!
+! Input, external FCN, the name of the user-supplied subroutine which
+! calculates the functions. The routine should have the form:
+! subroutine fcn ( m, n, x, fvec, iflag )
+! integer ( kind = 4 ) n
+! real ( kind = 8 ) fvec(m)
+! integer ( kind = 4 ) iflag
+! real ( kind = 8 ) x(n)
+!
+! If IFLAG = 0 on input, then FCN is only being called to allow the user
+! to print out the current iterate.
+! If IFLAG = 1 on input, FCN should calculate the functions at X and
+! return this vector in FVEC.
+! To terminate the algorithm, FCN may set IFLAG negative on return.
+!
+! Input, integer ( kind = 4 ) M, is the number of functions.
+!
+! Input, integer ( kind = 4 ) N, is the number of variables.
+! N must not exceed M.
+!
+! Input, real ( kind = 8 ) X(N), the point where the jacobian is evaluated.
+!
+! Input, real ( kind = 8 ) FVEC(M), the functions evaluated at X.
+!
+! Output, real ( kind = 8 ) FJAC(LDFJAC,N), the M by N approximate
+! jacobian matrix.
+!
+! Input, integer ( kind = 4 ) LDFJAC, the leading dimension of FJAC,
+! which must not be less than M.
+!
+! Output, integer ( kind = 4 ) IFLAG, is an error flag returned by FCN.
+! If FCN returns a nonzero value of IFLAG, then this routine returns
+! immediately to the calling program, with the value of IFLAG.
+!
+! Input, real ( kind = 8 ) EPSFCN, is used in determining a suitable
+! step length for the forward-difference approximation. This approximation
+! assumes that the relative errors in the functions are of the order of
+! EPSFCN. If EPSFCN is less than the machine precision, it is assumed that
+! the relative errors in the functions are of the order of the machine
+! precision.
+!
+ implicit none
+
+ integer ( kind = 4 ) ldfjac
+ integer ( kind = 4 ) m
+ integer ( kind = 4 ) n
+
+ real ( kind = 8 ) eps
+ real ( kind = 8 ) epsfcn
+ real ( kind = 8 ) epsmch
+ external fcn
+ real ( kind = 8 ) fjac(ldfjac,n)
+ real ( kind = 8 ) fvec(m)
+ real ( kind = 8 ) h
+ integer ( kind = 4 ) i
+ integer ( kind = 4 ) iflag
+ integer ( kind = 4 ) j
+ real ( kind = 8 ) temp
+ real ( kind = 8 ) wa(m)
+ real ( kind = 8 ) x(n)
+
+ epsmch = epsilon ( epsmch )
+
+ eps = sqrt ( max ( epsfcn, epsmch ) )
+
+ do j = 1, n
+
+ temp = x(j)
+ h = eps * abs ( temp )
+ if ( h == 0.0D+00 ) then
+ h = eps
+ end if
+
+ iflag = 1
+ x(j) = temp + h
+ call fcn ( m, n, x, wa, iflag )
+
+ if ( iflag < 0 ) then
+ exit
+ end if
+
+ x(j) = temp
+ fjac(1:m,j) = ( wa(1:m) - fvec(1:m) ) / h
+
+ end do
+
+ return
+end
+subroutine hybrd ( fcn, n, x, fvec, xtol, maxfev, ml, mu, epsfcn, diag, mode, &
+ factor, nprint, info, nfev, fjac, ldfjac, r, lr, qtf )
+
+!*****************************************************************************80
+!
+!! HYBRD seeks a zero of N nonlinear equations in N variables.
+!
+! Discussion:
+!
+! HYBRD finds a zero of a system of N nonlinear functions in N variables
+! by a modification of the Powell hybrid method. The user must provide a
+! subroutine which calculates the functions. The jacobian is
+! then calculated by a forward-difference approximation.
+!
+! Licensing:
+!
+! This code is distributed under the GNU LGPL license.
+!
+! Modified:
+!
+! 06 April 2010
+!
+! Author:
+!
+! Original FORTRAN77 version by Jorge More, Burton Garbow, Kenneth Hillstrom.
+! FORTRAN90 version by John Burkardt.
+!
+! Reference:
+!
+! Jorge More, Burton Garbow, Kenneth Hillstrom,
+! User Guide for MINPACK-1,
+! Technical Report ANL-80-74,
+! Argonne National Laboratory, 1980.
+!
+! Parameters:
+!
+! Input, external FCN, the name of the user-supplied subroutine which
+! calculates the functions. The routine should have the form:
+! subroutine fcn ( n, x, fvec, iflag )
+! integer ( kind = 4 ) n
+! real ( kind = 8 ) fvec(n)
+! integer ( kind = 4 ) iflag
+! real ( kind = 8 ) x(n)
+!
+! If IFLAG = 0 on input, then FCN is only being called to allow the user
+! to print out the current iterate.
+! If IFLAG = 1 on input, FCN should calculate the functions at X and
+! return this vector in FVEC.
+! To terminate the algorithm, FCN may set IFLAG negative on return.
+!
+! Input, integer ( kind = 4 ) N, the number of functions and variables.
+!
+! Input/output, real ( kind = 8 ) X(N). On input, X must contain an initial
+! estimate of the solution vector. On output X contains the final
+! estimate of the solution vector.
+!
+! Output, real ( kind = 8 ) FVEC(N), the functions evaluated at the output X.
+!
+! Input, real ( kind = 8 ) XTOL. Termination occurs when the relative error
+! between two consecutive iterates is at most XTOL. XTOL should be
+! nonnegative.
+!
+! Input, integer ( kind = 4 ) MAXFEV. Termination occurs when the number of
+! calls to FCN is at least MAXFEV by the end of an iteration.
+!
+! Input, integer ( kind = 4 ) ML, MU, specify the number of subdiagonals and
+! superdiagonals within the band of the jacobian matrix. If the jacobian
+! is not banded, set ML and MU to at least n - 1.
+!
+! Input, real ( kind = 8 ) EPSFCN, is used in determining a suitable step
+! length for the forward-difference approximation. This approximation
+! assumes that the relative errors in the functions are of the order of
+! EPSFCN. If EPSFCN is less than the machine precision, it is assumed that
+! the relative errors in the functions are of the order of the machine
+! precision.
+!
+! Input/output, real ( kind = 8 ) DIAG(N). If MODE = 1, then DIAG is set
+! internally. If MODE = 2, then DIAG must contain positive entries that
+! serve as multiplicative scale factors for the variables.
+!
+! Input, integer ( kind = 4 ) MODE, scaling option.
+! 1, variables will be scaled internally.
+! 2, scaling is specified by the input DIAG vector.
+!
+! Input, real ( kind = 8 ) FACTOR, determines the initial step bound. This
+! bound is set to the product of FACTOR and the euclidean norm of DIAG*X if
+! nonzero, or else to FACTOR itself. In most cases, FACTOR should lie
+! in the interval (0.1, 100) with 100 the recommended value.
+!
+! Input, integer ( kind = 4 ) NPRINT, enables controlled printing of
+! iterates if it is positive. In this case, FCN is called with IFLAG = 0 at
+! the beginning of the first iteration and every NPRINT iterations thereafter
+! and immediately prior to return, with X and FVEC available
+! for printing. If NPRINT is not positive, no special calls
+! of FCN with IFLAG = 0 are made.
+!
+! Output, integer ( kind = 4 ) INFO, error flag. If the user has terminated
+! execution, INFO is set to the (negative) value of IFLAG.
+! See the description of FCN.
+! Otherwise, INFO is set as follows:
+! 0, improper input parameters.
+! 1, relative error between two consecutive iterates is at most XTOL.
+! 2, number of calls to FCN has reached or exceeded MAXFEV.
+! 3, XTOL is too small. No further improvement in the approximate
+! solution X is possible.
+! 4, iteration is not making good progress, as measured by the improvement
+! from the last five jacobian evaluations.
+! 5, iteration is not making good progress, as measured by the improvement
+! from the last ten iterations.
+!
+! Output, integer ( kind = 4 ) NFEV, the number of calls to FCN.
+!
+! Output, real ( kind = 8 ) FJAC(LDFJAC,N), an N by N array which contains
+! the orthogonal matrix Q produced by the QR factorization of the final
+! approximate jacobian.
+!
+! Input, integer ( kind = 4 ) LDFJAC, the leading dimension of FJAC.
+! LDFJAC must be at least N.
+!
+! Output, real ( kind = 8 ) R(LR), the upper triangular matrix produced by
+! the QR factorization of the final approximate jacobian, stored rowwise.
+!
+! Input, integer ( kind = 4 ) LR, the size of the R array, which must be no
+! less than (N*(N+1))/2.
+!
+! Output, real ( kind = 8 ) QTF(N), contains the vector Q'*FVEC.
+!
+ implicit none
+
+ integer ( kind = 4 ) ldfjac
+ integer ( kind = 4 ) lr
+ integer ( kind = 4 ) n
+
+ real ( kind = 8 ) actred
+ real ( kind = 8 ) delta
+ real ( kind = 8 ) diag(n)
+ real ( kind = 8 ) enorm
+ real ( kind = 8 ) epsfcn
+ real ( kind = 8 ) epsmch
+ real ( kind = 8 ) factor
+ external fcn
+ real ( kind = 8 ) fjac(ldfjac,n)
+ real ( kind = 8 ) fnorm
+ real ( kind = 8 ) fnorm1
+ real ( kind = 8 ) fvec(n)
+ integer ( kind = 4 ) i
+ integer ( kind = 4 ) iflag
+ integer ( kind = 4 ) info
+ integer ( kind = 4 ) iter
+ integer ( kind = 4 ) iwa(1)
+ integer ( kind = 4 ) j
+ logical jeval
+ integer ( kind = 4 ) l
+ integer ( kind = 4 ) maxfev
+ integer ( kind = 4 ) ml
+ integer ( kind = 4 ) mode
+ integer ( kind = 4 ) msum
+ integer ( kind = 4 ) mu
+ integer ( kind = 4 ) ncfail
+ integer ( kind = 4 ) nslow1
+ integer ( kind = 4 ) nslow2
+ integer ( kind = 4 ) ncsuc
+ integer ( kind = 4 ) nfev
+ integer ( kind = 4 ) nprint
+ logical pivot
+ real ( kind = 8 ) pnorm
+ real ( kind = 8 ) prered
+ real ( kind = 8 ) qtf(n)
+ real ( kind = 8 ) r(lr)
+ real ( kind = 8 ) ratio
+ logical sing
+ real ( kind = 8 ) sum2
+ real ( kind = 8 ) temp
+ real ( kind = 8 ) wa1(n)
+ real ( kind = 8 ) wa2(n)
+ real ( kind = 8 ) wa3(n)
+ real ( kind = 8 ) wa4(n)
+ real ( kind = 8 ) x(n)
+ real ( kind = 8 ) xnorm
+ real ( kind = 8 ) xtol
+
+ epsmch = epsilon ( epsmch )
+
+ info = 0
+ iflag = 0
+ nfev = 0
+!
+! Check the input parameters for errors.
+!
+ if ( n <= 0 ) then
+ return
+ else if ( xtol < 0.0D+00 ) then
+ return
+ else if ( maxfev <= 0 ) then
+ return
+ else if ( ml < 0 ) then
+ return
+ else if ( mu < 0 ) then
+ return
+ else if ( factor <= 0.0D+00 ) then
+ return
+ else if ( ldfjac < n ) then
+ return
+ else if ( lr < ( n * ( n + 1 ) ) / 2 ) then
+ return
+ end if
+
+ if ( mode == 2 ) then
+
+ do j = 1, n
+ if ( diag(j) <= 0.0D+00 ) then
+ go to 300
+ end if
+ end do
+
+ end if
+!
+! Evaluate the function at the starting point
+! and calculate its norm.
+!
+ iflag = 1
+ call fcn ( n, x, fvec, iflag )
+ nfev = 1
+
+ if ( iflag < 0 ) then
+ go to 300
+ end if
+
+ fnorm = enorm ( n, fvec )
+!
+! Determine the number of calls to FCN needed to compute the jacobian matrix.
+!
+ msum = min ( ml + mu + 1, n )
+!
+! Initialize iteration counter and monitors.
+!
+ iter = 1
+ ncsuc = 0
+ ncfail = 0
+ nslow1 = 0
+ nslow2 = 0
+!
+! Beginning of the outer loop.
+!
+30 continue
+
+ jeval = .true.
+!
+! Calculate the jacobian matrix.
+!
+ iflag = 2
+ call fdjac1 ( fcn, n, x, fvec, fjac, ldfjac, iflag, ml, mu, epsfcn )
+
+ nfev = nfev + msum
+
+ if ( iflag < 0 ) then
+ go to 300
+ end if
+!
+! Compute the QR factorization of the jacobian.
+!
+ pivot = .false.
+ call qrfac ( n, n, fjac, ldfjac, pivot, iwa, 1, wa1, wa2 )
+!
+! On the first iteration, if MODE is 1, scale according
+! to the norms of the columns of the initial jacobian.
+!
+ if ( iter == 1 ) then
+
+ if ( mode /= 2 ) then
+
+ diag(1:n) = wa2(1:n)
+ do j = 1, n
+ if ( wa2(j) == 0.0D+00 ) then
+ diag(j) = 1.0D+00
+ end if
+ end do
+
+ end if
+!
+! On the first iteration, calculate the norm of the scaled X
+! and initialize the step bound DELTA.
+!
+ wa3(1:n) = diag(1:n) * x(1:n)
+ xnorm = enorm ( n, wa3 )
+ delta = factor * xnorm
+ if ( delta == 0.0D+00 ) then
+ delta = factor
+ end if
+
+ end if
+!
+! Form Q' * FVEC and store in QTF.
+!
+ qtf(1:n) = fvec(1:n)
+
+ do j = 1, n
+
+ if ( fjac(j,j) /= 0.0D+00 ) then
+ temp = - dot_product ( qtf(j:n), fjac(j:n,j) ) / fjac(j,j)
+ qtf(j:n) = qtf(j:n) + fjac(j:n,j) * temp
+ end if
+
+ end do
+!
+! Copy the triangular factor of the QR factorization into R.
+!
+ sing = .false.
+
+ do j = 1, n
+ l = j
+ do i = 1, j - 1
+ r(l) = fjac(i,j)
+ l = l + n - i
+ end do
+ r(l) = wa1(j)
+ if ( wa1(j) == 0.0D+00 ) then
+ sing = .true.
+ end if
+ end do
+!
+! Accumulate the orthogonal factor in FJAC.
+!
+ call qform ( n, n, fjac, ldfjac )
+!
+! Rescale if necessary.
+!
+ if ( mode /= 2 ) then
+ do j = 1, n
+ diag(j) = max ( diag(j), wa2(j) )
+ end do
+ end if
+!
+! Beginning of the inner loop.
+!
+180 continue
+!
+! If requested, call FCN to enable printing of iterates.
+!
+ if ( 0 < nprint ) then
+ iflag = 0
+ if ( mod ( iter - 1, nprint ) == 0 ) then
+ call fcn ( n, x, fvec, iflag )
+ end if
+ if ( iflag < 0 ) then
+ go to 300
+ end if
+ end if
+!
+! Determine the direction P.
+!
+ call dogleg ( n, r, lr, diag, qtf, delta, wa1 )
+!
+! Store the direction P and X + P.
+! Calculate the norm of P.
+!
+ wa1(1:n) = - wa1(1:n)
+ wa2(1:n) = x(1:n) + wa1(1:n)
+ wa3(1:n) = diag(1:n) * wa1(1:n)
+
+ pnorm = enorm ( n, wa3 )
+!
+! On the first iteration, adjust the initial step bound.
+!
+ if ( iter == 1 ) then
+ delta = min ( delta, pnorm )
+ end if
+!
+! Evaluate the function at X + P and calculate its norm.
+!
+ iflag = 1
+ call fcn ( n, wa2, wa4, iflag )
+ nfev = nfev + 1
+
+ if ( iflag < 0 ) then
+ go to 300
+ end if
+
+ fnorm1 = enorm ( n, wa4 )
+!
+! Compute the scaled actual reduction.
+!
+ actred = -1.0D+00
+ if ( fnorm1 < fnorm ) then
+ actred = 1.0D+00 - ( fnorm1 / fnorm ) ** 2
+ endif
+!
+! Compute the scaled predicted reduction.
+!
+ l = 1
+ do i = 1, n
+ sum2 = 0.0D+00
+ do j = i, n
+ sum2 = sum2 + r(l) * wa1(j)
+ l = l + 1
+ end do
+ wa3(i) = qtf(i) + sum2
+ end do
+
+ temp = enorm ( n, wa3 )
+ prered = 0.0D+00
+ if ( temp < fnorm ) then
+ prered = 1.0D+00 - ( temp / fnorm ) ** 2
+ end if
+!
+! Compute the ratio of the actual to the predicted reduction.
+!
+ ratio = 0.0D+00
+ if ( 0.0D+00 < prered ) then
+ ratio = actred / prered
+ end if
+!
+! Update the step bound.
+!
+ if ( ratio < 0.1D+00 ) then
+
+ ncsuc = 0
+ ncfail = ncfail + 1
+ delta = 0.5D+00 * delta
+
+ else
+
+ ncfail = 0
+ ncsuc = ncsuc + 1
+
+ if ( 0.5D+00 <= ratio .or. 1 < ncsuc ) then
+ delta = max ( delta, pnorm / 0.5D+00 )
+ end if
+
+ if ( abs ( ratio - 1.0D+00 ) <= 0.1D+00 ) then
+ delta = pnorm / 0.5D+00
+ end if
+
+ end if
+!
+! Test for successful iteration.
+!
+! Successful iteration.
+! Update X, FVEC, and their norms.
+!
+ if ( 0.0001D+00 <= ratio ) then
+ x(1:n) = wa2(1:n)
+ wa2(1:n) = diag(1:n) * x(1:n)
+ fvec(1:n) = wa4(1:n)
+ xnorm = enorm ( n, wa2 )
+ fnorm = fnorm1
+ iter = iter + 1
+ end if
+!
+! Determine the progress of the iteration.
+!
+ nslow1 = nslow1 + 1
+ if ( 0.001D+00 <= actred ) then
+ nslow1 = 0
+ end if
+
+ if ( jeval ) then
+ nslow2 = nslow2 + 1
+ end if
+
+ if ( 0.1D+00 <= actred ) then
+ nslow2 = 0
+ end if
+!
+! Test for convergence.
+!
+ if ( delta <= xtol * xnorm .or. fnorm == 0.0D+00 ) then
+ info = 1
+ end if
+
+ if ( info /= 0 ) then
+ go to 300
+ end if
+!
+! Tests for termination and stringent tolerances.
+!
+ if ( maxfev <= nfev ) then
+ info = 2
+ end if
+
+ if ( 0.1D+00 * max ( 0.1D+00 * delta, pnorm ) <= epsmch * xnorm ) then
+ info = 3
+ end if
+
+ if ( nslow2 == 5 ) then
+ info = 4
+ end if
+
+ if ( nslow1 == 10 ) then
+ info = 5
+ end if
+
+ if ( info /= 0 ) then
+ go to 300
+ end if
+!
+! Criterion for recalculating jacobian approximation
+! by forward differences.
+!
+ if ( ncfail == 2 ) then
+ go to 290
+ end if
+!
+! Calculate the rank one modification to the jacobian
+! and update QTF if necessary.
+!
+ do j = 1, n
+ sum2 = dot_product ( wa4(1:n), fjac(1:n,j) )
+ wa2(j) = ( sum2 - wa3(j) ) / pnorm
+ wa1(j) = diag(j) * ( ( diag(j) * wa1(j) ) / pnorm )
+ if ( 0.0001D+00 <= ratio ) then
+ qtf(j) = sum2
+ end if
+ end do
+!
+! Compute the QR factorization of the updated jacobian.
+!
+ call r1updt ( n, n, r, lr, wa1, wa2, wa3, sing )
+ call r1mpyq ( n, n, fjac, ldfjac, wa2, wa3 )
+ call r1mpyq ( 1, n, qtf, 1, wa2, wa3 )
+!
+! End of the inner loop.
+!
+ jeval = .false.
+ go to 180
+
+ 290 continue
+!
+! End of the outer loop.
+!
+ go to 30
+
+ 300 continue
+!
+! Termination, either normal or user imposed.
+!
+ if ( iflag < 0 ) then
+ info = iflag
+ end if
+
+ iflag = 0
+
+ if ( 0 < nprint ) then
+ call fcn ( n, x, fvec, iflag )
+ end if
+
+ return
+end
+subroutine hybrd1 ( fcn, n, x, fvec, tol, info )
+
+!*****************************************************************************80
+!
+!! HYBRD1 seeks a zero of N nonlinear equations in N variables.
+!
+! Discussion:
+!
+! HYBRD1 finds a zero of a system of N nonlinear functions in N variables
+! by a modification of the Powell hybrid method. This is done by using the
+! more general nonlinear equation solver HYBRD. The user must provide a
+! subroutine which calculates the functions. The jacobian is then
+! calculated by a forward-difference approximation.
+!
+! Licensing:
+!
+! This code is distributed under the GNU LGPL license.
+!
+! Modified:
+!
+! 19 August 2016
+!
+! Author:
+!
+! Original FORTRAN77 version by Jorge More, Burton Garbow, Kenneth Hillstrom.
+! FORTRAN90 version by John Burkardt.
+!
+! Reference:
+!
+! Jorge More, Burton Garbow, Kenneth Hillstrom,
+! User Guide for MINPACK-1,
+! Technical Report ANL-80-74,
+! Argonne National Laboratory, 1980.
+!
+! Parameters:
+!
+! Input, external FCN, the name of the user-supplied subroutine which
+! calculates the functions. The routine should have the form:
+! subroutine fcn ( n, x, fvec, iflag )
+! integer ( kind = 4 ) n
+! real ( kind = 8 ) fvec(n)
+! integer ( kind = 4 ) iflag
+! real ( kind = 8 ) x(n)
+! If IFLAG = 0 on input, then FCN is only being called to allow the user
+! to print out the current iterate.
+! If IFLAG = 1 on input, FCN should calculate the functions at X and
+! return this vector in FVEC.
+! To terminate the algorithm, FCN may set IFLAG negative on return.
+!
+! Input, integer ( kind = 4 ) N, the number of functions and variables.
+!
+! Input/output, real ( kind = 8 ) X(N). On input, X must contain an initial
+! estimate of the solution vector. On output X contains the final
+! estimate of the solution vector.
+!
+! Output, real ( kind = 8 ) FVEC(N), the functions evaluated at the output X.
+!
+! Input, real ( kind = 8 ) TOL. Termination occurs when the algorithm
+! estimates that the relative error between X and the solution is at
+! most TOL. TOL should be nonnegative.
+!
+! Output, integer ( kind = 4 ) INFO, error flag. If the user has terminated
+! execution, INFO is set to the (negative) value of IFLAG. See the
+! description of FCN.
+! Otherwise, INFO is set as follows:
+! 0, improper input parameters.
+! 1, algorithm estimates that the relative error between X and the
+! solution is at most TOL.
+! 2, number of calls to FCN has reached or exceeded 200*(N+1).
+! 3, TOL is too small. No further improvement in the approximate
+! solution X is possible.
+! 4, the iteration is not making good progress.
+!
+ implicit none
+
+ integer ( kind = 4 ) lwa
+ integer ( kind = 4 ) n
+
+ real ( kind = 8 ) diag(n)
+ real ( kind = 8 ) epsfcn
+ real ( kind = 8 ) factor
+ external fcn
+ real ( kind = 8 ) fjac(n,n)
+ real ( kind = 8 ) fvec(n)
+ integer ( kind = 4 ) info
+ integer ( kind = 4 ) j
+ integer ( kind = 4 ) ldfjac
+ integer ( kind = 4 ) lr
+ integer ( kind = 4 ) maxfev
+ integer ( kind = 4 ) ml
+ integer ( kind = 4 ) mode
+ integer ( kind = 4 ) mu
+ integer ( kind = 4 ) nfev
+ integer ( kind = 4 ) nprint
+ real ( kind = 8 ) qtf(n)
+ real ( kind = 8 ) r((n*(n+1))/2)
+ real ( kind = 8 ) tol
+ real ( kind = 8 ) x(n)
+ real ( kind = 8 ) xtol
+
+ if ( n <= 0 ) then
+ info = 0
+ return
+ end if
+
+ if ( tol < 0.0D+00 ) then
+ info = 0
+ return
+ end if
+
+ xtol = tol
+ maxfev = 200 * ( n + 1 )
+ ml = n - 1
+ mu = n - 1
+ epsfcn = 0.0D+00
+ diag(1:n) = 1.0D+00
+ mode = 2
+ factor = 100.0D+00
+ nprint = 0
+ info = 0
+ nfev = 0
+ fjac(1:n,1:n) = 0.0D+00
+ ldfjac = n
+ r(1:(n*(n+1))/2) = 0.0D+00
+ lr = ( n * ( n + 1 ) ) / 2
+ qtf(1:n) = 0.0D+00
+
+ call hybrd ( fcn, n, x, fvec, xtol, maxfev, ml, mu, epsfcn, diag, mode, &
+ factor, nprint, info, nfev, fjac, ldfjac, r, lr, qtf )
+
+ if ( info == 5 ) then
+ info = 4
+ end if
+
+ return
+end
+subroutine hybrj ( fcn, n, x, fvec, fjac, ldfjac, xtol, maxfev, diag, mode, &
+ factor, nprint, info, nfev, njev, r, lr, qtf )
+
+!*****************************************************************************80
+!
+!! HYBRJ seeks a zero of N nonlinear equations in N variables.
+!
+! Discussion:
+!
+! HYBRJ finds a zero of a system of N nonlinear functions in N variables
+! by a modification of the Powell hybrid method. The user must provide a
+! subroutine which calculates the functions and the jacobian.
+!
+! Licensing:
+!
+! This code is distributed under the GNU LGPL license.
+!
+! Modified:
+!
+! 06 April 2010
+!
+! Author:
+!
+! Original FORTRAN77 version by Jorge More, Burton Garbow, Kenneth Hillstrom.
+! FORTRAN90 version by John Burkardt.
+!
+! Reference:
+!
+! Jorge More, Burton Garbow, Kenneth Hillstrom,
+! User Guide for MINPACK-1,
+! Technical Report ANL-80-74,
+! Argonne National Laboratory, 1980.
+!
+! Parameters:
+!
+! Input, external FCN, the name of the user-supplied subroutine which
+! calculates the functions and the jacobian. FCN should have the form:
+!
+! subroutine fcn ( n, x, fvec, fjac, ldfjac, iflag )
+! integer ( kind = 4 ) ldfjac
+! integer ( kind = 4 ) n
+! real ( kind = 8 ) fjac(ldfjac,n)
+! real ( kind = 8 ) fvec(n)
+! integer ( kind = 4 ) iflag
+! real ( kind = 8 ) x(n)
+!
+! If IFLAG = 0 on input, then FCN is only being called to allow the user
+! to print out the current iterate.
+! If IFLAG = 1 on input, FCN should calculate the functions at X and
+! return this vector in FVEC.
+! If IFLAG = 2 on input, FCN should calculate the jacobian at X and
+! return this matrix in FJAC.
+! To terminate the algorithm, FCN may set IFLAG negative on return.
+!
+! Input, integer ( kind = 4 ) N, the number of functions and variables.
+!
+! Input/output, real ( kind = 8 ) X(N). On input, X must contain an initial
+! estimate of the solution vector. On output X contains the final
+! estimate of the solution vector.
+!
+! Output, real ( kind = 8 ) FVEC(N), the functions evaluated at the output X.
+!
+! Output, real ( kind = 8 ) FJAC(LDFJAC,N), an N by N matrix, containing
+! the orthogonal matrix Q produced by the QR factorization
+! of the final approximate jacobian.
+!
+! Input, integer ( kind = 4 ) LDFJAC, the leading dimension of the
+! array FJAC. LDFJAC must be at least N.
+!
+! Input, real ( kind = 8 ) XTOL. Termination occurs when the relative error
+! between two consecutive iterates is at most XTOL. XTOL should be
+! nonnegative.
+!
+! Input, integer ( kind = 4 ) MAXFEV. Termination occurs when the number of
+! calls to FCN is at least MAXFEV by the end of an iteration.
+!
+! Input/output, real ( kind = 8 ) DIAG(N). If MODE = 1, then DIAG is set
+! internally. If MODE = 2, then DIAG must contain positive entries that
+! serve as multiplicative scale factors for the variables.
+!
+! Input, integer ( kind = 4 ) MODE, scaling option.
+! 1, variables will be scaled internally.
+! 2, scaling is specified by the input DIAG vector.
+!
+! Input, real ( kind = 8 ) FACTOR, determines the initial step bound. This
+! bound is set to the product of FACTOR and the euclidean norm of DIAG*X if
+! nonzero, or else to FACTOR itself. In most cases, FACTOR should lie
+! in the interval (0.1, 100) with 100 the recommended value.
+!
+! Input, integer ( kind = 4 ) NPRINT, enables controlled printing of iterates
+! if it is positive. In this case, FCN is called with IFLAG = 0 at the
+! beginning of the first iteration and every NPRINT iterations thereafter
+! and immediately prior to return, with X and FVEC available
+! for printing. If NPRINT is not positive, no special calls
+! of FCN with IFLAG = 0 are made.
+!
+! Output, integer ( kind = 4 ) INFO, error flag. If the user has terminated
+! execution, INFO is set to the (negative) value of IFLAG.
+! See the description of FCN. Otherwise, INFO is set as follows:
+! 0, improper input parameters.
+! 1, relative error between two consecutive iterates is at most XTOL.
+! 2, number of calls to FCN with IFLAG = 1 has reached MAXFEV.
+! 3, XTOL is too small. No further improvement in
+! the approximate solution X is possible.
+! 4, iteration is not making good progress, as measured by the
+! improvement from the last five jacobian evaluations.
+! 5, iteration is not making good progress, as measured by the
+! improvement from the last ten iterations.
+!
+! Output, integer ( kind = 4 ) NFEV, the number of calls to FCN
+! with IFLAG = 1.
+!
+! Output, integer ( kind = 4 ) NJEV, the number of calls to FCN
+! with IFLAG = 2.
+!
+! Output, real ( kind = 8 ) R(LR), the upper triangular matrix produced
+! by the QR factorization of the final approximate jacobian, stored rowwise.
+!
+! Input, integer ( kind = 4 ) LR, the size of the R array, which must
+! be no less than (N*(N+1))/2.
+!
+! Output, real ( kind = 8 ) QTF(N), contains the vector Q'*FVEC.
+!
+ implicit none
+
+ integer ( kind = 4 ) ldfjac
+ integer ( kind = 4 ) lr
+ integer ( kind = 4 ) n
+
+ real ( kind = 8 ) actred
+ real ( kind = 8 ) delta
+ real ( kind = 8 ) diag(n)
+ real ( kind = 8 ) enorm
+ real ( kind = 8 ) epsmch
+ real ( kind = 8 ) factor
+ external fcn
+ real ( kind = 8 ) fjac(ldfjac,n)
+ real ( kind = 8 ) fnorm
+ real ( kind = 8 ) fnorm1
+ real ( kind = 8 ) fvec(n)
+ integer ( kind = 4 ) i
+ integer ( kind = 4 ) iflag
+ integer ( kind = 4 ) info
+ integer ( kind = 4 ) iter
+ integer ( kind = 4 ) iwa(1)
+ integer ( kind = 4 ) j
+ logical jeval
+ integer ( kind = 4 ) l
+ integer ( kind = 4 ) maxfev
+ integer ( kind = 4 ) mode
+ integer ( kind = 4 ) ncfail
+ integer ( kind = 4 ) nslow1
+ integer ( kind = 4 ) nslow2
+ integer ( kind = 4 ) ncsuc
+ integer ( kind = 4 ) nfev
+ integer ( kind = 4 ) njev
+ integer ( kind = 4 ) nprint
+ logical pivot
+ real ( kind = 8 ) pnorm
+ real ( kind = 8 ) prered
+ real ( kind = 8 ) qtf(n)
+ real ( kind = 8 ) r(lr)
+ real ( kind = 8 ) ratio
+ logical sing
+ real ( kind = 8 ) sum2
+ real ( kind = 8 ) temp
+ real ( kind = 8 ) wa1(n)
+ real ( kind = 8 ) wa2(n)
+ real ( kind = 8 ) wa3(n)
+ real ( kind = 8 ) wa4(n)
+ real ( kind = 8 ) x(n)
+ real ( kind = 8 ) xnorm
+ real ( kind = 8 ) xtol
+
+ epsmch = epsilon ( epsmch )
+
+ info = 0
+ iflag = 0
+ nfev = 0
+ njev = 0
+!
+! Check the input parameters for errors.
+!
+ if ( n <= 0 ) then
+ if ( iflag < 0 ) then
+ info = iflag
+ end if
+ iflag = 0
+ if ( 0 < nprint ) then
+ call fcn ( n, x, fvec, fjac, ldfjac, iflag )
+ end if
+ return
+ end if
+
+ if ( ldfjac < n .or. &
+ xtol < 0.0D+00 .or. &
+ maxfev <= 0 .or. &
+ factor <= 0.0D+00 .or. &
+ lr < ( n * ( n + 1 ) ) / 2 ) then
+ if ( iflag < 0 ) then
+ info = iflag
+ end if
+ iflag = 0
+ if ( 0 < nprint ) then
+ call fcn ( n, x, fvec, fjac, ldfjac, iflag )
+ end if
+ return
+ end if
+
+ if ( mode == 2 ) then
+ do j = 1, n
+ if ( diag(j) <= 0.0D+00 ) then
+ if ( iflag < 0 ) then
+ info = iflag
+ end if
+ iflag = 0
+ if ( 0 < nprint ) then
+ call fcn ( n, x, fvec, fjac, ldfjac, iflag )
+ end if
+ return
+ end if
+ end do
+ end if
+!
+! Evaluate the function at the starting point and calculate its norm.
+!
+ iflag = 1
+ call fcn ( n, x, fvec, fjac, ldfjac, iflag )
+ nfev = 1
+
+ if ( iflag < 0 ) then
+ if ( iflag < 0 ) then
+ info = iflag
+ end if
+ iflag = 0
+ if ( 0 < nprint ) then
+ call fcn ( n, x, fvec, fjac, ldfjac, iflag )
+ end if
+ return
+ end if
+
+ fnorm = enorm ( n, fvec )
+!
+! Initialize iteration counter and monitors.
+!
+ iter = 1
+ ncsuc = 0
+ ncfail = 0
+ nslow1 = 0
+ nslow2 = 0
+!
+! Beginning of the outer loop.
+!
+ do
+
+ jeval = .true.
+!
+! Calculate the jacobian matrix.
+!
+ iflag = 2
+ call fcn ( n, x, fvec, fjac, ldfjac, iflag )
+ njev = njev + 1
+
+ if ( iflag < 0 ) then
+ info = iflag
+ iflag = 0
+ if ( 0 < nprint ) then
+ call fcn ( n, x, fvec, fjac, ldfjac, iflag )
+ end if
+ return
+ end if
+!
+! Compute the QR factorization of the jacobian.
+!
+ pivot = .false.
+ call qrfac ( n, n, fjac, ldfjac, pivot, iwa, 1, wa1, wa2 )
+!
+! On the first iteration, if MODE is 1, scale according
+! to the norms of the columns of the initial jacobian.
+!
+ if ( iter == 1 ) then
+
+ if ( mode /= 2 ) then
+ diag(1:n) = wa2(1:n)
+ do j = 1, n
+ if ( wa2(j) == 0.0D+00 ) then
+ diag(j) = 1.0D+00
+ end if
+ end do
+ end if
+!
+! On the first iteration, calculate the norm of the scaled X
+! and initialize the step bound DELTA.
+!
+ wa3(1:n) = diag(1:n) * x(1:n)
+ xnorm = enorm ( n, wa3 )
+ delta = factor * xnorm
+ if ( delta == 0.0D+00 ) then
+ delta = factor
+ end if
+
+ end if
+!
+! Form Q'*FVEC and store in QTF.
+!
+ qtf(1:n) = fvec(1:n)
+
+ do j = 1, n
+ if ( fjac(j,j) /= 0.0D+00 ) then
+ sum2 = 0.0D+00
+ do i = j, n
+ sum2 = sum2 + fjac(i,j) * qtf(i)
+ end do
+ temp = - sum2 / fjac(j,j)
+ do i = j, n
+ qtf(i) = qtf(i) + fjac(i,j) * temp
+ end do
+ end if
+ end do
+!
+! Copy the triangular factor of the QR factorization into R.
+!
+ sing = .false.
+
+ do j = 1, n
+ l = j
+ do i = 1, j - 1
+ r(l) = fjac(i,j)
+ l = l + n - i
+ end do
+ r(l) = wa1(j)
+ if ( wa1(j) == 0.0D+00 ) then
+ sing = .true.
+ end if
+ end do
+!
+! Accumulate the orthogonal factor in FJAC.
+!
+ call qform ( n, n, fjac, ldfjac )
+!
+! Rescale if necessary.
+!
+ if ( mode /= 2 ) then
+ do j = 1, n
+ diag(j) = max ( diag(j), wa2(j) )
+ end do
+ end if
+!
+! Beginning of the inner loop.
+!
+ do
+!
+! If requested, call FCN to enable printing of iterates.
+!
+ if ( 0 < nprint ) then
+
+ iflag = 0
+ if ( mod ( iter - 1, nprint ) == 0 ) then
+ call fcn ( n, x, fvec, fjac, ldfjac, iflag )
+ end if
+
+ if ( iflag < 0 ) then
+ info = iflag
+ iflag = 0
+ if ( 0 < nprint ) then
+ call fcn ( n, x, fvec, fjac, ldfjac, iflag )
+ end if
+ return
+ end if
+
+ end if
+!
+! Determine the direction P.
+!
+ call dogleg ( n, r, lr, diag, qtf, delta, wa1 )
+!
+! Store the direction P and X + P.
+! Calculate the norm of P.
+!
+ wa1(1:n) = - wa1(1:n)
+ wa2(1:n) = x(1:n) + wa1(1:n)
+ wa3(1:n) = diag(1:n) * wa1(1:n)
+ pnorm = enorm ( n, wa3 )
+!
+! On the first iteration, adjust the initial step bound.
+!
+ if ( iter == 1 ) then
+ delta = min ( delta, pnorm )
+ end if
+!
+! Evaluate the function at X + P and calculate its norm.
+!
+ iflag = 1
+ call fcn ( n, wa2, wa4, fjac, ldfjac, iflag )
+ nfev = nfev + 1
+
+ if ( iflag < 0 ) then
+ info = iflag
+ iflag = 0
+ if ( 0 < nprint ) then
+ call fcn ( n, x, fvec, fjac, ldfjac, iflag )
+ end if
+ return
+ end if
+
+ fnorm1 = enorm ( n, wa4 )
+!
+! Compute the scaled actual reduction.
+!
+ actred = -1.0D+00
+ if ( fnorm1 < fnorm ) then
+ actred = 1.0D+00 - ( fnorm1 / fnorm ) ** 2
+ end if
+!
+! Compute the scaled predicted reduction.
+!
+ l = 1
+ do i = 1, n
+ sum2 = 0.0D+00
+ do j = i, n
+ sum2 = sum2 + r(l) * wa1(j)
+ l = l + 1
+ end do
+ wa3(i) = qtf(i) + sum2
+ end do
+
+ temp = enorm ( n, wa3 )
+ prered = 0.0D+00
+ if ( temp < fnorm ) then
+ prered = 1.0D+00 - ( temp / fnorm ) ** 2
+ end if
+!
+! Compute the ratio of the actual to the predicted reduction.
+!
+ if ( 0.0D+00 < prered ) then
+ ratio = actred / prered
+ else
+ ratio = 0.0D+00
+ end if
+!
+! Update the step bound.
+!
+ if ( ratio < 0.1D+00 ) then
+
+ ncsuc = 0
+ ncfail = ncfail + 1
+ delta = 0.5D+00 * delta
+
+ else
+
+ ncfail = 0
+ ncsuc = ncsuc + 1
+
+ if ( 0.5D+00 <= ratio .or. 1 < ncsuc ) then
+ delta = max ( delta, pnorm / 0.5D+00 )
+ end if
+
+ if ( abs ( ratio - 1.0D+00 ) <= 0.1D+00 ) then
+ delta = pnorm / 0.5D+00
+ end if
+
+ end if
+!
+! Test for successful iteration.
+!
+
+!
+! Successful iteration.
+! Update X, FVEC, and their norms.
+!
+ if ( 0.0001D+00 <= ratio ) then
+ x(1:n) = wa2(1:n)
+ wa2(1:n) = diag(1:n) * x(1:n)
+ fvec(1:n) = wa4(1:n)
+ xnorm = enorm ( n, wa2 )
+ fnorm = fnorm1
+ iter = iter + 1
+ end if
+!
+! Determine the progress of the iteration.
+!
+ nslow1 = nslow1 + 1
+ if ( 0.001D+00 <= actred ) then
+ nslow1 = 0
+ end if
+
+ if ( jeval ) then
+ nslow2 = nslow2 + 1
+ end if
+
+ if ( 0.1D+00 <= actred ) then
+ nslow2 = 0
+ end if
+!
+! Test for convergence.
+!
+ if ( delta <= xtol * xnorm .or. fnorm == 0.0D+00 ) then
+ info = 1
+ end if
+
+ if ( info /= 0 ) then
+ iflag = 0
+ if ( 0 < nprint ) then
+ call fcn ( n, x, fvec, fjac, ldfjac, iflag )
+ end if
+ return
+ end if
+!
+! Tests for termination and stringent tolerances.
+!
+ if ( maxfev <= nfev ) then
+ info = 2
+ end if
+
+ if ( 0.1D+00 * max ( 0.1D+00 * delta, pnorm ) <= epsmch * xnorm ) then
+ info = 3
+ end if
+
+ if ( nslow2 == 5 ) then
+ info = 4
+ end if
+
+ if ( nslow1 == 10 ) then
+ info = 5
+ end if
+
+ if ( info /= 0 ) then
+ iflag = 0
+ if ( 0 < nprint ) then
+ call fcn ( n, x, fvec, fjac, ldfjac, iflag )
+ end if
+ return
+ end if
+!
+! Criterion for recalculating jacobian.
+!
+ if ( ncfail == 2 ) then
+ exit
+ end if
+!
+! Calculate the rank one modification to the jacobian
+! and update QTF if necessary.
+!
+ do j = 1, n
+ sum2 = dot_product ( wa4(1:n), fjac(1:n,j) )
+ wa2(j) = ( sum2 - wa3(j) ) / pnorm
+ wa1(j) = diag(j) * ( ( diag(j) * wa1(j) ) / pnorm )
+ if ( 0.0001D+00 <= ratio ) then
+ qtf(j) = sum2
+ end if
+ end do
+!
+! Compute the QR factorization of the updated jacobian.
+!
+ call r1updt ( n, n, r, lr, wa1, wa2, wa3, sing )
+ call r1mpyq ( n, n, fjac, ldfjac, wa2, wa3 )
+ call r1mpyq ( 1, n, qtf, 1, wa2, wa3 )
+!
+! End of the inner loop.
+!
+ jeval = .false.
+
+ end do
+!
+! End of the outer loop.
+!
+ end do
+
+end
+subroutine hybrj1 ( fcn, n, x, fvec, fjac, ldfjac, tol, info )
+
+!*****************************************************************************80
+!
+!! HYBRJ1 seeks a zero of N equations in N variables by Powell's method.
+!
+! Discussion:
+!
+! HYBRJ1 finds a zero of a system of N nonlinear functions in N variables
+! by a modification of the Powell hybrid method. This is done by using the
+! more general nonlinear equation solver HYBRJ. The user
+! must provide a subroutine which calculates the functions
+! and the jacobian.
+!
+! Licensing:
+!
+! This code is distributed under the GNU LGPL license.
+!
+! Modified:
+!
+! 06 April 2010
+!
+! Author:
+!
+! Original FORTRAN77 version by Jorge More, Burton Garbow, Kenneth Hillstrom.
+! FORTRAN90 version by John Burkardt.
+!
+! Reference:
+!
+! Jorge More, Burton Garbow, Kenneth Hillstrom,
+! User Guide for MINPACK-1,
+! Technical Report ANL-80-74,
+! Argonne National Laboratory, 1980.
+!
+! Parameters:
+!
+! Input, external FCN, the name of the user-supplied subroutine which
+! calculates the functions and the jacobian. FCN should have the form:
+! subroutine fcn ( n, x, fvec, fjac, ldfjac, iflag )
+! integer ( kind = 4 ) ldfjac
+! integer ( kind = 4 ) n
+! real ( kind = 8 ) fjac(ldfjac,n)
+! real ( kind = 8 ) fvec(n)
+! integer ( kind = 4 ) iflag
+! real ( kind = 8 ) x(n)
+!
+! If IFLAG = 0 on input, then FCN is only being called to allow the user
+! to print out the current iterate.
+! If IFLAG = 1 on input, FCN should calculate the functions at X and
+! return this vector in FVEC.
+! If IFLAG = 2 on input, FCN should calculate the jacobian at X and
+! return this matrix in FJAC.
+! To terminate the algorithm, FCN may set IFLAG negative on return.
+!
+! Input, integer ( kind = 4 ) N, the number of functions and variables.
+!
+! Input/output, real ( kind = 8 ) X(N). On input, X must contain an initial
+! estimate of the solution vector. On output X contains the final
+! estimate of the solution vector.
+!
+! Output, real ( kind = 8 ) FVEC(N), the functions evaluated at the output X.
+!
+! Output, real ( kind = 8 ) FJAC(LDFJAC,N), an N by N array which contains
+! the orthogonal matrix Q produced by the QR factorization of the final
+! approximate jacobian.
+!
+! Input, integer ( kind = 4 ) LDFJAC, the leading dimension of FJAC.
+! LDFJAC must be at least N.
+!
+! Input, real ( kind = 8 ) TOL. Termination occurs when the algorithm
+! estimates that the relative error between X and the solution is at most
+! TOL. TOL should be nonnegative.
+!
+! Output, integer ( kind = 4 ) INFO, error flag. If the user has terminated
+! execution, INFO is set to the (negative) value of IFLAG. See description
+! of FCN. Otherwise, INFO is set as follows:
+! 0, improper input parameters.
+! 1, algorithm estimates that the relative error between X and the
+! solution is at most TOL.
+! 2, number of calls to FCN with IFLAG = 1 has reached 100*(N+1).
+! 3, TOL is too small. No further improvement in the approximate
+! solution X is possible.
+! 4, iteration is not making good progress.
+!
+ implicit none
+
+ integer ( kind = 4 ) ldfjac
+ integer ( kind = 4 ) n
+
+ real ( kind = 8 ) diag(n)
+ real ( kind = 8 ) factor
+ external fcn
+ real ( kind = 8 ) fjac(ldfjac,n)
+ real ( kind = 8 ) fvec(n)
+ integer ( kind = 4 ) info
+ integer ( kind = 4 ) j
+ integer ( kind = 4 ) lr
+ integer ( kind = 4 ) maxfev
+ integer ( kind = 4 ) mode
+ integer ( kind = 4 ) nfev
+ integer ( kind = 4 ) njev
+ integer ( kind = 4 ) nprint
+ real ( kind = 8 ) qtf(n)
+ real ( kind = 8 ) r((n*(n+1))/2)
+ real ( kind = 8 ) tol
+ real ( kind = 8 ) x(n)
+ real ( kind = 8 ) xtol
+
+ info = 0
+
+ if ( n <= 0 ) then
+ return
+ else if ( ldfjac < n ) then
+ return
+ else if ( tol < 0.0D+00 ) then
+ return
+ end if
+
+ maxfev = 100 * ( n + 1 )
+ xtol = tol
+ mode = 2
+ diag(1:n) = 1.0D+00
+ factor = 100.0D+00
+ nprint = 0
+ lr = ( n * ( n + 1 ) ) / 2
+
+ call hybrj ( fcn, n, x, fvec, fjac, ldfjac, xtol, maxfev, diag, mode, &
+ factor, nprint, info, nfev, njev, r, lr, qtf )
+
+ if ( info == 5 ) then
+ info = 4
+ end if
+
+ return
+end
+subroutine lmder ( fcn, m, n, x, fvec, fjac, ldfjac, ftol, xtol, gtol, maxfev, &
+ diag, mode, factor, nprint, info, nfev, njev, ipvt, qtf )
+
+!*****************************************************************************80
+!
+!! LMDER minimizes M functions in N variables by the Levenberg-Marquardt method.
+!
+! Discussion:
+!
+! LMDER minimizes the sum of the squares of M nonlinear functions in
+! N variables by a modification of the Levenberg-Marquardt algorithm.
+! The user must provide a subroutine which calculates the functions
+! and the jacobian.
+!
+! Licensing:
+!
+! This code is distributed under the GNU LGPL license.
+!
+! Modified:
+!
+! 06 April 2010
+!
+! Author:
+!
+! Original FORTRAN77 version by Jorge More, Burton Garbow, Kenneth Hillstrom.
+! FORTRAN90 version by John Burkardt.
+!
+! Reference:
+!
+! Jorge More, Burton Garbow, Kenneth Hillstrom,
+! User Guide for MINPACK-1,
+! Technical Report ANL-80-74,
+! Argonne National Laboratory, 1980.
+!
+! Parameters:
+!
+! Input, external FCN, the name of the user-supplied subroutine which
+! calculates the functions and the jacobian. FCN should have the form:
+! subroutine fcn ( m, n, x, fvec, fjac, ldfjac, iflag )
+! integer ( kind = 4 ) ldfjac
+! integer ( kind = 4 ) n
+! real ( kind = 8 ) fjac(ldfjac,n)
+! real ( kind = 8 ) fvec(m)
+! integer ( kind = 4 ) iflag
+! real ( kind = 8 ) x(n)
+!
+! If IFLAG = 0 on input, then FCN is only being called to allow the user
+! to print out the current iterate.
+! If IFLAG = 1 on input, FCN should calculate the functions at X and
+! return this vector in FVEC.
+! If IFLAG = 2 on input, FCN should calculate the jacobian at X and
+! return this matrix in FJAC.
+! To terminate the algorithm, FCN may set IFLAG negative on return.
+!
+! Input, integer ( kind = 4 ) M, is the number of functions.
+!
+! Input, integer ( kind = 4 ) N, is the number of variables.
+! N must not exceed M.
+!
+! Input/output, real ( kind = 8 ) X(N). On input, X must contain an initial
+! estimate of the solution vector. On output X contains the final
+! estimate of the solution vector.
+!
+! Output, real ( kind = 8 ) FVEC(M), the functions evaluated at the output X.
+!
+! Output, real ( kind = 8 ) FJAC(LDFJAC,N), an M by N array. The upper
+! N by N submatrix of FJAC contains an upper triangular matrix R with
+! diagonal elements of nonincreasing magnitude such that
+! P' * ( JAC' * JAC ) * P = R' * R,
+! where P is a permutation matrix and JAC is the final calculated jacobian.
+! Column J of P is column IPVT(J) of the identity matrix. The lower
+! trapezoidal part of FJAC contains information generated during
+! the computation of R.
+!
+! Input, integer ( kind = 4 ) LDFJAC, the leading dimension of FJAC.
+! LDFJAC must be at least M.
+!
+! Input, real ( kind = 8 ) FTOL. Termination occurs when both the actual
+! and predicted relative reductions in the sum of squares are at most FTOL.
+! Therefore, FTOL measures the relative error desired in the sum of
+! squares. FTOL should be nonnegative.
+!
+! Input, real ( kind = 8 ) XTOL. Termination occurs when the relative error
+! between two consecutive iterates is at most XTOL. XTOL should be
+! nonnegative.
+!
+! Input, real ( kind = 8 ) GTOL. Termination occurs when the cosine of the
+! angle between FVEC and any column of the jacobian is at most GTOL in
+! absolute value. Therefore, GTOL measures the orthogonality desired
+! between the function vector and the columns of the jacobian. GTOL should
+! be nonnegative.
+!
+! Input, integer ( kind = 4 ) MAXFEV. Termination occurs when the number of
+! calls to FCN with IFLAG = 1 is at least MAXFEV by the end of an iteration.
+!
+! Input/output, real ( kind = 8 ) DIAG(N). If MODE = 1, then DIAG is set
+! internally. If MODE = 2, then DIAG must contain positive entries that
+! serve as multiplicative scale factors for the variables.
+!
+! Input, integer ( kind = 4 ) MODE, scaling option.
+! 1, variables will be scaled internally.
+! 2, scaling is specified by the input DIAG vector.
+!
+! Input, real ( kind = 8 ) FACTOR, determines the initial step bound. This
+! bound is set to the product of FACTOR and the euclidean norm of DIAG*X if
+! nonzero, or else to FACTOR itself. In most cases, FACTOR should lie
+! in the interval (0.1, 100) with 100 the recommended value.
+!
+! Input, integer ( kind = 4 ) NPRINT, enables controlled printing of iterates
+! if it is positive. In this case, FCN is called with IFLAG = 0 at the
+! beginning of the first iteration and every NPRINT iterations thereafter
+! and immediately prior to return, with X and FVEC available
+! for printing. If NPRINT is not positive, no special calls
+! of FCN with IFLAG = 0 are made.
+!
+! Output, integer ( kind = 4 ) INFO, error flag. If the user has terminated
+! execution, INFO is set to the (negative) value of IFLAG. See description
+! of FCN. Otherwise, INFO is set as follows:
+! 0, improper input parameters.
+! 1, both actual and predicted relative reductions in the sum of
+! squares are at most FTOL.
+! 2, relative error between two consecutive iterates is at most XTOL.
+! 3, conditions for INFO = 1 and INFO = 2 both hold.
+! 4, the cosine of the angle between FVEC and any column of the jacobian
+! is at most GTOL in absolute value.
+! 5, number of calls to FCN with IFLAG = 1 has reached MAXFEV.
+! 6, FTOL is too small. No further reduction in the sum of squares
+! is possible.
+! 7, XTOL is too small. No further improvement in the approximate
+! solution X is possible.
+! 8, GTOL is too small. FVEC is orthogonal to the columns of the
+! jacobian to machine precision.
+!
+! Output, integer ( kind = 4 ) NFEV, the number of calls to FCN with
+! IFLAG = 1.
+!
+! Output, integer ( kind = 4 ) NJEV, the number of calls to FCN with
+! IFLAG = 2.
+!
+! Output, integer ( kind = 4 ) IPVT(N), defines a permutation matrix P
+! such that JAC*P = Q*R, where JAC is the final calculated jacobian, Q is
+! orthogonal (not stored), and R is upper triangular with diagonal
+! elements of nonincreasing magnitude. Column J of P is column
+! IPVT(J) of the identity matrix.
+!
+! Output, real ( kind = 8 ) QTF(N), contains the first N elements of Q'*FVEC.
+!
+ implicit none
+
+ integer ( kind = 4 ) ldfjac
+ integer ( kind = 4 ) m
+ integer ( kind = 4 ) n
+
+ real ( kind = 8 ) actred
+ real ( kind = 8 ) delta
+ real ( kind = 8 ) diag(n)
+ real ( kind = 8 ) dirder
+ real ( kind = 8 ) enorm
+ real ( kind = 8 ) epsmch
+ real ( kind = 8 ) factor
+ external fcn
+ real ( kind = 8 ) fjac(ldfjac,n)
+ real ( kind = 8 ) fnorm
+ real ( kind = 8 ) fnorm1
+ real ( kind = 8 ) ftol
+ real ( kind = 8 ) fvec(m)
+ real ( kind = 8 ) gnorm
+ real ( kind = 8 ) gtol
+ integer ( kind = 4 ) i
+ integer ( kind = 4 ) iflag
+ integer ( kind = 4 ) info
+ integer ( kind = 4 ) ipvt(n)
+ integer ( kind = 4 ) iter
+ integer ( kind = 4 ) j
+ integer ( kind = 4 ) l
+ integer ( kind = 4 ) maxfev
+ integer ( kind = 4 ) mode
+ integer ( kind = 4 ) nfev
+ integer ( kind = 4 ) njev
+ integer ( kind = 4 ) nprint
+ real ( kind = 8 ) par
+ logical pivot
+ real ( kind = 8 ) pnorm
+ real ( kind = 8 ) prered
+ real ( kind = 8 ) qtf(n)
+ real ( kind = 8 ) ratio
+ real ( kind = 8 ) sum2
+ real ( kind = 8 ) temp
+ real ( kind = 8 ) temp1
+ real ( kind = 8 ) temp2
+ real ( kind = 8 ) wa1(n)
+ real ( kind = 8 ) wa2(n)
+ real ( kind = 8 ) wa3(n)
+ real ( kind = 8 ) wa4(m)
+ real ( kind = 8 ) xnorm
+ real ( kind = 8 ) x(n)
+ real ( kind = 8 ) xtol
+
+ epsmch = epsilon ( epsmch )
+
+ info = 0
+ iflag = 0
+ nfev = 0
+ njev = 0
+!
+! Check the input parameters for errors.
+!
+ if ( n <= 0 ) then
+ go to 300
+ end if
+
+ if ( m < n ) then
+ go to 300
+ end if
+
+ if ( ldfjac < m &
+ .or. ftol < 0.0D+00 .or. xtol < 0.0D+00 .or. gtol < 0.0D+00 &
+ .or. maxfev <= 0 .or. factor <= 0.0D+00 ) then
+ go to 300
+ end if
+
+ if ( mode == 2 ) then
+ do j = 1, n
+ if ( diag(j) <= 0.0D+00 ) then
+ go to 300
+ end if
+ end do
+ end if
+!
+! Evaluate the function at the starting point and calculate its norm.
+!
+ iflag = 1
+ call fcn ( m, n, x, fvec, fjac, ldfjac, iflag )
+ nfev = 1
+ if ( iflag < 0 ) then
+ go to 300
+ end if
+
+ fnorm = enorm ( m, fvec )
+!
+! Initialize Levenberg-Marquardt parameter and iteration counter.
+!
+ par = 0.0D+00
+ iter = 1
+!
+! Beginning of the outer loop.
+!
+30 continue
+!
+! Calculate the jacobian matrix.
+!
+ iflag = 2
+ call fcn ( m, n, x, fvec, fjac, ldfjac, iflag )
+
+ njev = njev + 1
+
+ if ( iflag < 0 ) then
+ go to 300
+ end if
+!
+! If requested, call FCN to enable printing of iterates.
+!
+ if ( 0 < nprint ) then
+ iflag = 0
+ if ( mod ( iter - 1, nprint ) == 0 ) then
+ call fcn ( m, n, x, fvec, fjac, ldfjac, iflag )
+ end if
+ if ( iflag < 0 ) then
+ go to 300
+ end if
+ end if
+!
+! Compute the QR factorization of the jacobian.
+!
+ pivot = .true.
+ call qrfac ( m, n, fjac, ldfjac, pivot, ipvt, n, wa1, wa2 )
+!
+! On the first iteration and if mode is 1, scale according
+! to the norms of the columns of the initial jacobian.
+!
+ if ( iter == 1 ) then
+
+ if ( mode /= 2 ) then
+ diag(1:n) = wa2(1:n)
+ do j = 1, n
+ if ( wa2(j) == 0.0D+00 ) then
+ diag(j) = 1.0D+00
+ end if
+ end do
+ end if
+!
+! On the first iteration, calculate the norm of the scaled X
+! and initialize the step bound DELTA.
+!
+ wa3(1:n) = diag(1:n) * x(1:n)
+
+ xnorm = enorm ( n, wa3 )
+ delta = factor * xnorm
+ if ( delta == 0.0D+00 ) then
+ delta = factor
+ end if
+
+ end if
+!
+! Form Q'*FVEC and store the first N components in QTF.
+!
+ wa4(1:m) = fvec(1:m)
+
+ do j = 1, n
+
+ if ( fjac(j,j) /= 0.0D+00 ) then
+ sum2 = dot_product ( wa4(j:m), fjac(j:m,j) )
+ temp = - sum2 / fjac(j,j)
+ wa4(j:m) = wa4(j:m) + fjac(j:m,j) * temp
+ end if
+
+ fjac(j,j) = wa1(j)
+ qtf(j) = wa4(j)
+
+ end do
+!
+! Compute the norm of the scaled gradient.
+!
+ gnorm = 0.0D+00
+
+ if ( fnorm /= 0.0D+00 ) then
+
+ do j = 1, n
+ l = ipvt(j)
+ if ( wa2(l) /= 0.0D+00 ) then
+ sum2 = dot_product ( qtf(1:j), fjac(1:j,j) ) / fnorm
+ gnorm = max ( gnorm, abs ( sum2 / wa2(l) ) )
+ end if
+ end do
+
+ end if
+!
+! Test for convergence of the gradient norm.
+!
+ if ( gnorm <= gtol ) then
+ info = 4
+ go to 300
+ end if
+!
+! Rescale if necessary.
+!
+ if ( mode /= 2 ) then
+ do j = 1, n
+ diag(j) = max ( diag(j), wa2(j) )
+ end do
+ end if
+!
+! Beginning of the inner loop.
+!
+200 continue
+!
+! Determine the Levenberg-Marquardt parameter.
+!
+ call lmpar ( n, fjac, ldfjac, ipvt, diag, qtf, delta, par, wa1, wa2 )
+!
+! Store the direction p and x + p. calculate the norm of p.
+!
+ wa1(1:n) = - wa1(1:n)
+ wa2(1:n) = x(1:n) + wa1(1:n)
+ wa3(1:n) = diag(1:n) * wa1(1:n)
+
+ pnorm = enorm ( n, wa3 )
+!
+! On the first iteration, adjust the initial step bound.
+!
+ if ( iter == 1 ) then
+ delta = min ( delta, pnorm )
+ end if
+!
+! Evaluate the function at x + p and calculate its norm.
+!
+ iflag = 1
+ call fcn ( m, n, wa2, wa4, fjac, ldfjac, iflag )
+
+ nfev = nfev + 1
+
+ if ( iflag < 0 ) then
+ go to 300
+ end if
+
+ fnorm1 = enorm ( m, wa4 )
+!
+! Compute the scaled actual reduction.
+!
+ actred = -1.0D+00
+ if ( 0.1D+00 * fnorm1 < fnorm ) then
+ actred = 1.0D+00 - ( fnorm1 / fnorm ) ** 2
+ end if
+!
+! Compute the scaled predicted reduction and
+! the scaled directional derivative.
+!
+ do j = 1, n
+ wa3(j) = 0.0D+00
+ l = ipvt(j)
+ temp = wa1(l)
+ wa3(1:j) = wa3(1:j) + fjac(1:j,j) * temp
+ end do
+
+ temp1 = enorm ( n, wa3 ) / fnorm
+ temp2 = ( sqrt ( par ) * pnorm ) / fnorm
+ prered = temp1 ** 2 + temp2 ** 2 / 0.5D+00
+ dirder = - ( temp1 ** 2 + temp2 ** 2 )
+!
+! Compute the ratio of the actual to the predicted reduction.
+!
+ if ( prered /= 0.0D+00 ) then
+ ratio = actred / prered
+ else
+ ratio = 0.0D+00
+ end if
+!
+! Update the step bound.
+!
+ if ( ratio <= 0.25D+00 ) then
+
+ if ( 0.0D+00 <= actred ) then
+ temp = 0.5D+00
+ end if
+
+ if ( actred < 0.0D+00 ) then
+ temp = 0.5D+00 * dirder / ( dirder + 0.5D+00 * actred )
+ end if
+
+ if ( 0.1D+00 * fnorm1 >= fnorm .or. temp < 0.1D+00 ) then
+ temp = 0.1D+00
+ end if
+
+ delta = temp * min ( delta, pnorm / 0.1D+00 )
+ par = par / temp
+
+ else
+
+ if ( par == 0.0D+00 .or. ratio >= 0.75D+00 ) then
+ delta = 2.0D+00 * pnorm
+ par = 0.5D+00 * par
+ end if
+
+ end if
+!
+! Successful iteration.
+!
+! Update X, FVEC, and their norms.
+!
+ if ( 0.0001D+00 <= ratio ) then
+ x(1:n) = wa2(1:n)
+ wa2(1:n) = diag(1:n) * x(1:n)
+ fvec(1:m) = wa4(1:m)
+ xnorm = enorm ( n, wa2 )
+ fnorm = fnorm1
+ iter = iter + 1
+ end if
+!
+! Tests for convergence.
+!
+ if ( abs ( actred) <= ftol .and. &
+ prered <= ftol .and. &
+ 0.5D+00 * ratio <= 1.0D+00 ) then
+ info = 1
+ end if
+
+ if ( delta <= xtol * xnorm ) then
+ info = 2
+ end if
+
+ if ( abs ( actred) <= ftol .and. prered <= ftol &
+ .and. 0.5D+00 * ratio <= 1.0D+00 .and. info == 2 ) then
+ info = 3
+ end if
+
+ if ( info /= 0 ) then
+ go to 300
+ end if
+!
+! Tests for termination and stringent tolerances.
+!
+ if ( nfev >= maxfev ) then
+ info = 5
+ end if
+
+ if ( abs ( actred ) <= epsmch .and. prered <= epsmch &
+ .and. 0.5D+00 * ratio <= 1.0D+00 ) then
+ info = 6
+ end if
+
+ if ( delta <= epsmch * xnorm ) then
+ info = 7
+ end if
+
+ if ( gnorm <= epsmch ) then
+ info = 8
+ end if
+
+ if ( info /= 0 ) then
+ go to 300
+ end if
+!
+! End of the inner loop. repeat if iteration unsuccessful.
+!
+ if ( ratio < 0.0001D+00 ) then
+ go to 200
+ end if
+!
+! End of the outer loop.
+!
+ go to 30
+
+ 300 continue
+!
+! Termination, either normal or user imposed.
+!
+ if ( iflag < 0 ) then
+ info = iflag
+ end if
+
+ iflag = 0
+
+ if ( 0 < nprint ) then
+ call fcn ( m, n, x, fvec, fjac, ldfjac, iflag )
+ end if
+
+ return
+end
+subroutine lmder1 ( fcn, m, n, x, fvec, fjac, ldfjac, tol, info )
+
+!*****************************************************************************80
+!
+!! LMDER1 minimizes M functions in N variables by Levenberg-Marquardt method.
+!
+! Discussion:
+!
+! LMDER1 minimizes the sum of the squares of M nonlinear functions in
+! N variables by a modification of the Levenberg-Marquardt algorithm.
+! This is done by using the more general least-squares solver LMDER.
+! The user must provide a subroutine which calculates the functions
+! and the jacobian.
+!
+! Licensing:
+!
+! This code is distributed under the GNU LGPL license.
+!
+! Modified:
+!
+! 06 April 2010
+!
+! Author:
+!
+! Original FORTRAN77 version by Jorge More, Burton Garbow, Kenneth Hillstrom.
+! FORTRAN90 version by John Burkardt.
+!
+! Reference:
+!
+! Jorge More, Burton Garbow, Kenneth Hillstrom,
+! User Guide for MINPACK-1,
+! Technical Report ANL-80-74,
+! Argonne National Laboratory, 1980.
+!
+! Parameters:
+!
+! Input, external FCN, the name of the user-supplied subroutine which
+! calculates the functions and the jacobian. FCN should have the form:
+! subroutine fcn ( m, n, x, fvec, fjac, ldfjac, iflag )
+! integer ( kind = 4 ) ldfjac
+! integer ( kind = 4 ) n
+! real ( kind = 8 ) fjac(ldfjac,n)
+! real ( kind = 8 ) fvec(m)
+! integer ( kind = 4 ) iflag
+! real ( kind = 8 ) x(n)
+!
+! If IFLAG = 0 on input, then FCN is only being called to allow the user
+! to print out the current iterate.
+! If IFLAG = 1 on input, FCN should calculate the functions at X and
+! return this vector in FVEC.
+! If IFLAG = 2 on input, FCN should calculate the jacobian at X and
+! return this matrix in FJAC.
+! To terminate the algorithm, FCN may set IFLAG negative on return.
+!
+! Input, integer ( kind = 4 ) M, the number of functions.
+!
+! Input, integer ( kind = 4 ) N, is the number of variables.
+! N must not exceed M.
+!
+! Input/output, real ( kind = 8 ) X(N). On input, X must contain an initial
+! estimate of the solution vector. On output X contains the final
+! estimate of the solution vector.
+!
+! Output, real ( kind = 8 ) FVEC(M), the functions evaluated at the output X.
+!
+! Output, real ( kind = 8 ) FJAC(LDFJAC,N), an M by N array. The upper
+! N by N submatrix contains an upper triangular matrix R with
+! diagonal elements of nonincreasing magnitude such that
+! P' * ( JAC' * JAC ) * P = R' * R,
+! where P is a permutation matrix and JAC is the final calculated
+! jacobian. Column J of P is column IPVT(J) of the identity matrix.
+! The lower trapezoidal part of FJAC contains information generated during
+! the computation of R.
+!
+! Input, integer ( kind = 4 ) LDFJAC, is the leading dimension of FJAC,
+! which must be no less than M.
+!
+! Input, real ( kind = 8 ) TOL. Termination occurs when the algorithm
+! estimates either that the relative error in the sum of squares is at
+! most TOL or that the relative error between X and the solution is at
+! most TOL.
+!
+! Output, integer ( kind = 4 ) INFO, error flag. If the user has terminated
+! execution, INFO is set to the (negative) value of IFLAG. See description
+! of FCN. Otherwise, INFO is set as follows:
+! 0, improper input parameters.
+! 1, algorithm estimates that the relative error in the sum of squares
+! is at most TOL.
+! 2, algorithm estimates that the relative error between X and the
+! solution is at most TOL.
+! 3, conditions for INFO = 1 and INFO = 2 both hold.
+! 4, FVEC is orthogonal to the columns of the jacobian to machine precision.
+! 5, number of calls to FCN with IFLAG = 1 has reached 100*(N+1).
+! 6, TOL is too small. No further reduction in the sum of squares is
+! possible.
+! 7, TOL is too small. No further improvement in the approximate
+! solution X is possible.
+!
+ implicit none
+
+ integer ( kind = 4 ) ldfjac
+ integer ( kind = 4 ) m
+ integer ( kind = 4 ) n
+
+ real ( kind = 8 ) diag(n)
+ real ( kind = 8 ) factor
+ external fcn
+ real ( kind = 8 ) fjac(ldfjac,n)
+ real ( kind = 8 ) ftol
+ real ( kind = 8 ) fvec(m)
+ real ( kind = 8 ) gtol
+ integer ( kind = 4 ) info
+ integer ( kind = 4 ) ipvt(n)
+ integer ( kind = 4 ) maxfev
+ integer ( kind = 4 ) mode
+ integer ( kind = 4 ) nfev
+ integer ( kind = 4 ) njev
+ integer ( kind = 4 ) nprint
+ real ( kind = 8 ) qtf(n)
+ real ( kind = 8 ) tol
+ real ( kind = 8 ) x(n)
+ real ( kind = 8 ) xtol
+
+ info = 0
+
+ if ( n <= 0 ) then
+ return
+ else if ( m < n ) then
+ return
+ else if ( ldfjac < m ) then
+ return
+ else if ( tol < 0.0D+00 ) then
+ return
+ end if
+
+ factor = 100.0D+00
+ maxfev = 100 * ( n + 1 )
+ ftol = tol
+ xtol = tol
+ gtol = 0.0D+00
+ mode = 1
+ nprint = 0
+
+ call lmder ( fcn, m, n, x, fvec, fjac, ldfjac, ftol, xtol, gtol, maxfev, &
+ diag, mode, factor, nprint, info, nfev, njev, ipvt, qtf )
+
+ if ( info == 8 ) then
+ info = 4
+ end if
+
+ return
+end
+subroutine lmdif ( fcn, m, n, x, fvec, ftol, xtol, gtol, maxfev, epsfcn, &
+ diag, mode, factor, nprint, info, nfev, fjac, ldfjac, ipvt, qtf )
+
+!*****************************************************************************80
+!
+!! LMDIF minimizes M functions in N variables by the Levenberg-Marquardt method.
+!
+! Discussion:
+!
+! LMDIF minimizes the sum of the squares of M nonlinear functions in
+! N variables by a modification of the Levenberg-Marquardt algorithm.
+! The user must provide a subroutine which calculates the functions.
+! The jacobian is then calculated by a forward-difference approximation.
+!
+! Licensing:
+!
+! This code is distributed under the GNU LGPL license.
+!
+! Modified:
+!
+! 06 April 2010
+!
+! Author:
+!
+! Original FORTRAN77 version by Jorge More, Burton Garbow, Kenneth Hillstrom.
+! FORTRAN90 version by John Burkardt.
+!
+! Reference:
+!
+! Jorge More, Burton Garbow, Kenneth Hillstrom,
+! User Guide for MINPACK-1,
+! Technical Report ANL-80-74,
+! Argonne National Laboratory, 1980.
+!
+! Parameters:
+!
+! Input, external FCN, the name of the user-supplied subroutine which
+! calculates the functions. The routine should have the form:
+! subroutine fcn ( m, n, x, fvec, iflag )
+! integer ( kind = 4 ) m
+! integer ( kind = 4 ) n
+! real ( kind = 8 ) fvec(m)
+! integer ( kind = 4 ) iflag
+! real ( kind = 8 ) x(n)
+! If IFLAG = 0 on input, then FCN is only being called to allow the user
+! to print out the current iterate.
+! If IFLAG = 1 on input, FCN should calculate the functions at X and
+! return this vector in FVEC.
+! To terminate the algorithm, FCN may set IFLAG negative on return.
+!
+! Input, integer ( kind = 4 ) M, the number of functions.
+!
+! Input, integer ( kind = 4 ) N, the number of variables.
+! N must not exceed M.
+!
+! Input/output, real ( kind = 8 ) X(N). On input, X must contain an initial
+! estimate of the solution vector. On output X contains the final
+! estimate of the solution vector.
+!
+! Output, real ( kind = 8 ) FVEC(M), the functions evaluated at the output X.
+!
+! Input, real ( kind = 8 ) FTOL. Termination occurs when both the actual
+! and predicted relative reductions in the sum of squares are at most FTOL.
+! Therefore, FTOL measures the relative error desired in the sum of
+! squares. FTOL should be nonnegative.
+!
+! Input, real ( kind = 8 ) XTOL. Termination occurs when the relative error
+! between two consecutive iterates is at most XTOL. Therefore, XTOL
+! measures the relative error desired in the approximate solution. XTOL
+! should be nonnegative.
+!
+! Input, real ( kind = 8 ) GTOL. termination occurs when the cosine of the
+! angle between FVEC and any column of the jacobian is at most GTOL in
+! absolute value. Therefore, GTOL measures the orthogonality desired
+! between the function vector and the columns of the jacobian. GTOL should
+! be nonnegative.
+!
+! Input, integer ( kind = 4 ) MAXFEV. Termination occurs when the number of
+! calls to FCN is at least MAXFEV by the end of an iteration.
+!
+! Input, real ( kind = 8 ) EPSFCN, is used in determining a suitable step
+! length for the forward-difference approximation. This approximation
+! assumes that the relative errors in the functions are of the order of
+! EPSFCN. If EPSFCN is less than the machine precision, it is assumed that
+! the relative errors in the functions are of the order of the machine
+! precision.
+!
+! Input/output, real ( kind = 8 ) DIAG(N). If MODE = 1, then DIAG is set
+! internally. If MODE = 2, then DIAG must contain positive entries that
+! serve as multiplicative scale factors for the variables.
+!
+! Input, integer ( kind = 4 ) MODE, scaling option.
+! 1, variables will be scaled internally.
+! 2, scaling is specified by the input DIAG vector.
+!
+! Input, real ( kind = 8 ) FACTOR, determines the initial step bound.
+! This bound is set to the product of FACTOR and the euclidean norm of
+! DIAG*X if nonzero, or else to FACTOR itself. In most cases, FACTOR should
+! lie in the interval (0.1, 100) with 100 the recommended value.
+!
+! Input, integer ( kind = 4 ) NPRINT, enables controlled printing of iterates
+! if it is positive. In this case, FCN is called with IFLAG = 0 at the
+! beginning of the first iteration and every NPRINT iterations thereafter
+! and immediately prior to return, with X and FVEC available
+! for printing. If NPRINT is not positive, no special calls
+! of FCN with IFLAG = 0 are made.
+!
+! Output, integer ( kind = 4 ) INFO, error flag. If the user has terminated
+! execution, INFO is set to the (negative) value of IFLAG. See description
+! of FCN. Otherwise, INFO is set as follows:
+! 0, improper input parameters.
+! 1, both actual and predicted relative reductions in the sum of squares
+! are at most FTOL.
+! 2, relative error between two consecutive iterates is at most XTOL.
+! 3, conditions for INFO = 1 and INFO = 2 both hold.
+! 4, the cosine of the angle between FVEC and any column of the jacobian
+! is at most GTOL in absolute value.
+! 5, number of calls to FCN has reached or exceeded MAXFEV.
+! 6, FTOL is too small. No further reduction in the sum of squares
+! is possible.
+! 7, XTOL is too small. No further improvement in the approximate
+! solution X is possible.
+! 8, GTOL is too small. FVEC is orthogonal to the columns of the
+! jacobian to machine precision.
+!
+! Output, integer ( kind = 4 ) NFEV, the number of calls to FCN.
+!
+! Output, real ( kind = 8 ) FJAC(LDFJAC,N), an M by N array. The upper
+! N by N submatrix of FJAC contains an upper triangular matrix R with
+! diagonal elements of nonincreasing magnitude such that
+!
+! P' * ( JAC' * JAC ) * P = R' * R,
+!
+! where P is a permutation matrix and JAC is the final calculated jacobian.
+! Column J of P is column IPVT(J) of the identity matrix. The lower
+! trapezoidal part of FJAC contains information generated during
+! the computation of R.
+!
+! Input, integer ( kind = 4 ) LDFJAC, the leading dimension of FJAC.
+! LDFJAC must be at least M.
+!
+! Output, integer ( kind = 4 ) IPVT(N), defines a permutation matrix P such
+! that JAC * P = Q * R, where JAC is the final calculated jacobian, Q is
+! orthogonal (not stored), and R is upper triangular with diagonal
+! elements of nonincreasing magnitude. Column J of P is column IPVT(J)
+! of the identity matrix.
+!
+! Output, real ( kind = 8 ) QTF(N), the first N elements of Q'*FVEC.
+!
+ implicit none
+
+ integer ( kind = 4 ) ldfjac
+ integer ( kind = 4 ) m
+ integer ( kind = 4 ) n
+
+ real ( kind = 8 ) actred
+ real ( kind = 8 ) delta
+ real ( kind = 8 ) diag(n)
+ real ( kind = 8 ) dirder
+ real ( kind = 8 ) enorm
+ real ( kind = 8 ) epsfcn
+ real ( kind = 8 ) epsmch
+ real ( kind = 8 ) factor
+ external fcn
+ real ( kind = 8 ) fjac(ldfjac,n)
+ real ( kind = 8 ) fnorm
+ real ( kind = 8 ) fnorm1
+ real ( kind = 8 ) ftol
+ real ( kind = 8 ) fvec(m)
+ real ( kind = 8 ) gnorm
+ real ( kind = 8 ) gtol
+ integer ( kind = 4 ) i
+ integer ( kind = 4 ) iflag
+ integer ( kind = 4 ) iter
+ integer ( kind = 4 ) info
+ integer ( kind = 4 ) ipvt(n)
+ integer ( kind = 4 ) j
+ integer ( kind = 4 ) l
+ integer ( kind = 4 ) maxfev
+ integer ( kind = 4 ) mode
+ integer ( kind = 4 ) nfev
+ integer ( kind = 4 ) nprint
+ real ( kind = 8 ) par
+ logical pivot
+ real ( kind = 8 ) pnorm
+ real ( kind = 8 ) prered
+ real ( kind = 8 ) qtf(n)
+ real ( kind = 8 ) ratio
+ real ( kind = 8 ) sum2
+ real ( kind = 8 ) temp
+ real ( kind = 8 ) temp1
+ real ( kind = 8 ) temp2
+ real ( kind = 8 ) wa1(n)
+ real ( kind = 8 ) wa2(n)
+ real ( kind = 8 ) wa3(n)
+ real ( kind = 8 ) wa4(m)
+ real ( kind = 8 ) x(n)
+ real ( kind = 8 ) xnorm
+ real ( kind = 8 ) xtol
+
+ epsmch = epsilon ( epsmch )
+
+ info = 0
+ iflag = 0
+ nfev = 0
+
+ if ( n <= 0 ) then
+ go to 300
+ else if ( m < n ) then
+ go to 300
+ else if ( ldfjac < m ) then
+ go to 300
+ else if ( ftol < 0.0D+00 ) then
+ go to 300
+ else if ( xtol < 0.0D+00 ) then
+ go to 300
+ else if ( gtol < 0.0D+00 ) then
+ go to 300
+ else if ( maxfev <= 0 ) then
+ go to 300
+ else if ( factor <= 0.0D+00 ) then
+ go to 300
+ end if
+
+ if ( mode == 2 ) then
+ do j = 1, n
+ if ( diag(j) <= 0.0D+00 ) then
+ go to 300
+ end if
+ end do
+ end if
+!
+! Evaluate the function at the starting point and calculate its norm.
+!
+ iflag = 1
+ call fcn ( m, n, x, fvec, iflag )
+ nfev = 1
+
+ if ( iflag < 0 ) then
+ go to 300
+ end if
+
+ fnorm = enorm ( m, fvec )
+!
+! Initialize Levenberg-Marquardt parameter and iteration counter.
+!
+ par = 0.0D+00
+ iter = 1
+!
+! Beginning of the outer loop.
+!
+30 continue
+!
+! Calculate the jacobian matrix.
+!
+ iflag = 2
+ call fdjac2 ( fcn, m, n, x, fvec, fjac, ldfjac, iflag, epsfcn )
+ nfev = nfev + n
+
+ if ( iflag < 0 ) then
+ go to 300
+ end if
+!
+! If requested, call FCN to enable printing of iterates.
+!
+ if ( 0 < nprint ) then
+ iflag = 0
+ if ( mod ( iter - 1, nprint ) == 0 ) then
+ call fcn ( m, n, x, fvec, iflag )
+ end if
+ if ( iflag < 0 ) then
+ go to 300
+ end if
+ end if
+!
+! Compute the QR factorization of the jacobian.
+!
+ pivot = .true.
+ call qrfac ( m, n, fjac, ldfjac, pivot, ipvt, n, wa1, wa2 )
+!
+! On the first iteration and if MODE is 1, scale according
+! to the norms of the columns of the initial jacobian.
+!
+ if ( iter == 1 ) then
+
+ if ( mode /= 2 ) then
+ diag(1:n) = wa2(1:n)
+ do j = 1, n
+ if ( wa2(j) == 0.0D+00 ) then
+ diag(j) = 1.0D+00
+ end if
+ end do
+ end if
+!
+! On the first iteration, calculate the norm of the scaled X
+! and initialize the step bound DELTA.
+!
+ wa3(1:n) = diag(1:n) * x(1:n)
+ xnorm = enorm ( n, wa3 )
+ delta = factor * xnorm
+ if ( delta == 0.0D+00 ) then
+ delta = factor
+ end if
+ end if
+!
+! Form Q' * FVEC and store the first N components in QTF.
+!
+ wa4(1:m) = fvec(1:m)
+
+ do j = 1, n
+
+ if ( fjac(j,j) /= 0.0D+00 ) then
+ sum2 = dot_product ( wa4(j:m), fjac(j:m,j) )
+ temp = - sum2 / fjac(j,j)
+ wa4(j:m) = wa4(j:m) + fjac(j:m,j) * temp
+ end if
+
+ fjac(j,j) = wa1(j)
+ qtf(j) = wa4(j)
+
+ end do
+!
+! Compute the norm of the scaled gradient.
+!
+ gnorm = 0.0D+00
+
+ if ( fnorm /= 0.0D+00 ) then
+
+ do j = 1, n
+
+ l = ipvt(j)
+
+ if ( wa2(l) /= 0.0D+00 ) then
+ sum2 = 0.0D+00
+ do i = 1, j
+ sum2 = sum2 + fjac(i,j) * ( qtf(i) / fnorm )
+ end do
+ gnorm = max ( gnorm, abs ( sum2 / wa2(l) ) )
+ end if
+
+ end do
+
+ end if
+!
+! Test for convergence of the gradient norm.
+!
+ if ( gnorm <= gtol ) then
+ info = 4
+ go to 300
+ end if
+!
+! Rescale if necessary.
+!
+ if ( mode /= 2 ) then
+ do j = 1, n
+ diag(j) = max ( diag(j), wa2(j) )
+ end do
+ end if
+!
+! Beginning of the inner loop.
+!
+200 continue
+!
+! Determine the Levenberg-Marquardt parameter.
+!
+ call lmpar ( n, fjac, ldfjac, ipvt, diag, qtf, delta, par, wa1, wa2 )
+!
+! Store the direction P and X + P.
+! Calculate the norm of P.
+!
+ wa1(1:n) = -wa1(1:n)
+ wa2(1:n) = x(1:n) + wa1(1:n)
+ wa3(1:n) = diag(1:n) * wa1(1:n)
+
+ pnorm = enorm ( n, wa3 )
+!
+! On the first iteration, adjust the initial step bound.
+!
+ if ( iter == 1 ) then
+ delta = min ( delta, pnorm )
+ end if
+!
+! Evaluate the function at X + P and calculate its norm.
+!
+ iflag = 1
+ call fcn ( m, n, wa2, wa4, iflag )
+ nfev = nfev + 1
+ if ( iflag < 0 ) then
+ go to 300
+ end if
+ fnorm1 = enorm ( m, wa4 )
+!
+! Compute the scaled actual reduction.
+!
+ if ( 0.1D+00 * fnorm1 < fnorm ) then
+ actred = 1.0D+00 - ( fnorm1 / fnorm ) ** 2
+ else
+ actred = -1.0D+00
+ end if
+!
+! Compute the scaled predicted reduction and the scaled directional derivative.
+!
+ do j = 1, n
+ wa3(j) = 0.0D+00
+ l = ipvt(j)
+ temp = wa1(l)
+ wa3(1:j) = wa3(1:j) + fjac(1:j,j) * temp
+ end do
+
+ temp1 = enorm ( n, wa3 ) / fnorm
+ temp2 = ( sqrt ( par ) * pnorm ) / fnorm
+ prered = temp1 ** 2 + temp2 ** 2 / 0.5D+00
+ dirder = - ( temp1 ** 2 + temp2 ** 2 )
+!
+! Compute the ratio of the actual to the predicted reduction.
+!
+ ratio = 0.0D+00
+ if ( prered /= 0.0D+00 ) then
+ ratio = actred / prered
+ end if
+!
+! Update the step bound.
+!
+ if ( ratio <= 0.25D+00 ) then
+
+ if ( actred >= 0.0D+00 ) then
+ temp = 0.5D+00
+ endif
+
+ if ( actred < 0.0D+00 ) then
+ temp = 0.5D+00 * dirder / ( dirder + 0.5D+00 * actred )
+ end if
+
+ if ( 0.1D+00 * fnorm1 >= fnorm .or. temp < 0.1D+00 ) then
+ temp = 0.1D+00
+ end if
+
+ delta = temp * min ( delta, pnorm / 0.1D+00 )
+ par = par / temp
+
+ else
+
+ if ( par == 0.0D+00 .or. ratio >= 0.75D+00 ) then
+ delta = 2.0D+00 * pnorm
+ par = 0.5D+00 * par
+ end if
+
+ end if
+!
+! Test for successful iteration.
+!
+
+!
+! Successful iteration. update X, FVEC, and their norms.
+!
+ if ( 0.0001D+00 <= ratio ) then
+ x(1:n) = wa2(1:n)
+ wa2(1:n) = diag(1:n) * x(1:n)
+ fvec(1:m) = wa4(1:m)
+ xnorm = enorm ( n, wa2 )
+ fnorm = fnorm1
+ iter = iter + 1
+ end if
+!
+! Tests for convergence.
+!
+ if ( abs ( actred) <= ftol .and. prered <= ftol &
+ .and. 0.5D+00 * ratio <= 1.0D+00 ) then
+ info = 1
+ end if
+
+ if ( delta <= xtol * xnorm ) then
+ info = 2
+ end if
+
+ if ( abs ( actred) <= ftol .and. prered <= ftol &
+ .and. 0.5D+00 * ratio <= 1.0D+00 .and. info == 2 ) info = 3
+
+ if ( info /= 0 ) then
+ go to 300
+ end if
+!
+! Tests for termination and stringent tolerances.
+!
+ if ( maxfev <= nfev ) then
+ info = 5
+ end if
+
+ if ( abs ( actred) <= epsmch .and. prered <= epsmch &
+ .and. 0.5D+00 * ratio <= 1.0D+00 ) then
+ info = 6
+ end if
+
+ if ( delta <= epsmch * xnorm ) then
+ info = 7
+ end if
+
+ if ( gnorm <= epsmch ) then
+ info = 8
+ end if
+
+ if ( info /= 0 ) then
+ go to 300
+ end if
+!
+! End of the inner loop. Repeat if iteration unsuccessful.
+!
+ if ( ratio < 0.0001D+00 ) then
+ go to 200
+ end if
+!
+! End of the outer loop.
+!
+ go to 30
+
+300 continue
+!
+! Termination, either normal or user imposed.
+!
+ if ( iflag < 0 ) then
+ info = iflag
+ end if
+
+ iflag = 0
+
+ if ( 0 < nprint ) then
+ call fcn ( m, n, x, fvec, iflag )
+ end if
+
+ return
+end
+subroutine lmdif1 ( fcn, m, n, x, fvec, tol, info )
+
+!*****************************************************************************80
+!
+!! LMDIF1 minimizes M functions in N variables using Levenberg-Marquardt method.
+!
+! Discussion:
+!
+! LMDIF1 minimizes the sum of the squares of M nonlinear functions in
+! N variables by a modification of the Levenberg-Marquardt algorithm.
+! This is done by using the more general least-squares solver LMDIF.
+! The user must provide a subroutine which calculates the functions.
+! The jacobian is then calculated by a forward-difference approximation.
+!
+! Licensing:
+!
+! This code is distributed under the GNU LGPL license.
+!
+! Modified:
+!
+! 06 April 2010
+!
+! Author:
+!
+! Original FORTRAN77 version by Jorge More, Burton Garbow, Kenneth Hillstrom.
+! FORTRAN90 version by John Burkardt.
+!
+! Reference:
+!
+! Jorge More, Burton Garbow, Kenneth Hillstrom,
+! User Guide for MINPACK-1,
+! Technical Report ANL-80-74,
+! Argonne National Laboratory, 1980.
+!
+! Parameters:
+!
+! Input, external FCN, the name of the user-supplied subroutine which
+! calculates the functions. The routine should have the form:
+! subroutine fcn ( m, n, x, fvec, iflag )
+! integer ( kind = 4 ) n
+! real ( kind = 8 ) fvec(m)
+! integer ( kind = 4 ) iflag
+! real ( kind = 8 ) x(n)
+!
+! If IFLAG = 0 on input, then FCN is only being called to allow the user
+! to print out the current iterate.
+! If IFLAG = 1 on input, FCN should calculate the functions at X and
+! return this vector in FVEC.
+! To terminate the algorithm, FCN may set IFLAG negative on return.
+!
+! Input, integer ( kind = 4 ) M, the number of functions.
+!
+! Input, integer ( kind = 4 ) N, the number of variables.
+! N must not exceed M.
+!
+! Input/output, real ( kind = 8 ) X(N). On input, X must contain an initial
+! estimate of the solution vector. On output X contains the final
+! estimate of the solution vector.
+!
+! Output, real ( kind = 8 ) FVEC(M), the functions evaluated at the output X.
+!
+! Input, real ( kind = 8 ) TOL. Termination occurs when the algorithm
+! estimates either that the relative error in the sum of squares is at
+! most TOL or that the relative error between X and the solution is at
+! most TOL. TOL should be nonnegative.
+!
+! Output, integer ( kind = 4 ) INFO, error flag. If the user has terminated
+! execution, INFO is set to the (negative) value of IFLAG. See description
+! of FCN. Otherwise, INFO is set as follows:
+! 0, improper input parameters.
+! 1, algorithm estimates that the relative error in the sum of squares
+! is at most TOL.
+! 2, algorithm estimates that the relative error between X and the
+! solution is at most TOL.
+! 3, conditions for INFO = 1 and INFO = 2 both hold.
+! 4, FVEC is orthogonal to the columns of the jacobian to machine precision.
+! 5, number of calls to FCN has reached or exceeded 200*(N+1).
+! 6, TOL is too small. No further reduction in the sum of squares
+! is possible.
+! 7, TOL is too small. No further improvement in the approximate
+! solution X is possible.
+!
+ implicit none
+
+ integer ( kind = 4 ) m
+ integer ( kind = 4 ) n
+
+ real ( kind = 8 ) diag(n)
+ real ( kind = 8 ) epsfcn
+ real ( kind = 8 ) factor
+ external fcn
+ real ( kind = 8 ) fjac(m,n)
+ real ( kind = 8 ) ftol
+ real ( kind = 8 ) fvec(m)
+ real ( kind = 8 ) gtol
+ integer ( kind = 4 ) info
+ integer ( kind = 4 ) ipvt(n)
+ integer ( kind = 4 ) ldfjac
+ integer ( kind = 4 ) maxfev
+ integer ( kind = 4 ) mode
+ integer ( kind = 4 ) nfev
+ integer ( kind = 4 ) nprint
+ real ( kind = 8 ) qtf(n)
+ real ( kind = 8 ) tol
+ real ( kind = 8 ) x(n)
+ real ( kind = 8 ) xtol
+
+ info = 0
+
+ if ( n <= 0 ) then
+ return
+ else if ( m < n ) then
+ return
+ else if ( tol < 0.0D+00 ) then
+ return
+ end if
+
+ ! *** BVIE BEGIN ***
+ !factor = 100.0D+00
+ factor = 0.1D+00
+ ! *** BVIE END ***
+ maxfev = 200 * ( n + 1 )
+ ftol = tol
+ xtol = tol
+ gtol = 0.0D+00
+ epsfcn = 0.0D+00
+ mode = 1
+ nprint = 0
+ ldfjac = m
+
+ call lmdif ( fcn, m, n, x, fvec, ftol, xtol, gtol, maxfev, epsfcn, &
+ diag, mode, factor, nprint, info, nfev, fjac, ldfjac, ipvt, qtf )
+
+ if ( info == 8 ) then
+ info = 4
+ end if
+
+ return
+end
+subroutine lmpar ( n, r, ldr, ipvt, diag, qtb, delta, par, x, sdiag )
+
+!*****************************************************************************80
+!
+!! LMPAR computes a parameter for the Levenberg-Marquardt method.
+!
+! Discussion:
+!
+! Given an M by N matrix A, an N by N nonsingular diagonal
+! matrix D, an M-vector B, and a positive number DELTA,
+! the problem is to determine a value for the parameter
+! PAR such that if X solves the system
+!
+! A*X = B,
+! sqrt ( PAR ) * D * X = 0,
+!
+! in the least squares sense, and DXNORM is the euclidean
+! norm of D*X, then either PAR is zero and
+!
+! ( DXNORM - DELTA ) <= 0.1 * DELTA,
+!
+! or PAR is positive and
+!
+! abs ( DXNORM - DELTA) <= 0.1 * DELTA.
+!
+! This subroutine completes the solution of the problem
+! if it is provided with the necessary information from the
+! QR factorization, with column pivoting, of A. That is, if
+! A*P = Q*R, where P is a permutation matrix, Q has orthogonal
+! columns, and R is an upper triangular matrix with diagonal
+! elements of nonincreasing magnitude, then LMPAR expects
+! the full upper triangle of R, the permutation matrix P,
+! and the first N components of Q'*B. On output
+! LMPAR also provides an upper triangular matrix S such that
+!
+! P' * ( A' * A + PAR * D * D ) * P = S'* S.
+!
+! S is employed within LMPAR and may be of separate interest.
+!
+! Only a few iterations are generally needed for convergence
+! of the algorithm. If, however, the limit of 10 iterations
+! is reached, then the output PAR will contain the best
+! value obtained so far.
+!
+! Licensing:
+!
+! This code is distributed under the GNU LGPL license.
+!
+! Modified:
+!
+! 24 January 2014
+!
+! Author:
+!
+! Original FORTRAN77 version by Jorge More, Burton Garbow, Kenneth Hillstrom.
+! FORTRAN90 version by John Burkardt.
+!
+! Reference:
+!
+! Jorge More, Burton Garbow, Kenneth Hillstrom,
+! User Guide for MINPACK-1,
+! Technical Report ANL-80-74,
+! Argonne National Laboratory, 1980.
+!
+! Parameters:
+!
+! Input, integer ( kind = 4 ) N, the order of R.
+!
+! Input/output, real ( kind = 8 ) R(LDR,N),the N by N matrix. The full
+! upper triangle must contain the full upper triangle of the matrix R.
+! On output the full upper triangle is unaltered, and the strict lower
+! triangle contains the strict upper triangle (transposed) of the upper
+! triangular matrix S.
+!
+! Input, integer ( kind = 4 ) LDR, the leading dimension of R. LDR must be
+! no less than N.
+!
+! Input, integer ( kind = 4 ) IPVT(N), defines the permutation matrix P
+! such that A*P = Q*R. Column J of P is column IPVT(J) of the
+! identity matrix.
+!
+! Input, real ( kind = 8 ) DIAG(N), the diagonal elements of the matrix D.
+!
+! Input, real ( kind = 8 ) QTB(N), the first N elements of the vector Q'*B.
+!
+! Input, real ( kind = 8 ) DELTA, an upper bound on the euclidean norm
+! of D*X. DELTA should be positive.
+!
+! Input/output, real ( kind = 8 ) PAR. On input an initial estimate of the
+! Levenberg-Marquardt parameter. On output the final estimate.
+! PAR should be nonnegative.
+!
+! Output, real ( kind = 8 ) X(N), the least squares solution of the system
+! A*X = B, sqrt(PAR)*D*X = 0, for the output value of PAR.
+!
+! Output, real ( kind = 8 ) SDIAG(N), the diagonal elements of the upper
+! triangular matrix S.
+!
+ implicit none
+
+ integer ( kind = 4 ) ldr
+ integer ( kind = 4 ) n
+
+ real ( kind = 8 ) delta
+ real ( kind = 8 ) diag(n)
+ real ( kind = 8 ) dwarf
+ real ( kind = 8 ) dxnorm
+ real ( kind = 8 ) enorm
+ real ( kind = 8 ) gnorm
+ real ( kind = 8 ) fp
+ integer ( kind = 4 ) i
+ integer ( kind = 4 ) ipvt(n)
+ integer ( kind = 4 ) iter
+ integer ( kind = 4 ) j
+ integer ( kind = 4 ) k
+ integer ( kind = 4 ) l
+ integer ( kind = 4 ) nsing
+ real ( kind = 8 ) par
+ real ( kind = 8 ) parc
+ real ( kind = 8 ) parl
+ real ( kind = 8 ) paru
+ real ( kind = 8 ) qnorm
+ real ( kind = 8 ) qtb(n)
+ real ( kind = 8 ) r(ldr,n)
+ real ( kind = 8 ) sdiag(n)
+ real ( kind = 8 ) sum2
+ real ( kind = 8 ) temp
+ real ( kind = 8 ) wa1(n)
+ real ( kind = 8 ) wa2(n)
+ real ( kind = 8 ) x(n)
+!
+! DWARF is the smallest positive magnitude.
+!
+ dwarf = tiny ( dwarf )
+!
+! Compute and store in X the Gauss-Newton direction.
+!
+! If the jacobian is rank-deficient, obtain a least squares solution.
+!
+ nsing = n
+
+ do j = 1, n
+ wa1(j) = qtb(j)
+ if ( r(j,j) == 0.0D+00 .and. nsing == n ) then
+ nsing = j - 1
+ end if
+ if ( nsing < n ) then
+ wa1(j) = 0.0D+00
+ end if
+ end do
+
+ do k = 1, nsing
+ j = nsing - k + 1
+ wa1(j) = wa1(j) / r(j,j)
+ temp = wa1(j)
+ wa1(1:j-1) = wa1(1:j-1) - r(1:j-1,j) * temp
+ end do
+
+ do j = 1, n
+ l = ipvt(j)
+ x(l) = wa1(j)
+ end do
+!
+! Initialize the iteration counter.
+! Evaluate the function at the origin, and test
+! for acceptance of the Gauss-Newton direction.
+!
+ iter = 0
+ wa2(1:n) = diag(1:n) * x(1:n)
+ dxnorm = enorm ( n, wa2 )
+ fp = dxnorm - delta
+
+ if ( fp <= 0.1D+00 * delta ) then
+ if ( iter == 0 ) then
+ par = 0.0D+00
+ end if
+ return
+ end if
+!
+! If the jacobian is not rank deficient, the Newton
+! step provides a lower bound, PARL, for the zero of
+! the function.
+!
+! Otherwise set this bound to zero.
+!
+ parl = 0.0D+00
+
+ if ( n <= nsing ) then
+
+ do j = 1, n
+ l = ipvt(j)
+ wa1(j) = diag(l) * ( wa2(l) / dxnorm )
+ end do
+
+ do j = 1, n
+ sum2 = dot_product ( wa1(1:j-1), r(1:j-1,j) )
+ wa1(j) = ( wa1(j) - sum2 ) / r(j,j)
+ end do
+
+ temp = enorm ( n, wa1 )
+ parl = ( ( fp / delta ) / temp ) / temp
+
+ end if
+!
+! Calculate an upper bound, PARU, for the zero of the function.
+!
+ do j = 1, n
+ sum2 = dot_product ( qtb(1:j), r(1:j,j) )
+ l = ipvt(j)
+ wa1(j) = sum2 / diag(l)
+ end do
+
+ gnorm = enorm ( n, wa1 )
+ paru = gnorm / delta
+
+ if ( paru == 0.0D+00 ) then
+ paru = dwarf / min ( delta, 0.1D+00 )
+ end if
+!
+! If the input PAR lies outside of the interval (PARL, PARU),
+! set PAR to the closer endpoint.
+!
+ par = max ( par, parl )
+ par = min ( par, paru )
+ if ( par == 0.0D+00 ) then
+ par = gnorm / dxnorm
+ end if
+!
+! Beginning of an iteration.
+!
+ do
+
+ iter = iter + 1
+!
+! Evaluate the function at the current value of PAR.
+!
+ if ( par == 0.0D+00 ) then
+ par = max ( dwarf, 0.001D+00 * paru )
+ end if
+
+ wa1(1:n) = sqrt ( par ) * diag(1:n)
+
+ call qrsolv ( n, r, ldr, ipvt, wa1, qtb, x, sdiag )
+
+ wa2(1:n) = diag(1:n) * x(1:n)
+ dxnorm = enorm ( n, wa2 )
+ temp = fp
+ fp = dxnorm - delta
+!
+! If the function is small enough, accept the current value of PAR.
+!
+ if ( abs ( fp ) <= 0.1D+00 * delta ) then
+ exit
+ end if
+!
+! Test for the exceptional cases where PARL
+! is zero or the number of iterations has reached 10.
+!
+ if ( parl == 0.0D+00 .and. fp <= temp .and. temp < 0.0D+00 ) then
+ exit
+ else if ( iter == 10 ) then
+ exit
+ end if
+!
+! Compute the Newton correction.
+!
+ do j = 1, n
+ l = ipvt(j)
+ wa1(j) = diag(l) * ( wa2(l) / dxnorm )
+ end do
+
+ do j = 1, n
+ wa1(j) = wa1(j) / sdiag(j)
+ temp = wa1(j)
+ wa1(j+1:n) = wa1(j+1:n) - r(j+1:n,j) * temp
+ end do
+
+ temp = enorm ( n, wa1 )
+ parc = ( ( fp / delta ) / temp ) / temp
+!
+! Depending on the sign of the function, update PARL or PARU.
+!
+ if ( 0.0D+00 < fp ) then
+ parl = max ( parl, par )
+ else if ( fp < 0.0D+00 ) then
+ paru = min ( paru, par )
+ end if
+!
+! Compute an improved estimate for PAR.
+!
+ par = max ( parl, par + parc )
+!
+! End of an iteration.
+!
+ end do
+!
+! Termination.
+!
+ if ( iter == 0 ) then
+ par = 0.0D+00
+ end if
+
+ return
+end
+subroutine lmstr ( fcn, m, n, x, fvec, fjac, ldfjac, ftol, xtol, gtol, maxfev, &
+ diag, mode, factor, nprint, info, nfev, njev, ipvt, qtf )
+
+!*****************************************************************************80
+!
+!! LMSTR minimizes M functions in N variables using Levenberg-Marquardt method.
+!
+! Discussion:
+!
+! LMSTR minimizes the sum of the squares of M nonlinear functions in
+! N variables by a modification of the Levenberg-Marquardt algorithm
+! which uses minimal storage.
+!
+! The user must provide a subroutine which calculates the functions and
+! the rows of the jacobian.
+!
+! Licensing:
+!
+! This code is distributed under the GNU LGPL license.
+!
+! Modified:
+!
+! 06 April 2010
+!
+! Author:
+!
+! Original FORTRAN77 version by Jorge More, Burton Garbow, Kenneth Hillstrom.
+! FORTRAN90 version by John Burkardt.
+!
+! Reference:
+!
+! Jorge More, Burton Garbow, Kenneth Hillstrom,
+! User Guide for MINPACK-1,
+! Technical Report ANL-80-74,
+! Argonne National Laboratory, 1980.
+!
+! Parameters:
+!
+! Input, external FCN, the name of the user-supplied subroutine which
+! calculates the functions and the rows of the jacobian.
+! FCN should have the form:
+! subroutine fcn ( m, n, x, fvec, fjrow, iflag )
+! integer ( kind = 4 ) m
+! integer ( kind = 4 ) n
+! real ( kind = 8 ) fjrow(n)
+! real ( kind = 8 ) fvec(m)
+! integer ( kind = 4 ) iflag
+! real ( kind = 8 ) x(n)
+! If IFLAG = 0 on input, then FCN is only being called to allow the user
+! to print out the current iterate.
+! If IFLAG = 1 on input, FCN should calculate the functions at X and
+! return this vector in FVEC.
+! If the input value of IFLAG is I > 1, calculate the (I-1)-st row of
+! the jacobian at X, and return this vector in FJROW.
+! To terminate the algorithm, set the output value of IFLAG negative.
+!
+! Input, integer ( kind = 4 ) M, the number of functions.
+!
+! Input, integer ( kind = 4 ) N, the number of variables.
+! N must not exceed M.
+!
+! Input/output, real ( kind = 8 ) X(N). On input, X must contain an initial
+! estimate of the solution vector. On output X contains the final
+! estimate of the solution vector.
+!
+! Output, real ( kind = 8 ) FVEC(M), the functions evaluated at the output X.
+!
+! Output, real ( kind = 8 ) FJAC(LDFJAC,N), an N by N array. The upper
+! triangle of FJAC contains an upper triangular matrix R such that
+!
+! P' * ( JAC' * JAC ) * P = R' * R,
+!
+! where P is a permutation matrix and JAC is the final calculated jacobian.
+! Column J of P is column IPVT(J) of the identity matrix. The lower
+! triangular part of FJAC contains information generated during
+! the computation of R.
+!
+! Input, integer ( kind = 4 ) LDFJAC, the leading dimension of FJAC.
+! LDFJAC must be at least N.
+!
+! Input, real ( kind = 8 ) FTOL. Termination occurs when both the actual and
+! predicted relative reductions in the sum of squares are at most FTOL.
+! Therefore, FTOL measures the relative error desired in the sum of
+! squares. FTOL should be nonnegative.
+!
+! Input, real ( kind = 8 ) XTOL. Termination occurs when the relative error
+! between two consecutive iterates is at most XTOL. XTOL should be
+! nonnegative.
+!
+! Input, real ( kind = 8 ) GTOL. termination occurs when the cosine of the
+! angle between FVEC and any column of the jacobian is at most GTOL in
+! absolute value. Therefore, GTOL measures the orthogonality desired
+! between the function vector and the columns of the jacobian. GTOL should
+! be nonnegative.
+!
+! Input, integer ( kind = 4 ) MAXFEV. Termination occurs when the number
+! of calls to FCN with IFLAG = 1 is at least MAXFEV by the end of
+! an iteration.
+!
+! Input/output, real ( kind = 8 ) DIAG(N). If MODE = 1, then DIAG is set
+! internally. If MODE = 2, then DIAG must contain positive entries that
+! serve as multiplicative scale factors for the variables.
+!
+! Input, integer ( kind = 4 ) MODE, scaling option.
+! 1, variables will be scaled internally.
+! 2, scaling is specified by the input DIAG vector.
+!
+! Input, real ( kind = 8 ) FACTOR, determines the initial step bound. This
+! bound is set to the product of FACTOR and the euclidean norm of DIAG*X if
+! nonzero, or else to FACTOR itself. In most cases, FACTOR should lie
+! in the interval (0.1, 100) with 100 the recommended value.
+!
+! Input, integer ( kind = 4 ) NPRINT, enables controlled printing of iterates
+! if it is positive. In this case, FCN is called with IFLAG = 0 at the
+! beginning of the first iteration and every NPRINT iterations thereafter
+! and immediately prior to return, with X and FVEC available
+! for printing. If NPRINT is not positive, no special calls
+! of FCN with IFLAG = 0 are made.
+!
+! Output, integer ( kind = 4 ) INFO, error flag. If the user has terminated
+! execution, INFO is set to the (negative) value of IFLAG. See the
+! description of FCN. Otherwise, INFO is set as follows:
+! 0, improper input parameters.
+! 1, both actual and predicted relative reductions in the sum of squares
+! are at most FTOL.
+! 2, relative error between two consecutive iterates is at most XTOL.
+! 3, conditions for INFO = 1 and INFO = 2 both hold.
+! 4, the cosine of the angle between FVEC and any column of the jacobian
+! is at most GTOL in absolute value.
+! 5, number of calls to FCN with IFLAG = 1 has reached MAXFEV.
+! 6, FTOL is too small. No further reduction in the sum of squares is
+! possible.
+! 7, XTOL is too small. No further improvement in the approximate
+! solution X is possible.
+! 8, GTOL is too small. FVEC is orthogonal to the columns of the
+! jacobian to machine precision.
+!
+! Output, integer ( kind = 4 ) NFEV, the number of calls to FCN
+! with IFLAG = 1.
+!
+! Output, integer ( kind = 4 ) NJEV, the number of calls to FCN
+! with IFLAG = 2.
+!
+! Output, integer ( kind = 4 ) IPVT(N), defines a permutation matrix P such
+! that JAC * P = Q * R, where JAC is the final calculated jacobian, Q is
+! orthogonal (not stored), and R is upper triangular.
+! Column J of P is column IPVT(J) of the identity matrix.
+!
+! Output, real ( kind = 8 ) QTF(N), contains the first N elements of Q'*FVEC.
+!
+ implicit none
+
+ integer ( kind = 4 ) ldfjac
+ integer ( kind = 4 ) m
+ integer ( kind = 4 ) n
+
+ real ( kind = 8 ) actred
+ real ( kind = 8 ) delta
+ real ( kind = 8 ) diag(n)
+ real ( kind = 8 ) dirder
+ real ( kind = 8 ) enorm
+ real ( kind = 8 ) epsmch
+ real ( kind = 8 ) factor
+ external fcn
+ real ( kind = 8 ) fjac(ldfjac,n)
+ real ( kind = 8 ) fnorm
+ real ( kind = 8 ) fnorm1
+ real ( kind = 8 ) ftol
+ real ( kind = 8 ) fvec(m)
+ real ( kind = 8 ) gnorm
+ real ( kind = 8 ) gtol
+ integer ( kind = 4 ) i
+ integer ( kind = 4 ) iflag
+ integer ( kind = 4 ) info
+ integer ( kind = 4 ) ipvt(n)
+ integer ( kind = 4 ) iter
+ integer ( kind = 4 ) j
+ integer ( kind = 4 ) l
+ integer ( kind = 4 ) maxfev
+ integer ( kind = 4 ) mode
+ integer ( kind = 4 ) nfev
+ integer ( kind = 4 ) njev
+ integer ( kind = 4 ) nprint
+ real ( kind = 8 ) par
+ logical pivot
+ real ( kind = 8 ) pnorm
+ real ( kind = 8 ) prered
+ real ( kind = 8 ) qtf(n)
+ real ( kind = 8 ) ratio
+ logical sing
+ real ( kind = 8 ) sum2
+ real ( kind = 8 ) temp
+ real ( kind = 8 ) temp1
+ real ( kind = 8 ) temp2
+ real ( kind = 8 ) wa1(n)
+ real ( kind = 8 ) wa2(n)
+ real ( kind = 8 ) wa3(n)
+ real ( kind = 8 ) wa4(m)
+ real ( kind = 8 ) x(n)
+ real ( kind = 8 ) xnorm
+ real ( kind = 8 ) xtol
+
+ epsmch = epsilon ( epsmch )
+
+ info = 0
+ iflag = 0
+ nfev = 0
+ njev = 0
+!
+! Check the input parameters for errors.
+!
+ if ( n <= 0 ) then
+ go to 340
+ else if ( m < n ) then
+ go to 340
+ else if ( ldfjac < n ) then
+ go to 340
+ else if ( ftol < 0.0D+00 ) then
+ go to 340
+ else if ( xtol < 0.0D+00 ) then
+ go to 340
+ else if ( gtol < 0.0D+00 ) then
+ go to 340
+ else if ( maxfev <= 0 ) then
+ go to 340
+ else if ( factor <= 0.0D+00 ) then
+ go to 340
+ end if
+
+ if ( mode == 2 ) then
+ do j = 1, n
+ if ( diag(j) <= 0.0D+00 ) then
+ go to 340
+ end if
+ end do
+ end if
+!
+! Evaluate the function at the starting point and calculate its norm.
+!
+ iflag = 1
+ call fcn ( m, n, x, fvec, wa3, iflag )
+ nfev = 1
+
+ if ( iflag < 0 ) then
+ go to 340
+ end if
+
+ fnorm = enorm ( m, fvec )
+!
+! Initialize Levenberg-Marquardt parameter and iteration counter.
+!
+ par = 0.0D+00
+ iter = 1
+!
+! Beginning of the outer loop.
+!
+ 30 continue
+!
+! If requested, call FCN to enable printing of iterates.
+!
+ if ( 0 < nprint ) then
+ iflag = 0
+ if ( mod ( iter-1, nprint ) == 0 ) then
+ call fcn ( m, n, x, fvec, wa3, iflag )
+ end if
+ if ( iflag < 0 ) then
+ go to 340
+ end if
+ end if
+!
+! Compute the QR factorization of the jacobian matrix calculated one row
+! at a time, while simultaneously forming Q'* FVEC and storing
+! the first N components in QTF.
+!
+ qtf(1:n) = 0.0D+00
+ fjac(1:n,1:n) = 0.0D+00
+ iflag = 2
+
+ do i = 1, m
+ call fcn ( m, n, x, fvec, wa3, iflag )
+ if ( iflag < 0 ) then
+ go to 340
+ end if
+ temp = fvec(i)
+ call rwupdt ( n, fjac, ldfjac, wa3, qtf, temp, wa1, wa2 )
+ iflag = iflag + 1
+ end do
+
+ njev = njev + 1
+!
+! If the jacobian is rank deficient, call QRFAC to
+! reorder its columns and update the components of QTF.
+!
+ sing = .false.
+ do j = 1, n
+ if ( fjac(j,j) == 0.0D+00 ) then
+ sing = .true.
+ end if
+ ipvt(j) = j
+ wa2(j) = enorm ( j, fjac(1,j) )
+ end do
+
+ if ( sing ) then
+
+ pivot = .true.
+ call qrfac ( n, n, fjac, ldfjac, pivot, ipvt, n, wa1, wa2 )
+
+ do j = 1, n
+
+ if ( fjac(j,j) /= 0.0D+00 ) then
+
+ sum2 = dot_product ( qtf(j:n), fjac(j:n,j) )
+ temp = - sum2 / fjac(j,j)
+ qtf(j:n) = qtf(j:n) + fjac(j:n,j) * temp
+
+ end if
+
+ fjac(j,j) = wa1(j)
+
+ end do
+
+ end if
+!
+! On the first iteration
+! if mode is 1,
+! scale according to the norms of the columns of the initial jacobian.
+! calculate the norm of the scaled X,
+! initialize the step bound delta.
+!
+ if ( iter == 1 ) then
+
+ if ( mode /= 2 ) then
+
+ diag(1:n) = wa2(1:n)
+ do j = 1, n
+ if ( wa2(j) == 0.0D+00 ) then
+ diag(j) = 1.0D+00
+ end if
+ end do
+
+ end if
+
+ wa3(1:n) = diag(1:n) * x(1:n)
+ xnorm = enorm ( n, wa3 )
+ delta = factor * xnorm
+ if ( delta == 0.0D+00 ) then
+ delta = factor
+ end if
+
+ end if
+!
+! Compute the norm of the scaled gradient.
+!
+ gnorm = 0.0D+00
+
+ if ( fnorm /= 0.0D+00 ) then
+
+ do j = 1, n
+ l = ipvt(j)
+ if ( wa2(l) /= 0.0D+00 ) then
+ sum2 = dot_product ( qtf(1:j), fjac(1:j,j) ) / fnorm
+ gnorm = max ( gnorm, abs ( sum2 / wa2(l) ) )
+ end if
+ end do
+
+ end if
+!
+! Test for convergence of the gradient norm.
+!
+ if ( gnorm <= gtol ) then
+ info = 4
+ go to 340
+ end if
+!
+! Rescale if necessary.
+!
+ if ( mode /= 2 ) then
+ do j = 1, n
+ diag(j) = max ( diag(j), wa2(j) )
+ end do
+ end if
+!
+! Beginning of the inner loop.
+!
+240 continue
+!
+! Determine the Levenberg-Marquardt parameter.
+!
+ call lmpar ( n, fjac, ldfjac, ipvt, diag, qtf, delta, par, wa1, wa2 )
+!
+! Store the direction P and X + P.
+! Calculate the norm of P.
+!
+ wa1(1:n) = -wa1(1:n)
+ wa2(1:n) = x(1:n) + wa1(1:n)
+ wa3(1:n) = diag(1:n) * wa1(1:n)
+ pnorm = enorm ( n, wa3 )
+!
+! On the first iteration, adjust the initial step bound.
+!
+ if ( iter == 1 ) then
+ delta = min ( delta, pnorm )
+ end if
+!
+! Evaluate the function at X + P and calculate its norm.
+!
+ iflag = 1
+ call fcn ( m, n, wa2, wa4, wa3, iflag )
+ nfev = nfev + 1
+ if ( iflag < 0 ) then
+ go to 340
+ end if
+ fnorm1 = enorm ( m, wa4 )
+!
+! Compute the scaled actual reduction.
+!
+ if ( 0.1D+00 * fnorm1 < fnorm ) then
+ actred = 1.0D+00 - ( fnorm1 / fnorm ) ** 2
+ else
+ actred = -1.0D+00
+ end if
+!
+! Compute the scaled predicted reduction and
+! the scaled directional derivative.
+!
+ do j = 1, n
+ wa3(j) = 0.0D+00
+ l = ipvt(j)
+ temp = wa1(l)
+ wa3(1:j) = wa3(1:j) + fjac(1:j,j) * temp
+ end do
+
+ temp1 = enorm ( n, wa3 ) / fnorm
+ temp2 = ( sqrt(par) * pnorm ) / fnorm
+ prered = temp1 ** 2 + temp2 ** 2 / 0.5D+00
+ dirder = - ( temp1 ** 2 + temp2 ** 2 )
+!
+! Compute the ratio of the actual to the predicted reduction.
+!
+ if ( prered /= 0.0D+00 ) then
+ ratio = actred / prered
+ else
+ ratio = 0.0D+00
+ end if
+!
+! Update the step bound.
+!
+ if ( ratio <= 0.25D+00 ) then
+
+ if ( actred >= 0.0D+00 ) then
+ temp = 0.5D+00
+ else
+ temp = 0.5D+00 * dirder / ( dirder + 0.5D+00 * actred )
+ end if
+
+ if ( 0.1D+00 * fnorm1 >= fnorm .or. temp < 0.1D+00 ) then
+ temp = 0.1D+00
+ end if
+
+ delta = temp * min ( delta, pnorm / 0.1D+00 )
+ par = par / temp
+
+ else
+
+ if ( par == 0.0D+00 .or. ratio >= 0.75D+00 ) then
+ delta = pnorm / 0.5D+00
+ par = 0.5D+00 * par
+ end if
+
+ end if
+!
+! Test for successful iteration.
+!
+ if ( ratio >= 0.0001D+00 ) then
+ x(1:n) = wa2(1:n)
+ wa2(1:n) = diag(1:n) * x(1:n)
+ fvec(1:m) = wa4(1:m)
+ xnorm = enorm ( n, wa2 )
+ fnorm = fnorm1
+ iter = iter + 1
+ end if
+!
+! Tests for convergence, termination and stringent tolerances.
+!
+ if ( abs ( actred ) <= ftol .and. prered <= ftol &
+ .and. 0.5D+00 * ratio <= 1.0D+00 ) then
+ info = 1
+ end if
+
+ if ( delta <= xtol * xnorm ) then
+ info = 2
+ end if
+
+ if ( abs ( actred ) <= ftol .and. prered <= ftol &
+ .and. 0.5D+00 * ratio <= 1.0D+00 .and. info == 2 ) then
+ info = 3
+ end if
+
+ if ( info /= 0 ) then
+ go to 340
+ end if
+
+ if ( nfev >= maxfev) then
+ info = 5
+ end if
+
+ if ( abs ( actred ) <= epsmch .and. prered <= epsmch &
+ .and. 0.5D+00 * ratio <= 1.0D+00 ) then
+ info = 6
+ end if
+
+ if ( delta <= epsmch * xnorm ) then
+ info = 7
+ end if
+
+ if ( gnorm <= epsmch ) then
+ info = 8
+ end if
+
+ if ( info /= 0 ) then
+ go to 340
+ end if
+!
+! End of the inner loop. Repeat if iteration unsuccessful.
+!
+ if ( ratio < 0.0001D+00 ) then
+ go to 240
+ end if
+!
+! End of the outer loop.
+!
+ go to 30
+
+ 340 continue
+!
+! Termination, either normal or user imposed.
+!
+ if ( iflag < 0 ) then
+ info = iflag
+ end if
+
+ iflag = 0
+
+ if ( 0 < nprint ) then
+ call fcn ( m, n, x, fvec, wa3, iflag )
+ end if
+
+ return
+end
+subroutine lmstr1 ( fcn, m, n, x, fvec, fjac, ldfjac, tol, info )
+
+!*****************************************************************************80
+!
+!! LMSTR1 minimizes M functions in N variables using Levenberg-Marquardt method.
+!
+! Discussion:
+!
+! LMSTR1 minimizes the sum of the squares of M nonlinear functions in
+! N variables by a modification of the Levenberg-Marquardt algorithm
+! which uses minimal storage.
+!
+! This is done by using the more general least-squares solver
+! LMSTR. The user must provide a subroutine which calculates
+! the functions and the rows of the jacobian.
+!
+! Licensing:
+!
+! This code is distributed under the GNU LGPL license.
+!
+! Modified:
+!
+! 19 August 2016
+!
+! Author:
+!
+! Original FORTRAN77 version by Jorge More, Burton Garbow, Kenneth Hillstrom.
+! FORTRAN90 version by John Burkardt.
+!
+! Reference:
+!
+! Jorge More, Burton Garbow, Kenneth Hillstrom,
+! User Guide for MINPACK-1,
+! Technical Report ANL-80-74,
+! Argonne National Laboratory, 1980.
+!
+! Parameters:
+!
+! Input, external FCN, the name of the user-supplied subroutine which
+! calculates the functions and the rows of the jacobian.
+! FCN should have the form:
+! subroutine fcn ( m, n, x, fvec, fjrow, iflag )
+! integer ( kind = 4 ) m
+! integer ( kind = 4 ) n
+! real ( kind = 8 ) fjrow(n)
+! real ( kind = 8 ) fvec(m)
+! integer ( kind = 4 ) iflag
+! real ( kind = 8 ) x(n)
+! If IFLAG = 0 on input, then FCN is only being called to allow the user
+! to print out the current iterate.
+! If IFLAG = 1 on input, FCN should calculate the functions at X and
+! return this vector in FVEC.
+! If the input value of IFLAG is I > 1, calculate the (I-1)-st row of
+! the jacobian at X, and return this vector in FJROW.
+! To terminate the algorithm, set the output value of IFLAG negative.
+!
+! Input, integer ( kind = 4 ) M, the number of functions.
+!
+! Input, integer ( kind = 4 ) N, the number of variables.
+! N must not exceed M.
+!
+! Input/output, real ( kind = 8 ) X(N). On input, X must contain an initial
+! estimate of the solution vector. On output X contains the final
+! estimate of the solution vector.
+!
+! Output, real ( kind = 8 ) FVEC(M), the functions evaluated at the output X.
+!
+! Output, real ( kind = 8 ) FJAC(LDFJAC,N), an N by N array. The upper
+! triangle contains an upper triangular matrix R such that
+!
+! P' * ( JAC' * JAC ) * P = R' * R,
+!
+! where P is a permutation matrix and JAC is the final calculated
+! jacobian. Column J of P is column IPVT(J) of the identity matrix.
+! The lower triangular part of FJAC contains information generated
+! during the computation of R.
+!
+! Input, integer ( kind = 4 ) LDFJAC, the leading dimension of FJAC.
+! LDFJAC must be at least N.
+!
+! Input, real ( kind = 8 ) TOL. Termination occurs when the algorithm
+! estimates either that the relative error in the sum of squares is at
+! most TOL or that the relative error between X and the solution is at
+! most TOL. TOL should be nonnegative.
+!
+! Output, integer ( kind = 4 ) INFO, error flag. If the user has terminated
+! execution, INFO is set to the (negative) value of IFLAG. See description
+! of FCN. Otherwise, INFO is set as follows:
+! 0, improper input parameters.
+! 1, algorithm estimates that the relative error in the sum of squares
+! is at most TOL.
+! 2, algorithm estimates that the relative error between X and the
+! solution is at most TOL.
+! 3, conditions for INFO = 1 and INFO = 2 both hold.
+! 4, FVEC is orthogonal to the columns of the jacobian to machine precision.
+! 5, number of calls to FCN with IFLAG = 1 has reached 100*(N+1).
+! 6, TOL is too small. No further reduction in the sum of squares
+! is possible.
+! 7, TOL is too small. No further improvement in the approximate
+! solution X is possible.
+!
+ implicit none
+
+ integer ( kind = 4 ) ldfjac
+ integer ( kind = 4 ) m
+ integer ( kind = 4 ) n
+
+ real ( kind = 8 ) diag(n)
+ real ( kind = 8 ) factor
+ external fcn
+ real ( kind = 8 ) fjac(ldfjac,n)
+ real ( kind = 8 ) ftol
+ real ( kind = 8 ) fvec(m)
+ real ( kind = 8 ) gtol
+ integer ( kind = 4 ) info
+ integer ( kind = 4 ) ipvt(n)
+ integer ( kind = 4 ) maxfev
+ integer ( kind = 4 ) mode
+ integer ( kind = 4 ) nfev
+ integer ( kind = 4 ) njev
+ integer ( kind = 4 ) nprint
+ real ( kind = 8 ) qtf(n)
+ real ( kind = 8 ) tol
+ real ( kind = 8 ) x(n)
+ real ( kind = 8 ) xtol
+
+ if ( n <= 0 ) then
+ info = 0
+ return
+ end if
+
+ if ( m < n ) then
+ info = 0
+ return
+ end if
+
+ if ( ldfjac < n ) then
+ info = 0
+ return
+ end if
+
+ if ( tol < 0.0D+00 ) then
+ info = 0
+ return
+ end if
+
+ fvec(1:n) = 0.0D+00
+ fjac(1:ldfjac,1:n) = 0.0D+00
+ ftol = tol
+ xtol = tol
+ gtol = 0.0D+00
+ maxfev = 100 * ( n + 1 )
+ diag(1:n) = 0.0D+00
+ mode = 1
+ factor = 100.0D+00
+ nprint = 0
+ info = 0
+ nfev = 0
+ njev = 0
+ ipvt(1:n) = 0
+ qtf(1:n) = 0.0D+00
+
+ call lmstr ( fcn, m, n, x, fvec, fjac, ldfjac, ftol, xtol, gtol, maxfev, &
+ diag, mode, factor, nprint, info, nfev, njev, ipvt, qtf )
+
+ if ( info == 8 ) then
+ info = 4
+ end if
+
+ return
+end
+subroutine qform ( m, n, q, ldq )
+
+!*****************************************************************************80
+!
+!! QFORM produces the explicit QR factorization of a matrix.
+!
+! Discussion:
+!
+! The QR factorization of a matrix is usually accumulated in implicit
+! form, that is, as a series of orthogonal transformations of the
+! original matrix. This routine carries out those transformations,
+! to explicitly exhibit the factorization constructed by QRFAC.
+!
+! Licensing:
+!
+! This code is distributed under the GNU LGPL license.
+!
+! Modified:
+!
+! 06 April 2010
+!
+! Author:
+!
+! Original FORTRAN77 version by Jorge More, Burton Garbow, Kenneth Hillstrom.
+! FORTRAN90 version by John Burkardt.
+!
+! Reference:
+!
+! Jorge More, Burton Garbow, Kenneth Hillstrom,
+! User Guide for MINPACK-1,
+! Technical Report ANL-80-74,
+! Argonne National Laboratory, 1980.
+!
+! Parameters:
+!
+! Input, integer ( kind = 4 ) M, is a positive integer input variable set
+! to the number of rows of A and the order of Q.
+!
+! Input, integer ( kind = 4 ) N, is a positive integer input variable set
+! to the number of columns of A.
+!
+! Input/output, real ( kind = 8 ) Q(LDQ,M). Q is an M by M array.
+! On input the full lower trapezoid in the first min(M,N) columns of Q
+! contains the factored form.
+! On output, Q has been accumulated into a square matrix.
+!
+! Input, integer ( kind = 4 ) LDQ, is a positive integer input variable
+! not less than M which specifies the leading dimension of the array Q.
+!
+ implicit none
+
+ integer ( kind = 4 ) ldq
+ integer ( kind = 4 ) m
+ integer ( kind = 4 ) n
+
+ integer ( kind = 4 ) j
+ integer ( kind = 4 ) k
+ integer ( kind = 4 ) l
+ integer ( kind = 4 ) minmn
+ real ( kind = 8 ) q(ldq,m)
+ real ( kind = 8 ) temp
+ real ( kind = 8 ) wa(m)
+
+ minmn = min ( m, n )
+
+ do j = 2, minmn
+ q(1:j-1,j) = 0.0D+00
+ end do
+!
+! Initialize remaining columns to those of the identity matrix.
+!
+ q(1:m,n+1:m) = 0.0D+00
+
+ do j = n+1, m
+ q(j,j) = 1.0D+00
+ end do
+!
+! Accumulate Q from its factored form.
+!
+ do l = 1, minmn
+
+ k = minmn - l + 1
+
+ wa(k:m) = q(k:m,k)
+
+ q(k:m,k) = 0.0D+00
+ q(k,k) = 1.0D+00
+
+ if ( wa(k) /= 0.0D+00 ) then
+
+ do j = k, m
+ temp = dot_product ( wa(k:m), q(k:m,j) ) / wa(k)
+ q(k:m,j) = q(k:m,j) - temp * wa(k:m)
+ end do
+
+ end if
+
+ end do
+
+ return
+end
+subroutine qrfac ( m, n, a, lda, pivot, ipvt, lipvt, rdiag, acnorm )
+
+!*****************************************************************************80
+!
+!! QRFAC computes a QR factorization using Householder transformations.
+!
+! Discussion:
+!
+! This subroutine uses Householder transformations with column
+! pivoting (optional) to compute a QR factorization of the
+! M by N matrix A. That is, QRFAC determines an orthogonal
+! matrix Q, a permutation matrix P, and an upper trapezoidal
+! matrix R with diagonal elements of nonincreasing magnitude,
+! such that A*P = Q*R. The Householder transformation for
+! column K, K = 1,2,...,min(M,N), is of the form
+!
+! I - ( 1 / U(K) ) * U * U'
+!
+! where U has zeros in the first K-1 positions. The form of
+! this transformation and the method of pivoting first
+! appeared in the corresponding LINPACK subroutine.
+!
+! Licensing:
+!
+! This code is distributed under the GNU LGPL license.
+!
+! Modified:
+!
+! 06 April 2010
+!
+! Author:
+!
+! Original FORTRAN77 version by Jorge More, Burton Garbow, Kenneth Hillstrom.
+! FORTRAN90 version by John Burkardt.
+!
+! Reference:
+!
+! Jorge More, Burton Garbow, Kenneth Hillstrom,
+! User Guide for MINPACK-1,
+! Technical Report ANL-80-74,
+! Argonne National Laboratory, 1980.
+!
+! Parameters:
+!
+! Input, integer ( kind = 4 ) M, the number of rows of A.
+!
+! Input, integer ( kind = 4 ) N, the number of columns of A.
+!
+! Input/output, real ( kind = 8 ) A(LDA,N), the M by N array.
+! On input, A contains the matrix for which the QR factorization is to
+! be computed. On output, the strict upper trapezoidal part of A contains
+! the strict upper trapezoidal part of R, and the lower trapezoidal
+! part of A contains a factored form of Q (the non-trivial elements of
+! the U vectors described above).
+!
+! Input, integer ( kind = 4 ) LDA, the leading dimension of A, which must
+! be no less than M.
+!
+! Input, logical PIVOT, is TRUE if column pivoting is to be carried out.
+!
+! Output, integer ( kind = 4 ) IPVT(LIPVT), defines the permutation matrix P
+! such that A*P = Q*R. Column J of P is column IPVT(J) of the identity
+! matrix. If PIVOT is false, IPVT is not referenced.
+!
+! Input, integer ( kind = 4 ) LIPVT, the dimension of IPVT, which should
+! be N if pivoting is used.
+!
+! Output, real ( kind = 8 ) RDIAG(N), contains the diagonal elements of R.
+!
+! Output, real ( kind = 8 ) ACNORM(N), the norms of the corresponding
+! columns of the input matrix A. If this information is not needed,
+! then ACNORM can coincide with RDIAG.
+!
+ implicit none
+
+ integer ( kind = 4 ) lda
+ integer ( kind = 4 ) lipvt
+ integer ( kind = 4 ) m
+ integer ( kind = 4 ) n
+
+ real ( kind = 8 ) a(lda,n)
+ real ( kind = 8 ) acnorm(n)
+ real ( kind = 8 ) ajnorm
+ real ( kind = 8 ) enorm
+ real ( kind = 8 ) epsmch
+ integer ( kind = 4 ) i
+ integer ( kind = 4 ) i4_temp
+ integer ( kind = 4 ) ipvt(lipvt)
+ integer ( kind = 4 ) j
+ integer ( kind = 4 ) k
+ integer ( kind = 4 ) kmax
+ integer ( kind = 4 ) minmn
+ logical pivot
+ real ( kind = 8 ) r8_temp(m)
+ real ( kind = 8 ) rdiag(n)
+ real ( kind = 8 ) temp
+ real ( kind = 8 ) wa(n)
+
+ epsmch = epsilon ( epsmch )
+!
+! Compute the initial column norms and initialize several arrays.
+!
+ do j = 1, n
+ acnorm(j) = enorm ( m, a(1:m,j) )
+ end do
+
+ rdiag(1:n) = acnorm(1:n)
+ wa(1:n) = acnorm(1:n)
+
+ if ( pivot ) then
+ do j = 1, n
+ ipvt(j) = j
+ end do
+ end if
+!
+! Reduce A to R with Householder transformations.
+!
+ minmn = min ( m, n )
+
+ do j = 1, minmn
+!
+! Bring the column of largest norm into the pivot position.
+!
+ if ( pivot ) then
+
+ kmax = j
+
+ do k = j, n
+ if ( rdiag(kmax) < rdiag(k) ) then
+ kmax = k
+ end if
+ end do
+
+ if ( kmax /= j ) then
+
+ r8_temp(1:m) = a(1:m,j)
+ a(1:m,j) = a(1:m,kmax)
+ a(1:m,kmax) = r8_temp(1:m)
+
+ rdiag(kmax) = rdiag(j)
+ wa(kmax) = wa(j)
+
+ i4_temp = ipvt(j)
+ ipvt(j) = ipvt(kmax)
+ ipvt(kmax) = i4_temp
+
+ end if
+
+ end if
+!
+! Compute the Householder transformation to reduce the
+! J-th column of A to a multiple of the J-th unit vector.
+!
+ ajnorm = enorm ( m-j+1, a(j,j) )
+
+ if ( ajnorm /= 0.0D+00 ) then
+
+ if ( a(j,j) < 0.0D+00 ) then
+ ajnorm = -ajnorm
+ end if
+
+ a(j:m,j) = a(j:m,j) / ajnorm
+ a(j,j) = a(j,j) + 1.0D+00
+!
+! Apply the transformation to the remaining columns and update the norms.
+!
+ do k = j + 1, n
+
+ temp = dot_product ( a(j:m,j), a(j:m,k) ) / a(j,j)
+
+ a(j:m,k) = a(j:m,k) - temp * a(j:m,j)
+
+ if ( pivot .and. rdiag(k) /= 0.0D+00 ) then
+
+ temp = a(j,k) / rdiag(k)
+ rdiag(k) = rdiag(k) * sqrt ( max ( 0.0D+00, 1.0D+00-temp ** 2 ) )
+
+ if ( 0.05D+00 * ( rdiag(k) / wa(k) ) ** 2 <= epsmch ) then
+ rdiag(k) = enorm ( m-j, a(j+1,k) )
+ wa(k) = rdiag(k)
+ end if
+
+ end if
+
+ end do
+
+ end if
+
+ rdiag(j) = - ajnorm
+
+ end do
+
+ return
+end
+subroutine qrsolv ( n, r, ldr, ipvt, diag, qtb, x, sdiag )
+
+!*****************************************************************************80
+!
+!! QRSOLV solves a rectangular linear system A*x=b in the least squares sense.
+!
+! Discussion:
+!
+! Given an M by N matrix A, an N by N diagonal matrix D,
+! and an M-vector B, the problem is to determine an X which
+! solves the system
+!
+! A*X = B
+! D*X = 0
+!
+! in the least squares sense.
+!
+! This subroutine completes the solution of the problem
+! if it is provided with the necessary information from the
+! QR factorization, with column pivoting, of A. That is, if
+! Q*P = Q*R, where P is a permutation matrix, Q has orthogonal
+! columns, and R is an upper triangular matrix with diagonal
+! elements of nonincreasing magnitude, then QRSOLV expects
+! the full upper triangle of R, the permutation matrix p,
+! and the first N components of Q'*B.
+!
+! The system is then equivalent to
+!
+! R*Z = Q'*B
+! P'*D*P*Z = 0
+!
+! where X = P*Z. If this system does not have full rank,
+! then a least squares solution is obtained. On output QRSOLV
+! also provides an upper triangular matrix S such that
+!
+! P'*(A'*A + D*D)*P = S'*S.
+!
+! S is computed within QRSOLV and may be of separate interest.
+!
+! Licensing:
+!
+! This code is distributed under the GNU LGPL license.
+!
+! Modified:
+!
+! 06 April 2010
+!
+! Author:
+!
+! Original FORTRAN77 version by Jorge More, Burton Garbow, Kenneth Hillstrom.
+! FORTRAN90 version by John Burkardt.
+!
+! Reference:
+!
+! Jorge More, Burton Garbow, Kenneth Hillstrom,
+! User Guide for MINPACK-1,
+! Technical Report ANL-80-74,
+! Argonne National Laboratory, 1980.
+!
+! Parameters:
+!
+! Input, integer ( kind = 4 ) N, the order of R.
+!
+! Input/output, real ( kind = 8 ) R(LDR,N), the N by N matrix.
+! On input the full upper triangle must contain the full upper triangle
+! of the matrix R. On output the full upper triangle is unaltered, and
+! the strict lower triangle contains the strict upper triangle
+! (transposed) of the upper triangular matrix S.
+!
+! Input, integer ( kind = 4 ) LDR, the leading dimension of R, which must be
+! at least N.
+!
+! Input, integer ( kind = 4 ) IPVT(N), defines the permutation matrix P such
+! that A*P = Q*R. Column J of P is column IPVT(J) of the identity matrix.
+!
+! Input, real ( kind = 8 ) DIAG(N), the diagonal elements of the matrix D.
+!
+! Input, real ( kind = 8 ) QTB(N), the first N elements of the vector Q'*B.
+!
+! Output, real ( kind = 8 ) X(N), the least squares solution.
+!
+! Output, real ( kind = 8 ) SDIAG(N), the diagonal elements of the upper
+! triangular matrix S.
+!
+ implicit none
+
+ integer ( kind = 4 ) ldr
+ integer ( kind = 4 ) n
+
+ real ( kind = 8 ) c
+ real ( kind = 8 ) cotan
+ real ( kind = 8 ) diag(n)
+ integer ( kind = 4 ) i
+ integer ( kind = 4 ) ipvt(n)
+ integer ( kind = 4 ) j
+ integer ( kind = 4 ) k
+ integer ( kind = 4 ) l
+ integer ( kind = 4 ) nsing
+ real ( kind = 8 ) qtb(n)
+ real ( kind = 8 ) qtbpj
+ real ( kind = 8 ) r(ldr,n)
+ real ( kind = 8 ) s
+ real ( kind = 8 ) sdiag(n)
+ real ( kind = 8 ) sum2
+ real ( kind = 8 ) t
+ real ( kind = 8 ) temp
+ real ( kind = 8 ) wa(n)
+ real ( kind = 8 ) x(n)
+!
+! Copy R and Q'*B to preserve input and initialize S.
+!
+! In particular, save the diagonal elements of R in X.
+!
+ do j = 1, n
+ r(j:n,j) = r(j,j:n)
+ x(j) = r(j,j)
+ end do
+
+ wa(1:n) = qtb(1:n)
+!
+! Eliminate the diagonal matrix D using a Givens rotation.
+!
+ do j = 1, n
+!
+! Prepare the row of D to be eliminated, locating the
+! diagonal element using P from the QR factorization.
+!
+ l = ipvt(j)
+
+ if ( diag(l) /= 0.0D+00 ) then
+
+ sdiag(j:n) = 0.0D+00
+ sdiag(j) = diag(l)
+!
+! The transformations to eliminate the row of D
+! modify only a single element of Q'*B
+! beyond the first N, which is initially zero.
+!
+ qtbpj = 0.0D+00
+
+ do k = j, n
+!
+! Determine a Givens rotation which eliminates the
+! appropriate element in the current row of D.
+!
+ if ( sdiag(k) /= 0.0D+00 ) then
+
+ if ( abs ( r(k,k) ) < abs ( sdiag(k) ) ) then
+ cotan = r(k,k) / sdiag(k)
+ s = 0.5D+00 / sqrt ( 0.25D+00 + 0.25D+00 * cotan ** 2 )
+ c = s * cotan
+ else
+ t = sdiag(k) / r(k,k)
+ c = 0.5D+00 / sqrt ( 0.25D+00 + 0.25D+00 * t ** 2 )
+ s = c * t
+ end if
+!
+! Compute the modified diagonal element of R and
+! the modified element of (Q'*B,0).
+!
+ r(k,k) = c * r(k,k) + s * sdiag(k)
+ temp = c * wa(k) + s * qtbpj
+ qtbpj = - s * wa(k) + c * qtbpj
+ wa(k) = temp
+!
+! Accumulate the tranformation in the row of S.
+!
+ do i = k+1, n
+ temp = c * r(i,k) + s * sdiag(i)
+ sdiag(i) = - s * r(i,k) + c * sdiag(i)
+ r(i,k) = temp
+ end do
+
+ end if
+
+ end do
+
+ end if
+!
+! Store the diagonal element of S and restore
+! the corresponding diagonal element of R.
+!
+ sdiag(j) = r(j,j)
+ r(j,j) = x(j)
+
+ end do
+!
+! Solve the triangular system for Z. If the system is
+! singular, then obtain a least squares solution.
+!
+ nsing = n
+
+ do j = 1, n
+
+ if ( sdiag(j) == 0.0D+00 .and. nsing == n ) then
+ nsing = j - 1
+ end if
+
+ if ( nsing < n ) then
+ wa(j) = 0.0D+00
+ end if
+
+ end do
+
+ do j = nsing, 1, -1
+ sum2 = dot_product ( wa(j+1:nsing), r(j+1:nsing,j) )
+ wa(j) = ( wa(j) - sum2 ) / sdiag(j)
+ end do
+!
+! Permute the components of Z back to components of X.
+!
+ do j = 1, n
+ l = ipvt(j)
+ x(l) = wa(j)
+ end do
+
+ return
+end
+subroutine r1mpyq ( m, n, a, lda, v, w )
+
+!*****************************************************************************80
+!
+!! R1MPYQ computes A*Q, where Q is the product of Householder transformations.
+!
+! Discussion:
+!
+! Given an M by N matrix A, this subroutine computes A*Q where
+! Q is the product of 2*(N - 1) transformations
+!
+! GV(N-1)*...*GV(1)*GW(1)*...*GW(N-1)
+!
+! and GV(I), GW(I) are Givens rotations in the (I,N) plane which
+! eliminate elements in the I-th and N-th planes, respectively.
+! Q itself is not given, rather the information to recover the
+! GV, GW rotations is supplied.
+!
+! Licensing:
+!
+! This code is distributed under the GNU LGPL license.
+!
+! Modified:
+!
+! 06 April 2010
+!
+! Author:
+!
+! Original FORTRAN77 version by Jorge More, Burton Garbow, Kenneth Hillstrom.
+! FORTRAN90 version by John Burkardt.
+!
+! Reference:
+!
+! Jorge More, Burton Garbow, Kenneth Hillstrom,
+! User Guide for MINPACK-1,
+! Technical Report ANL-80-74,
+! Argonne National Laboratory, 1980.
+!
+! Parameters:
+!
+! Input, integer ( kind = 4 ) M, the number of rows of A.
+!
+! Input, integer ( kind = 4 ) N, the number of columns of A.
+!
+! Input/output, real ( kind = 8 ) A(LDA,N), the M by N array.
+! On input, the matrix A to be postmultiplied by the orthogonal matrix Q.
+! On output, the value of A*Q.
+!
+! Input, integer ( kind = 4 ) LDA, the leading dimension of A, which must not
+! be less than M.
+!
+! Input, real ( kind = 8 ) V(N), W(N), contain the information necessary
+! to recover the Givens rotations GV and GW.
+!
+ implicit none
+
+ integer ( kind = 4 ) lda
+ integer ( kind = 4 ) m
+ integer ( kind = 4 ) n
+
+ real ( kind = 8 ) a(lda,n)
+ real ( kind = 8 ) c
+ integer ( kind = 4 ) i
+ integer ( kind = 4 ) j
+ real ( kind = 8 ) s
+ real ( kind = 8 ) temp
+ real ( kind = 8 ) v(n)
+ real ( kind = 8 ) w(n)
+!
+! Apply the first set of Givens rotations to A.
+!
+ do j = n - 1, 1, -1
+
+ if ( 1.0D+00 < abs ( v(j) ) ) then
+ c = 1.0D+00 / v(j)
+ s = sqrt ( 1.0D+00 - c ** 2 )
+ else
+ s = v(j)
+ c = sqrt ( 1.0D+00 - s ** 2 )
+ end if
+
+ do i = 1, m
+ temp = c * a(i,j) - s * a(i,n)
+ a(i,n) = s * a(i,j) + c * a(i,n)
+ a(i,j) = temp
+ end do
+
+ end do
+!
+! Apply the second set of Givens rotations to A.
+!
+ do j = 1, n - 1
+
+ if ( abs ( w(j) ) > 1.0D+00 ) then
+ c = 1.0D+00 / w(j)
+ s = sqrt ( 1.0D+00 - c ** 2 )
+ else
+ s = w(j)
+ c = sqrt ( 1.0D+00 - s ** 2 )
+ end if
+
+ do i = 1, m
+ temp = c * a(i,j) + s * a(i,n)
+ a(i,n) = - s * a(i,j) + c * a(i,n)
+ a(i,j) = temp
+ end do
+
+ end do
+
+ return
+end
+subroutine r1updt ( m, n, s, ls, u, v, w, sing )
+
+!*****************************************************************************80
+!
+!! R1UPDT re-triangularizes a matrix after a rank one update.
+!
+! Discussion:
+!
+! Given an M by N lower trapezoidal matrix S, an M-vector U, and an
+! N-vector V, the problem is to determine an orthogonal matrix Q such that
+!
+! (S + U * V' ) * Q
+!
+! is again lower trapezoidal.
+!
+! This subroutine determines Q as the product of 2 * (N - 1)
+! transformations
+!
+! GV(N-1)*...*GV(1)*GW(1)*...*GW(N-1)
+!
+! where GV(I), GW(I) are Givens rotations in the (I,N) plane
+! which eliminate elements in the I-th and N-th planes,
+! respectively. Q itself is not accumulated, rather the
+! information to recover the GV and GW rotations is returned.
+!
+! Licensing:
+!
+! This code is distributed under the GNU LGPL license.
+!
+! Modified:
+!
+! 06 April 2010
+!
+! Author:
+!
+! Original FORTRAN77 version by Jorge More, Burton Garbow, Kenneth Hillstrom.
+! FORTRAN90 version by John Burkardt.
+!
+! Reference:
+!
+! Jorge More, Burton Garbow, Kenneth Hillstrom,
+! User Guide for MINPACK-1,
+! Technical Report ANL-80-74,
+! Argonne National Laboratory, 1980.
+!
+! Parameters:
+!
+! Input, integer ( kind = 4 ) M, the number of rows of S.
+!
+! Input, integer ( kind = 4 ) N, the number of columns of S.
+! N must not exceed M.
+!
+! Input/output, real ( kind = 8 ) S(LS). On input, the lower trapezoidal
+! matrix S stored by columns. On output S contains the lower trapezoidal
+! matrix produced as described above.
+!
+! Input, integer ( kind = 4 ) LS, the length of the S array. LS must be at
+! least (N*(2*M-N+1))/2.
+!
+! Input, real ( kind = 8 ) U(M), the U vector.
+!
+! Input/output, real ( kind = 8 ) V(N). On input, V must contain the
+! vector V. On output V contains the information necessary to recover the
+! Givens rotations GV described above.
+!
+! Output, real ( kind = 8 ) W(M), contains information necessary to
+! recover the Givens rotations GW described above.
+!
+! Output, logical SING, is set to TRUE if any of the diagonal elements
+! of the output S are zero. Otherwise SING is set FALSE.
+!
+ implicit none
+
+ integer ( kind = 4 ) ls
+ integer ( kind = 4 ) m
+ integer ( kind = 4 ) n
+
+ real ( kind = 8 ) cos
+ real ( kind = 8 ) cotan
+ real ( kind = 8 ) giant
+ integer ( kind = 4 ) i
+ integer ( kind = 4 ) j
+ integer ( kind = 4 ) jj
+ integer ( kind = 4 ) l
+ real ( kind = 8 ) s(ls)
+ real ( kind = 8 ) sin
+ logical sing
+ real ( kind = 8 ) tan
+ real ( kind = 8 ) tau
+ real ( kind = 8 ) temp
+ real ( kind = 8 ) u(m)
+ real ( kind = 8 ) v(n)
+ real ( kind = 8 ) w(m)
+!
+! GIANT is the largest magnitude.
+!
+ giant = huge ( giant )
+!
+! Initialize the diagonal element pointer.
+!
+ jj = ( n * ( 2 * m - n + 1 ) ) / 2 - ( m - n )
+!
+! Move the nontrivial part of the last column of S into W.
+!
+ l = jj
+ do i = n, m
+ w(i) = s(l)
+ l = l + 1
+ end do
+!
+! Rotate the vector V into a multiple of the N-th unit vector
+! in such a way that a spike is introduced into W.
+!
+ do j = n - 1, 1, -1
+
+ jj = jj - ( m - j + 1 )
+ w(j) = 0.0D+00
+
+ if ( v(j) /= 0.0D+00 ) then
+!
+! Determine a Givens rotation which eliminates the
+! J-th element of V.
+!
+ if ( abs ( v(n) ) < abs ( v(j) ) ) then
+ cotan = v(n) / v(j)
+ sin = 0.5D+00 / sqrt ( 0.25D+00 + 0.25D+00 * cotan ** 2 )
+ cos = sin * cotan
+ tau = 1.0D+00
+ if ( abs ( cos ) * giant > 1.0D+00 ) then
+ tau = 1.0D+00 / cos
+ end if
+ else
+ tan = v(j) / v(n)
+ cos = 0.5D+00 / sqrt ( 0.25D+00 + 0.25D+00 * tan ** 2 )
+ sin = cos * tan
+ tau = sin
+ end if
+!
+! Apply the transformation to V and store the information
+! necessary to recover the Givens rotation.
+!
+ v(n) = sin * v(j) + cos * v(n)
+ v(j) = tau
+!
+! Apply the transformation to S and extend the spike in W.
+!
+ l = jj
+ do i = j, m
+ temp = cos * s(l) - sin * w(i)
+ w(i) = sin * s(l) + cos * w(i)
+ s(l) = temp
+ l = l + 1
+ end do
+
+ end if
+
+ end do
+!
+! Add the spike from the rank 1 update to W.
+!
+ w(1:m) = w(1:m) + v(n) * u(1:m)
+!
+! Eliminate the spike.
+!
+ sing = .false.
+
+ do j = 1, n-1
+
+ if ( w(j) /= 0.0D+00 ) then
+!
+! Determine a Givens rotation which eliminates the
+! J-th element of the spike.
+!
+ if ( abs ( s(jj) ) < abs ( w(j) ) ) then
+
+ cotan = s(jj) / w(j)
+ sin = 0.5D+00 / sqrt ( 0.25D+00 + 0.25D+00 * cotan ** 2 )
+ cos = sin * cotan
+
+ if ( 1.0D+00 < abs ( cos ) * giant ) then
+ tau = 1.0D+00 / cos
+ else
+ tau = 1.0D+00
+ end if
+
+ else
+
+ tan = w(j) / s(jj)
+ cos = 0.5D+00 / sqrt ( 0.25D+00 + 0.25D+00 * tan ** 2 )
+ sin = cos * tan
+ tau = sin
+
+ end if
+!
+! Apply the transformation to S and reduce the spike in W.
+!
+ l = jj
+ do i = j, m
+ temp = cos * s(l) + sin * w(i)
+ w(i) = - sin * s(l) + cos * w(i)
+ s(l) = temp
+ l = l + 1
+ end do
+!
+! Store the information necessary to recover the Givens rotation.
+!
+ w(j) = tau
+
+ end if
+!
+! Test for zero diagonal elements in the output S.
+!
+ if ( s(jj) == 0.0D+00 ) then
+ sing = .true.
+ end if
+
+ jj = jj + ( m - j + 1 )
+
+ end do
+!
+! Move W back into the last column of the output S.
+!
+ l = jj
+ do i = n, m
+ s(l) = w(i)
+ l = l + 1
+ end do
+
+ if ( s(jj) == 0.0D+00 ) then
+ sing = .true.
+ end if
+
+ return
+end
+subroutine r8vec_print ( n, a, title )
+
+!*****************************************************************************80
+!
+!! R8VEC_PRINT prints an R8VEC.
+!
+! Discussion:
+!
+! An R8VEC is a vector of R8's.
+!
+! Licensing:
+!
+! This code is distributed under the GNU LGPL license.
+!
+! Modified:
+!
+! 22 August 2000
+!
+! Author:
+!
+! John Burkardt
+!
+! Parameters:
+!
+! Input, integer ( kind = 4 ) N, the number of components of the vector.
+!
+! Input, real ( kind = 8 ) A(N), the vector to be printed.
+!
+! Input, character ( len = * ) TITLE, a title.
+!
+ implicit none
+
+ integer ( kind = 4 ) n
+
+ real ( kind = 8 ) a(n)
+ integer ( kind = 4 ) i
+ character ( len = * ) title
+
+ write ( *, '(a)' ) ' '
+ write ( *, '(a)' ) trim ( title )
+ write ( *, '(a)' ) ' '
+ do i = 1, n
+ write ( *, '(2x,i8,2x,g16.8)' ) i, a(i)
+ end do
+
+ return
+end
+subroutine rwupdt ( n, r, ldr, w, b, alpha, c, s )
+
+!*****************************************************************************80
+!
+!! RWUPDT computes the decomposition of triangular matrix augmented by one row.
+!
+! Discussion:
+!
+! Given an N by N upper triangular matrix R, this subroutine
+! computes the QR decomposition of the matrix formed when a row
+! is added to R. If the row is specified by the vector W, then
+! RWUPDT determines an orthogonal matrix Q such that when the
+! N+1 by N matrix composed of R augmented by W is premultiplied
+! by Q', the resulting matrix is upper trapezoidal.
+! The matrix Q' is the product of N transformations
+!
+! G(N)*G(N-1)* ... *G(1)
+!
+! where G(I) is a Givens rotation in the (I,N+1) plane which eliminates
+! elements in the (N+1)-st plane. RWUPDT also computes the product
+! Q'*C where C is the (N+1)-vector (B,ALPHA). Q itself is not
+! accumulated, rather the information to recover the G rotations is
+! supplied.
+!
+! Licensing:
+!
+! This code is distributed under the GNU LGPL license.
+!
+! Modified:
+!
+! 06 April 2010
+!
+! Author:
+!
+! Original FORTRAN77 version by Jorge More, Burton Garbow, Kenneth Hillstrom.
+! FORTRAN90 version by John Burkardt.
+!
+! Reference:
+!
+! Jorge More, Burton Garbow, Kenneth Hillstrom,
+! User Guide for MINPACK-1,
+! Technical Report ANL-80-74,
+! Argonne National Laboratory, 1980.
+!
+! Parameters:
+!
+! Input, integer ( kind = 4 ) N, the order of R.
+!
+! Input/output, real ( kind = 8 ) R(LDR,N). On input the upper triangular
+! part of R must contain the matrix to be updated. On output R contains the
+! updated triangular matrix.
+!
+! Input, integer ( kind = 4 ) LDR, the leading dimension of the array R.
+! LDR must not be less than N.
+!
+! Input, real ( kind = 8 ) W(N), the row vector to be added to R.
+!
+! Input/output, real ( kind = 8 ) B(N). On input, the first N elements
+! of the vector C. On output the first N elements of the vector Q'*C.
+!
+! Input/output, real ( kind = 8 ) ALPHA. On input, the (N+1)-st element
+! of the vector C. On output the (N+1)-st element of the vector Q'*C.
+!
+! Output, real ( kind = 8 ) C(N), S(N), the cosines and sines of the
+! transforming Givens rotations.
+!
+ implicit none
+
+ integer ( kind = 4 ) ldr
+ integer ( kind = 4 ) n
+
+ real ( kind = 8 ) alpha
+ real ( kind = 8 ) b(n)
+ real ( kind = 8 ) c(n)
+ real ( kind = 8 ) cotan
+ integer ( kind = 4 ) i
+ integer ( kind = 4 ) j
+ real ( kind = 8 ) r(ldr,n)
+ real ( kind = 8 ) rowj
+ real ( kind = 8 ) s(n)
+ real ( kind = 8 ) tan
+ real ( kind = 8 ) temp
+ real ( kind = 8 ) w(n)
+
+ do j = 1, n
+
+ rowj = w(j)
+!
+! Apply the previous transformations to R(I,J), I=1,2,...,J-1, and to W(J).
+!
+ do i = 1, j - 1
+ temp = c(i) * r(i,j) + s(i) * rowj
+ rowj = - s(i) * r(i,j) + c(i) * rowj
+ r(i,j) = temp
+ end do
+!
+! Determine a Givens rotation which eliminates W(J).
+!
+ c(j) = 1.0D+00
+ s(j) = 0.0D+00
+
+ if ( rowj /= 0.0D+00 ) then
+
+ if ( abs ( r(j,j) ) < abs ( rowj ) ) then
+ cotan = r(j,j) / rowj
+ s(j) = 0.5D+00 / sqrt ( 0.25D+00 + 0.25D+00 * cotan ** 2 )
+ c(j) = s(j) * cotan
+ else
+ tan = rowj / r(j,j)
+ c(j) = 0.5D+00 / sqrt ( 0.25D+00 + 0.25D+00 * tan ** 2 )
+ s(j) = c(j) * tan
+ end if
+!
+! Apply the current transformation to R(J,J), B(J), and ALPHA.
+!
+ r(j,j) = c(j) * r(j,j) + s(j) * rowj
+ temp = c(j) * b(j) + s(j) * alpha
+ alpha = - s(j) * b(j) + c(j) * alpha
+ b(j) = temp
+
+ end if
+
+ end do
+
+ return
+end
+subroutine timestamp ( )
+
+!*****************************************************************************80
+!
+!! TIMESTAMP prints the current YMDHMS date as a time stamp.
+!
+! Example:
+!
+! 31 May 2001 9:45:54.872 AM
+!
+! Licensing:
+!
+! This code is distributed under the GNU LGPL license.
+!
+! Modified:
+!
+! 18 May 2013
+!
+! Author:
+!
+! John Burkardt
+!
+! Parameters:
+!
+! None
+!
+ implicit none
+
+ character ( len = 8 ) ampm
+ integer ( kind = 4 ) d
+ integer ( kind = 4 ) h
+ integer ( kind = 4 ) m
+ integer ( kind = 4 ) mm
+ character ( len = 9 ), parameter, dimension(12) :: month = (/ &
+ 'January ', 'February ', 'March ', 'April ', &
+ 'May ', 'June ', 'July ', 'August ', &
+ 'September', 'October ', 'November ', 'December ' /)
+ integer ( kind = 4 ) n
+ integer ( kind = 4 ) s
+ integer ( kind = 4 ) values(8)
+ integer ( kind = 4 ) y
+
+ call date_and_time ( values = values )
+
+ y = values(1)
+ m = values(2)
+ d = values(3)
+ h = values(5)
+ n = values(6)
+ s = values(7)
+ mm = values(8)
+
+ if ( h < 12 ) then
+ ampm = 'AM'
+ else if ( h == 12 ) then
+ if ( n == 0 .and. s == 0 ) then
+ ampm = 'Noon'
+ else
+ ampm = 'PM'
+ end if
+ else
+ h = h - 12
+ if ( h < 12 ) then
+ ampm = 'PM'
+ else if ( h == 12 ) then
+ if ( n == 0 .and. s == 0 ) then
+ ampm = 'Midnight'
+ else
+ ampm = 'AM'
+ end if
+ end if
+ end if
+
+ write ( *, '(i2.2,1x,a,1x,i4,2x,i2,a1,i2.2,a1,i2.2,a1,i3.3,1x,a)' ) &
+ d, trim ( month(m) ), y, h, ':', n, ':', s, '.', mm, trim ( ampm )
+
+ return
+end
diff --git a/src/PHYEX/micro/modd_param_lima.f90 b/src/PHYEX/micro/modd_param_lima.f90
index d199c2a666f0e97b165dff5f3dd4e1cf5a40c815..00af77b8569018404060bee7c6672e849b02f504 100644
--- a/src/PHYEX/micro/modd_param_lima.f90
+++ b/src/PHYEX/micro/modd_param_lima.f90
@@ -52,12 +52,9 @@ REAL, SAVE :: XTSTEP_TS ! maximum time for the sub-time-step
!
! 1.1 Cold scheme configuration
!
-LOGICAL, SAVE :: LCOLD ! TRUE to enable the cold scheme
LOGICAL, SAVE :: LNUCL ! TRUE to enable ice nucleation
LOGICAL, SAVE :: LSEDI ! TRUE to enable pristine ice sedimentation
LOGICAL, SAVE :: LHHONI ! TRUE to enable freezing of haze particules
-LOGICAL, SAVE :: LSNOW ! TRUE to enable snow and graupel
-LOGICAL, SAVE :: LHAIL ! TRUE to enable hail
LOGICAL, SAVE :: LMEYERS ! TRUE to use Meyers nucleation
LOGICAL, SAVE :: LCIBU ! TRUE to use collisional ice breakup
LOGICAL, SAVE :: LRDSF ! TRUE to use rain drop shattering by freezing
@@ -135,9 +132,7 @@ REAL,SAVE :: XNDEBRIS_CIBU ! Number of ice crystal debris produced
!
! 2.1 Warm scheme configuration
!
-LOGICAL, SAVE :: LWARM ! TRUE to enable the warm scheme
LOGICAL, SAVE :: LACTI ! TRUE to enable CCN activation
-LOGICAL, SAVE :: LRAIN ! TRUE to enable the formation of rain
LOGICAL, SAVE :: LSEDC ! TRUE to enable the droplet sedimentation
LOGICAL, SAVE :: LACTIT ! TRUE to enable the usage of dT/dt in CCN activation
LOGICAL, SAVE :: LBOUND ! TRUE to enable the continuously replenishing
diff --git a/src/PHYEX/micro/modd_param_lima_cold.f90 b/src/PHYEX/micro/modd_param_lima_cold.f90
index 3801cfcb78da31c9274375af9c3800ace8c5419a..337480312280e054f1abdaabadfa4ca829fda3ae 100644
--- a/src/PHYEX/micro/modd_param_lima_cold.f90
+++ b/src/PHYEX/micro/modd_param_lima_cold.f90
@@ -139,6 +139,14 @@ REAL,SAVE :: XCONCI_MAX ! Limitation of the pristine
! ice concentration (init and grid-nesting)
REAL,SAVE :: XFREFFI ! Factor to compute the cloud ice effective radius
!
+! For ICE4 nucleation
+REAL, SAVE :: XALPHA1
+REAL, SAVE :: XALPHA2
+REAL, SAVE :: XBETA1
+REAL, SAVE :: XBETA2
+REAL, SAVE :: XNU10
+REAL, SAVE :: XNU20
+!
!-------------------------------------------------------------------------------
!
END MODULE MODD_PARAM_LIMA_COLD
diff --git a/src/PHYEX/micro/mode_ice4_budgets.f90 b/src/PHYEX/micro/mode_ice4_budgets.f90
index 99cf34f3123f146272562530c881fec1efb33a29..03c550d31736c25e59c0ebe77506f0a9ad3c4d74 100644
--- a/src/PHYEX/micro/mode_ice4_budgets.f90
+++ b/src/PHYEX/micro/mode_ice4_budgets.f90
@@ -25,7 +25,7 @@ USE MODD_PARAM_ICE, ONLY: PARAM_ICE_t
!
USE MODD_FIELDS_ADDRESS ! index number for prognostic (theta and mixing ratios) and budgets
!
-USE MODE_BUDGET, ONLY: BUDGET_STORE_ADD_PHY, BUDGET_STORE_INIT_PHY, BUDGET_STORE_END_PHY
+USE MODE_BUDGET_PHY, ONLY: BUDGET_STORE_ADD_PHY, BUDGET_STORE_INIT_PHY, BUDGET_STORE_END_PHY
!
!
IMPLICIT NONE
diff --git a/src/PHYEX/micro/mode_ice4_sedimentation.f90 b/src/PHYEX/micro/mode_ice4_sedimentation.f90
index f6fc795edff66ad05a393e199992dfb0fb4955d5..c110a81f1cdf5e8616d6b5d1fd52d14ab7948ddc 100644
--- a/src/PHYEX/micro/mode_ice4_sedimentation.f90
+++ b/src/PHYEX/micro/mode_ice4_sedimentation.f90
@@ -42,7 +42,7 @@ USE MODD_RAIN_ICE_PARAM, ONLY: RAIN_ICE_PARAM_t
USE MODD_PARAM_ICE, ONLY: PARAM_ICE_t
!
USE MODE_MSG, ONLY: PRINT_MSG, NVERB_FATAL
-USE MODE_BUDGET, ONLY: BUDGET_STORE_INIT_PHY, BUDGET_STORE_END_PHY
+USE MODE_BUDGET_PHY, ONLY: BUDGET_STORE_INIT_PHY, BUDGET_STORE_END_PHY
!
USE MODE_ICE4_SEDIMENTATION_STAT, ONLY: ICE4_SEDIMENTATION_STAT
USE MODE_ICE4_SEDIMENTATION_SPLIT, ONLY: ICE4_SEDIMENTATION_SPLIT
diff --git a/src/PHYEX/micro/mode_lima_bergeron.f90 b/src/PHYEX/micro/mode_lima_bergeron.f90
index 7a4967708e09ec8b49e850a2583fd47a7c04ee6d..7df06b07fb522fb373f86bd6211ef365729bd9a1 100644
--- a/src/PHYEX/micro/mode_lima_bergeron.f90
+++ b/src/PHYEX/micro/mode_lima_bergeron.f90
@@ -2,41 +2,14 @@
!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_BERGERON
-! #################################
-!
-INTERFACE
- SUBROUTINE LIMA_BERGERON (LDCOMPUTE, &
- PRCT, PRIT, PCIT, PLBDI, &
- PSSIW, PAI, PCJ, PLVFACT, PLSFACT, &
- P_TH_BERFI, P_RC_BERFI )
-!
-LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE
-!
-REAL, DIMENSION(:), INTENT(IN) :: PRCT ! Cloud water C. at t
-REAL, DIMENSION(:), INTENT(IN) :: PRIT ! Cloud water C. at t
-REAL, DIMENSION(:), INTENT(IN) :: PCIT ! Cloud water C. at t
-REAL, DIMENSION(:), INTENT(IN) :: PLBDI !
-!
-REAL, DIMENSION(:), INTENT(IN) :: PSSIW !
-REAL, DIMENSION(:), INTENT(IN) :: PAI !
-REAL, DIMENSION(:), INTENT(IN) :: PCJ !
-REAL, DIMENSION(:), INTENT(IN) :: PLVFACT !
-REAL, DIMENSION(:), INTENT(IN) :: PLSFACT !
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_BERFI
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RC_BERFI
-!!
-END SUBROUTINE LIMA_BERGERON
-END INTERFACE
-END MODULE MODI_LIMA_BERGERON
-!
+MODULE MODE_LIMA_BERGERON
+ IMPLICIT NONE
+ CONTAINS
! #############################################################
- SUBROUTINE LIMA_BERGERON( LDCOMPUTE, &
- PRCT, PRIT, PCIT, PLBDI, &
- PSSIW, PAI, PCJ, PLVFACT, PLSFACT, &
- P_TH_BERFI, P_RC_BERFI )
+ SUBROUTINE LIMA_BERGERON( LDCOMPUTE, &
+ PRCT, PRIT, PCIT, PLBDI, &
+ PSSIW, PAI, PCJ, PLVFACT, PLSFACT, &
+ P_TH_BERFI, P_RC_BERFI )
! #############################################################
!
!! PURPOSE
@@ -99,3 +72,4 @@ END WHERE
!-------------------------------------------------------------------------------
!
END SUBROUTINE LIMA_BERGERON
+END MODULE MODE_LIMA_BERGERON
diff --git a/src/PHYEX/micro/mode_lima_ccn_activation.f90 b/src/PHYEX/micro/mode_lima_ccn_activation.f90
index bac576fa00f953074ced8034ceeb6e1271f3aadb..1731dd8156a2f19ebaa201b3f7fad0e835e2d417 100644
--- a/src/PHYEX/micro/mode_lima_ccn_activation.f90
+++ b/src/PHYEX/micro/mode_lima_ccn_activation.f90
@@ -3,47 +3,15 @@
!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_CCN_ACTIVATION
-! ###############################
-!
-INTERFACE
- SUBROUTINE LIMA_CCN_ACTIVATION (TPFILE, &
- PRHODREF, PEXNREF, PPABST, PT, PDTHRAD, PW_NU, &
- PTHT, PRVT, PRCT, PCCT, PRRT, PNFT, PNAT, &
- PCLDFR )
-USE MODD_IO, ONLY: TFILEDATA
-!
-TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
-!
-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
- ! the nucleation param.
-!
-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(INOUT) :: PCCT ! Cloud water m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Cloud water m.r. 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(IN) :: PCLDFR ! Precipitation fraction
-!
-END SUBROUTINE LIMA_CCN_ACTIVATION
-END INTERFACE
-END MODULE MODI_LIMA_CCN_ACTIVATION
-! #############################################################################
- SUBROUTINE LIMA_CCN_ACTIVATION (TPFILE, &
- PRHODREF, PEXNREF, PPABST, PT, PDTHRAD, PW_NU, &
- PTHT, PRVT, PRCT, PCCT, PRRT, PNFT, PNAT, &
- PCLDFR )
-! #############################################################################
+MODULE MODE_LIMA_CCN_ACTIVATION
+ IMPLICIT NONE
+CONTAINS
+! ##############################################################################
+ SUBROUTINE LIMA_CCN_ACTIVATION (CST, &
+ PRHODREF, PEXNREF, PPABST, PT, PDTHRAD, PW_NU, &
+ PTHT, PRVT, PRCT, PCCT, PRRT, PNFT, PNAT, &
+ PCLDFR )
+! ##############################################################################
!
!!
!! PURPOSE
@@ -97,10 +65,10 @@ END MODULE MODI_LIMA_CCN_ACTIVATION
!* 0. DECLARATIONS
! ------------
!
-USE MODD_CST, ONLY: XALPW, XBETAW, XCL, XCPD, XCPV, XGAMW, XLVTT, XMD, XMNH_EPSILON, XMV, XRV, XTT
-use modd_field, only: TFIELDMETADATA, TYPEREAL
-USE MODD_IO, ONLY: TFILEDATA
-USE MODD_LUNIT_n, ONLY: TLUOUT
+USE MODD_CST, ONLY: CST_t
+!use modd_field, only: TFIELDDATA, TYPEREAL
+!USE MODD_IO, ONLY: TFILEDATA
+!USE MODD_LUNIT_n, ONLY: TLUOUT
USE MODD_PARAMETERS, ONLY: JPHEXT, JPVEXT
USE MODD_PARAM_LIMA, ONLY: LADJ, LACTIT, NMOD_CCN, XCTMIN, XKHEN_MULTI, XRTMIN, XLIMIT_FACTOR
USE MODD_PARAM_LIMA_WARM, ONLY: XWMIN, NAHEN, NHYP, XAHENINTP1, XAHENINTP2, XCSTDCRIT, XHYPF12, &
@@ -108,7 +76,7 @@ USE MODD_PARAM_LIMA_WARM, ONLY: XWMIN, NAHEN, NHYP, XAHENINTP1, XAHENINTP2, XCST
XLBC, XLBEXC
USE MODD_TURB_n, ONLY: LSUBG_COND
-USE MODE_IO_FIELD_WRITE, only: IO_Field_write
+!USE MODE_IO_FIELD_WRITE, only: IO_Field_write
use mode_tools, only: Countjv
USE MODI_GAMMA
@@ -117,7 +85,8 @@ IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
!
-TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
+TYPE(CST_t), INTENT(IN) :: CST
+!TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Reference density
REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
@@ -180,11 +149,11 @@ REAL :: ZS1, ZS2, ZXACC
INTEGER :: JMOD
INTEGER :: IIB, IIE, IJB, IJE, IKB, IKE ! Physical domain
!
-INTEGER :: ILUOUT ! Logical unit of output listing
-TYPE(TFIELDMETADATA) :: TZFIELD
+!!$INTEGER :: ILUOUT ! Logical unit of output listing
+!!$TYPE(TFIELDMETADATA) :: TZFIELD
!-------------------------------------------------------------------------------
!
-ILUOUT = TLUOUT%NLU
+!ILUOUT = TLUOUT%NLU
!
!* 1. PREPARE COMPUTATIONS - PACK
! ---------------------------
@@ -198,8 +167,8 @@ IKE=SIZE(PRHODREF,3) - JPVEXT
!
! Saturation vapor mixing ratio and radiative tendency
!
-ZEPS= XMV / XMD
-ZRVSAT(:,:,:) = ZEPS / (PPABST(:,:,:)*EXP(-XALPW+XBETAW/PT(:,:,:)+XGAMW*ALOG(PT(:,:,:))) - 1.0)
+ZEPS= CST%XMV / CST%XMD
+ZRVSAT(:,:,:) = ZEPS / (PPABST(:,:,:)*EXP(-CST%XALPW+CST%XBETAW/PT(:,:,:)+CST%XGAMW*ALOG(PT(:,:,:))) - 1.0)
ZTDT(:,:,:) = 0.
IF (LACTIT .AND. SIZE(PDTHRAD).GT.0) ZTDT(:,:,:) = PDTHRAD(:,:,:) * PEXNREF(:,:,:)
!
@@ -222,7 +191,7 @@ IF (LADJ) THEN
.OR. ZTDT(IIB:IIE,IJB:IJE,IKB:IKE)<XTMIN
!
GNUCT(IIB:IIE,IJB:IJE,IKB:IKE) = GNUCT(IIB:IIE,IJB:IJE,IKB:IKE) &
- .AND. PT(IIB:IIE,IJB:IJE,IKB:IKE)>(XTT-22.) &
+ .AND. PT(IIB:IIE,IJB:IJE,IKB:IKE)>(CST%XTT-22.) &
.AND. ZCONC_TOT(IIB:IIE,IJB:IJE,IKB:IKE)>XCTMIN(2)
!
IF (LSUBG_COND) GNUCT(IIB:IIE,IJB:IJE,IKB:IKE) = GNUCT(IIB:IIE,IJB:IJE,IKB:IKE) &
@@ -231,7 +200,7 @@ IF (LADJ) THEN
.AND. PRVT(IIB:IIE,IJB:IJE,IKB:IKE).GE.ZRVSAT(IIB:IIE,IJB:IJE,IKB:IKE)
ELSE
GNUCT(IIB:IIE,IJB:IJE,IKB:IKE) = PRVT(IIB:IIE,IJB:IJE,IKB:IKE).GE.ZRVSAT(IIB:IIE,IJB:IJE,IKB:IKE) &
- .AND. PT(IIB:IIE,IJB:IJE,IKB:IKE)>(XTT-22.) &
+ .AND. PT(IIB:IIE,IJB:IJE,IKB:IKE)>(CST%XTT-22.) &
.AND. ZCONC_TOT(IIB:IIE,IJB:IJE,IKB:IKE)>XCTMIN(2)
END IF
!
@@ -285,7 +254,7 @@ IF( INUCT >= 1 ) THEN
ALLOCATE(ZSMAX(INUCT))
IF (LADJ) THEN
ZZW1(:) = 1.0/ZEPS + 1.0/ZZW1(:) &
- + (((XLVTT+(XCPV-XCL)*(ZZT(:)-XTT))/ZZT(:))**2)/(XCPD*XRV) ! Psi2
+ + (((CST%XLVTT+(CST%XCPV-CST%XCL)*(ZZT(:)-CST%XTT))/ZZT(:))**2)/(CST%XCPD*CST%XRV) ! Psi2
!
!
!-------------------------------------------------------------------------------
@@ -454,8 +423,8 @@ IF( INUCT >= 1 ) THEN
!
IF (.NOT.LSUBG_COND) THEN
ZW(:,:,:) = MIN( UNPACK( ZZW1(:),MASK=GNUCT(:,:,:),FIELD=0.0 ),PRVT(:,:,:) )
- PTHT(:,:,:) = PTHT(:,:,:) + ZW(:,:,:) * (XLVTT+(XCPV-XCL)*(PT(:,:,:)-XTT))/ &
- (PEXNREF(:,:,:)*(XCPD+XCPV*PRVT(:,:,:)+XCL*(PRCT(:,:,:)+PRRT(:,:,:))))
+ 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(:,:,:)
PRCT(:,:,:) = PRCT(:,:,:) + ZW(:,:,:)
PCCT(:,:,:) = PCCT(:,:,:) + UNPACK( ZZW6(:),MASK=GNUCT(:,:,:),FIELD=0. )
@@ -497,37 +466,36 @@ IF( INUCT >= 1 ) THEN
!
END IF ! INUCT
!
-IF ( tpfile%lopened ) THEN
- IF ( INUCT == 0 ) THEN
- ZW (:,:,:) = 0.
- ZW2(:,:,:) = 0.
- END IF
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'SMAX', &
- CSTDNAME = '', &
- CLONGNAME = 'SMAX', &
- CUNITS = '', &
- CDIR = 'XY', &
- CCOMMENT = 'X_Y_Z_SMAX', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- LTIMEDEP = .TRUE. )
- CALL IO_Field_write(TPFILE,TZFIELD,ZW)
- !
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'NACT', &
- CSTDNAME = '', &
- CLONGNAME = 'NACT', &
- CUNITS = 'kg-1', &
- CDIR = 'XY', &
- CCOMMENT = 'X_Y_Z_NACT', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- LTIMEDEP = .TRUE. )
- CALL IO_Field_write(TPFILE,TZFIELD,ZW2)
-END IF
+!!$IF ( tpfile%lopened ) THEN
+!!$ IF ( INUCT == 0 ) THEN
+!!$ ZW (:,:,:) = 0.
+!!$ ZW2(:,:,:) = 0.
+!!$ END IF
+!!$
+!!$ TZFIELD%CMNHNAME ='SMAX'
+!!$ TZFIELD%CSTDNAME = ''
+!!$ TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
+!!$ TZFIELD%CUNITS = ''
+!!$ TZFIELD%CDIR = 'XY'
+!!$ TZFIELD%CCOMMENT = 'X_Y_Z_SMAX'
+!!$ TZFIELD%NGRID = 1
+!!$ TZFIELD%NTYPE = TYPEREAL
+!!$ TZFIELD%NDIMS = 3
+!!$ TZFIELD%LTIMEDEP = .TRUE.
+!!$ CALL IO_Field_write(TPFILE,TZFIELD,ZW)
+!!$ !
+!!$ TZFIELD%CMNHNAME ='NACT'
+!!$ TZFIELD%CSTDNAME = ''
+!!$ TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
+!!$ TZFIELD%CUNITS = 'kg-1'
+!!$ TZFIELD%CDIR = 'XY'
+!!$ TZFIELD%CCOMMENT = 'X_Y_Z_NACT'
+!!$ TZFIELD%NGRID = 1
+!!$ TZFIELD%NTYPE = TYPEREAL
+!!$ TZFIELD%NDIMS = 3
+!!$ TZFIELD%LTIMEDEP = .TRUE.
+!!$ CALL IO_Field_write(TPFILE,TZFIELD,ZW2)
+!!$END IF
!
!
!-------------------------------------------------------------------------------
@@ -770,7 +738,7 @@ INTEGER :: PIVEC1
ALLOCATE(PFUNCSMAX(NPTS))
!
PFUNCSMAX(:) = 0.
-PZVEC1 = MAX( ( 1.0 + 10.0 * XMNH_EPSILON ) ,MIN( REAL(NHYP)*( 1.0 - 10.0 * XMNH_EPSILON ) , &
+PZVEC1 = MAX( ( 1.0 + 10.0 * CST%XMNH_EPSILON ) ,MIN( REAL(NHYP)*( 1.0 - 10.0 * CST%XMNH_EPSILON ) , &
XHYPINTP1*LOG(PPZSMAX)+XHYPINTP2 ) )
PIVEC1 = INT( PZVEC1 )
PZVEC1 = PZVEC1 - REAL( PIVEC1 )
@@ -849,3 +817,4 @@ END FUNCTION SINGL_FUNCSMAX
!-----------------------------------------------------------------------------
!
END SUBROUTINE LIMA_CCN_ACTIVATION
+END MODULE MODE_LIMA_CCN_ACTIVATION
diff --git a/src/PHYEX/micro/mode_lima_ccn_hom_freezing.f90 b/src/PHYEX/micro/mode_lima_ccn_hom_freezing.f90
index 86b7a9408b864e7d93dde71f280c0ce432bf57a8..25744d42abb867dfca9935a86bb924329e49ee8e 100644
--- a/src/PHYEX/micro/mode_lima_ccn_hom_freezing.f90
+++ b/src/PHYEX/micro/mode_lima_ccn_hom_freezing.f90
@@ -3,48 +3,14 @@
!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_CCN_HOM_FREEZING
-! #################################
-!
-INTERFACE
- SUBROUTINE LIMA_CCN_HOM_FREEZING (PRHODREF, PEXNREF, PPABST, PW_NU, &
- PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
- PCCT, PCRT, PCIT, PNFT, PNHT, &
- PICEFR )
-!
-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) :: PW_NU ! updraft velocity used for
- ! the nucleation param.
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHT ! Theta at time t
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRVT ! Water vapor m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCT ! Cloud water m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Rain water m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRIT ! Cloud ice m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRGT ! Graupel m.r. at t
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PCCT ! Cloud water C. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PCRT ! Rain water C. source
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCIT ! Ice crystal C. source
-!
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PNFT ! Free CCN conc.
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PNHT ! haze homogeneous freezing
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PICEFR ! Ice fraction
-!
-END SUBROUTINE LIMA_CCN_HOM_FREEZING
-END INTERFACE
-END MODULE MODI_LIMA_CCN_HOM_FREEZING
-!
+MODULE MODE_LIMA_CCN_HOM_FREEZING
+ IMPLICIT NONE
+CONTAINS
! ##########################################################################
- SUBROUTINE LIMA_CCN_HOM_FREEZING (PRHODREF, PEXNREF, PPABST, PW_NU, &
- PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
- PCCT, PCRT, PCIT, PNFT, PNHT , &
- PICEFR )
+ SUBROUTINE LIMA_CCN_HOM_FREEZING (CST, PRHODREF, PEXNREF, PPABST, PW_NU, &
+ PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
+ PCCT, PCRT, PCIT, PNFT, PNHT , &
+ PICEFR )
! ##########################################################################
!
!! PURPOSE
@@ -69,9 +35,7 @@ END MODULE MODI_LIMA_CCN_HOM_FREEZING
!* 0. DECLARATIONS
! ------------
!
-USE MODD_CST, ONLY: XP00, XRD, XRV, XMV, XMD, XCPD, XCPV, XCL, XCI, &
- XTT, XLSTT, XLVTT, XALPI, XBETAI, XGAMI, &
- XG
+USE MODD_CST, ONLY: CST_t
USE MODD_NSV
USE MODD_PARAMETERS, ONLY: JPHEXT, JPVEXT
USE MODD_PARAM_LIMA, ONLY: NMOD_CCN, NMOD_IMM, XRTMIN, XCTMIN, XNUC
@@ -89,6 +53,7 @@ IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
!
+TYPE(CST_t), INTENT(IN) :: CST
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
@@ -185,7 +150,7 @@ IKB=1+JPVEXT
IKE=SIZE(PTHT,3) - JPVEXT
!
! Temperature
-ZT(:,:,:) = PTHT(:,:,:) * ( PPABST(:,:,:)/XP00 ) ** (XRD/XCPD)
+ZT(:,:,:) = PTHT(:,:,:) * ( PPABST(:,:,:)/CST%XP00 ) ** (CST%XRD/CST%XCPD)
!
ZNHT(:,:,:) = PNHT(:,:,:)
!
@@ -193,7 +158,7 @@ ZNHT(:,:,:) = PNHT(:,:,:)
! PACK variables
!
GNEGT(:,:,:) = .FALSE.
-GNEGT(IIB:IIE,IJB:IJE,IKB:IKE) = ZT(IIB:IIE,IJB:IJE,IKB:IKE)<XTT-35.0
+GNEGT(IIB:IIE,IJB:IJE,IKB:IKE) = ZT(IIB:IIE,IJB:IJE,IKB:IKE)<CST%XTT-35.0
INEGT = COUNTJV( GNEGT(:,:,:),I1(:),I2(:),I3(:))
!
IF (INEGT.GT.0) THEN
@@ -256,14 +221,14 @@ IF (INEGT.GT.0) THEN
ALLOCATE( ZZX (INEGT) ) ; ZZX(:) = 0.0
ALLOCATE( ZZY (INEGT) ) ; ZZY(:) = 0.0
!
- ZTCELSIUS(:) = ZZT(:)-XTT ! T [°C]
- ZZW(:) = ZEXNREF(:)*( XCPD+XCPV*ZRVT(:)+XCL*(ZRCT(:)+ZRRT(:)) &
- +XCI*(ZRIT(:)+ZRST(:)+ZRGT(:)) )
- ZLSFACT(:) = (XLSTT+(XCPV-XCI)*ZTCELSIUS(:))/ZZW(:) ! L_s/(Pi_ref*C_ph)
- ZLVFACT(:) = (XLVTT+(XCPV-XCL)*ZTCELSIUS(:))/ZZW(:) ! L_v/(Pi_ref*C_ph)
+ ZTCELSIUS(:) = ZZT(:)-CST%XTT ! T [°C]
+ ZZW(:) = ZEXNREF(:)*( CST%XCPD+CST%XCPV*ZRVT(:)+CST%XCL*(ZRCT(:)+ZRRT(:)) &
+ +CST%XCI*(ZRIT(:)+ZRST(:)+ZRGT(:)) )
+ ZLSFACT(:) = (CST%XLSTT+(CST%XCPV-CST%XCI)*ZTCELSIUS(:))/ZZW(:) ! L_s/(Pi_ref*C_ph)
+ ZLVFACT(:) = (CST%XLVTT+(CST%XCPV-CST%XCL)*ZTCELSIUS(:))/ZZW(:) ! L_v/(Pi_ref*C_ph)
!
- ZZW(:) = EXP( XALPI - XBETAI/ZZT(:) - XGAMI*ALOG(ZZT(:) ) ) ! es_i
- ZSI(:) = ZRVT(:)*(ZPRES(:)-ZZW(:))/((XMV/XMD)*ZZW(:)) ! Saturation over ice
+ ZZW(:) = EXP( CST%XALPI - CST%XBETAI/ZZT(:) - CST%XGAMI*ALOG(ZZT(:) ) ) ! es_i
+ ZSI(:) = ZRVT(:)*(ZPRES(:)-ZZW(:))/((CST%XMV/CST%XMD)*ZZW(:)) ! Saturation over ice
!
!
!-------------------------------------------------------------------------------
@@ -293,7 +258,7 @@ IF (INEGT.GT.0) THEN
!
ZZW(:) = 0.0
ZZX(:) = 0.0
- ZEPS = XMV / XMD
+ ZEPS = CST%XMV / CST%XMD
ZZY(:) = XCRITSAT1_HONH - & ! Critical Sat.
(MIN( XTMAX_HONH,MAX( XTMIN_HONH,ZZT(:) ) )/XCRITSAT2_HONH)
!
@@ -303,19 +268,19 @@ IF (INEGT.GT.0) THEN
ALLOCATE(ZTAU(INEGT))
ALLOCATE(ZBFACT(INEGT))
!
- WHERE( (ZZT(:)<XTT-35.0) .AND. (ZSI(:)>ZZY(:)) )
- ZLS(:) = XLSTT+(XCPV-XCI)*ZTCELSIUS(:) ! Ls
+ WHERE( (ZZT(:)<CST%XTT-35.0) .AND. (ZSI(:)>ZZY(:)) )
+ ZLS(:) = CST%XLSTT+(CST%XCPV-CST%XCI)*ZTCELSIUS(:) ! Ls
!
- ZPSI1(:) = ZZY(:) * (XG/(XRD*ZZT(:)))*(ZEPS*ZLS(:)/(XCPD*ZZT(:))-1.)
+ ZPSI1(:) = ZZY(:) * (CST%XG/(CST%XRD*ZZT(:)))*(ZEPS*ZLS(:)/(CST%XCPD*ZZT(:))-1.)
! ! Psi1 (a1*Scr in KL01)
! BV correction PSI2 enlever 1/ZEPS ?
! ZPSI2(:) = ZSI(:) * (1.0/ZEPS+1.0/ZRVT(:)) + &
ZPSI2(:) = ZSI(:) * (1.0/ZRVT(:)) + &
- ZZY(:) * ((ZLS(:)/ZZT(:))**2)/(XCPD*XRV)
+ ZZY(:) * ((ZLS(:)/ZZT(:))**2)/(CST%XCPD*CST%XRV)
! ! Psi2 (a2+a3*Scr in KL01)
ZTAU(:) = 1.0 / ( MAX( XC1_HONH,XC1_HONH*(XC2_HONH-XC3_HONH*ZZT(:)) ) *&
ABS( (XDLNJODT1_HONH - XDLNJODT2_HONH*ZZT(:)) * &
- ((ZPRES(:)/XP00)**(XRD/XCPD))*ZTHT(:) ) )
+ ((ZPRES(:)/CST%XP00)**(CST%XRD/CST%XCPD))*ZTHT(:) ) )
!
ZBFACT(:) = (XRHOI_HONH/ZRHODREF(:)) * (ZSI(:)/(ZZY(:)-1.0)) &
! BV correction ZBFACT enlever 1/ZEPS ?
@@ -395,3 +360,4 @@ END IF ! INEGT>0
!-------------------------------------------------------------------------------
!
END SUBROUTINE LIMA_CCN_HOM_FREEZING
+END MODULE MODE_LIMA_CCN_HOM_FREEZING
diff --git a/src/PHYEX/micro/mode_lima_collisional_ice_breakup.f90 b/src/PHYEX/micro/mode_lima_collisional_ice_breakup.f90
index a6848d14345bcdf23a70338347f5b8ab66940e7b..58a040f5af64a6c7b1b780d32a0b6ea0a448709a 100644
--- a/src/PHYEX/micro/mode_lima_collisional_ice_breakup.f90
+++ b/src/PHYEX/micro/mode_lima_collisional_ice_breakup.f90
@@ -3,43 +3,15 @@
!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_COLLISIONAL_ICE_BREAKUP
-! ########################################
-!
-INTERFACE
- SUBROUTINE LIMA_COLLISIONAL_ICE_BREAKUP (LDCOMPUTE, &
- PRHODREF, &
- PRIT, PRST, PRGT, PCIT, PCST, PCGT, &
- PLBDS, PLBDG, &
- P_RI_CIBU, P_CI_CIBU )
-!
-LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE
-!
-REAL, DIMENSION(:), INTENT(IN) :: PRHODREF
-!
-REAL, DIMENSION(:), INTENT(IN) :: PRIT
-REAL, DIMENSION(:), INTENT(IN) :: PRST
-REAL, DIMENSION(:), INTENT(IN) :: PRGT
-REAL, DIMENSION(:), INTENT(IN) :: PCIT
-REAL, DIMENSION(:), INTENT(IN) :: PCST
-REAL, DIMENSION(:), INTENT(IN) :: PCGT
-REAL, DIMENSION(:), INTENT(IN) :: PLBDS
-REAL, DIMENSION(:), INTENT(IN) :: PLBDG
-!
-REAL, DIMENSION(:), INTENT(OUT) :: P_RI_CIBU
-REAL, DIMENSION(:), INTENT(OUT) :: P_CI_CIBU
-!
-END SUBROUTINE LIMA_COLLISIONAL_ICE_BREAKUP
-END INTERFACE
-END MODULE MODI_LIMA_COLLISIONAL_ICE_BREAKUP
-!
+MODULE MODE_LIMA_COLLISIONAL_ICE_BREAKUP
+ IMPLICIT NONE
+CONTAINS
! #######################################################################
- SUBROUTINE LIMA_COLLISIONAL_ICE_BREAKUP (LDCOMPUTE, &
- PRHODREF, &
- PRIT, PRST, PRGT, PCIT, PCST, PCGT, &
- PLBDS, PLBDG, &
- P_RI_CIBU, P_CI_CIBU )
+ SUBROUTINE LIMA_COLLISIONAL_ICE_BREAKUP (LDCOMPUTE, &
+ PRHODREF, &
+ PRIT, PRST, PRGT, PCIT, PCST, PCGT, &
+ PLBDS, PLBDG, &
+ P_RI_CIBU, P_CI_CIBU )
! #######################################################################
!
!! PURPOSE
@@ -418,3 +390,4 @@ END IF
!-------------------------------------------------------------------------------
!
END SUBROUTINE LIMA_COLLISIONAL_ICE_BREAKUP
+END MODULE MODE_LIMA_COLLISIONAL_ICE_BREAKUP
diff --git a/src/PHYEX/micro/mode_lima_compute_cloud_fractions.f90 b/src/PHYEX/micro/mode_lima_compute_cloud_fractions.f90
index bc861da682fa9484669c5ed33d05d189230c20be..98ac4ae517cd8b246674fd551efabd46b21cd441 100644
--- a/src/PHYEX/micro/mode_lima_compute_cloud_fractions.f90
+++ b/src/PHYEX/micro/mode_lima_compute_cloud_fractions.f90
@@ -3,62 +3,18 @@
!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_COMPUTE_CLOUD_FRACTIONS
-!#######################################
- INTERFACE
- SUBROUTINE LIMA_COMPUTE_CLOUD_FRACTIONS (KIB, KIE, KJB, KJE, KKB, KKE, KKL, &
- PCCT, PRCT, &
- PCRT, PRRT, &
- PCIT, PRIT, &
- PCST, PRST, &
- PCGT, PRGT, &
- PCHT, PRHT, &
- PCLDFR, PICEFR, PPRCFR )
- INTEGER, INTENT(IN) :: KIB !
- INTEGER, INTENT(IN) :: KIE !
- INTEGER, INTENT(IN) :: KJB !
- INTEGER, INTENT(IN) :: KJE !
- INTEGER, INTENT(IN) :: KKB !
- INTEGER, INTENT(IN) :: KKE !
- INTEGER, INTENT(IN) :: KKL !
- !
- REAL, DIMENSION(:,:,:),INTENT(IN) :: PCCT !
- REAL, DIMENSION(:,:,:),INTENT(IN) :: PRCT !
- !
- REAL, DIMENSION(:,:,:),INTENT(IN) :: PCRT !
- REAL, DIMENSION(:,:,:),INTENT(IN) :: PRRT !
- !
- REAL, DIMENSION(:,:,:),INTENT(IN) :: PCIT !
- REAL, DIMENSION(:,:,:),INTENT(IN) :: PRIT !
- !
- REAL, DIMENSION(:,:,:),INTENT(IN) :: PCST !
- REAL, DIMENSION(:,:,:),INTENT(IN) :: PRST !
- !
- REAL, DIMENSION(:,:,:),INTENT(IN) :: PCGT !
- REAL, DIMENSION(:,:,:),INTENT(IN) :: PRGT !
- !
- REAL, DIMENSION(:,:,:),INTENT(IN) :: PCHT !
- REAL, DIMENSION(:,:,:),INTENT(IN) :: PRHT !
- !
- REAL, DIMENSION(:,:,:),INTENT(INOUT) :: PCLDFR !
- REAL, DIMENSION(:,:,:),INTENT(INOUT) :: PICEFR !
- REAL, DIMENSION(:,:,:),INTENT(INOUT) :: PPRCFR !
- !
- END SUBROUTINE LIMA_COMPUTE_CLOUD_FRACTIONS
- END INTERFACE
-END MODULE MODI_LIMA_COMPUTE_CLOUD_FRACTIONS
-!
-!
+MODULE MODE_LIMA_COMPUTE_CLOUD_FRACTIONS
+ IMPLICIT NONE
+CONTAINS
!################################################################
-SUBROUTINE LIMA_COMPUTE_CLOUD_FRACTIONS (KIB, KIE, KJB, KJE, KKB, KKE, KKL, &
- PCCT, PRCT, &
- PCRT, PRRT, &
- PCIT, PRIT, &
- PCST, PRST, &
- PCGT, PRGT, &
- PCHT, PRHT, &
- PCLDFR, PICEFR, PPRCFR )
+ SUBROUTINE LIMA_COMPUTE_CLOUD_FRACTIONS (D, &
+ PCCT, PRCT, &
+ PCRT, PRRT, &
+ PCIT, PRIT, &
+ PCST, PRST, &
+ PCGT, PRGT, &
+ PCHT, PRHT, &
+ PCLDFR, PICEFR, PPRCFR )
!################################################################
!
!!
@@ -79,6 +35,7 @@ SUBROUTINE LIMA_COMPUTE_CLOUD_FRACTIONS (KIB, KIE, KJB, KJE, KKB, KKE, KKL, &
!* 0. DECLARATIONS
! ------------
!
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
USE MODD_PARAM_LIMA, ONLY : XCTMIN, XRTMIN, &
NMOM_C, NMOM_R, NMOM_I, NMOM_S, NMOM_G, NMOM_H
!
@@ -86,13 +43,7 @@ IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
!
-INTEGER, INTENT(IN) :: KIB !
-INTEGER, INTENT(IN) :: KIE !
-INTEGER, INTENT(IN) :: KJB !
-INTEGER, INTENT(IN) :: KJE !
-INTEGER, INTENT(IN) :: KKB !
-INTEGER, INTENT(IN) :: KKE !
-INTEGER, INTENT(IN) :: KKL !
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
!
REAL, DIMENSION(:,:,:),INTENT(IN) :: PCCT !
REAL, DIMENSION(:,:,:),INTENT(IN) :: PRCT !
@@ -134,14 +85,14 @@ WHERE(PICEFR(:,:,:)<1.E-10 .AND. PRIT(:,:,:)>XRTMIN(4) .AND. (NMOM_I.EQ.1 .OR. P
!
! Precipitation fraction
!!$PPRCFR(:,:,:) = MAX(PCLDFR(:,:,:),PICEFR(:,:,:))
-!!$DO JI = KIB,KIE
-!!$ DO JJ = KJB, KJE
-!!$ DO JK=KKE-KKL, KKB, -KKL
+!!$DO JI = D%NIB,D%NIE
+!!$ DO JJ = D%NJB, D%NJE
+!!$ DO JK=D%NKE-D%NKL, D%NKB, -D%NKL
!!$ IF ( (PRRT(JI,JJ,JK).GT.XRTMIN(3) .AND. PCRT(JI,JJ,JK).GT.XCTMIN(3)) .OR. &
!!$ PRST(JI,JJ,JK).GT.XRTMIN(5) .OR. &
!!$ PRGT(JI,JJ,JK).GT.XRTMIN(6) .OR. &
!!$ PRHT(JI,JJ,JK).GT.XRTMIN(7) ) THEN
-!!$ PPRCFR(JI,JJ,JK)=MAX(PPRCFR(JI,JJ,JK),PPRCFR(JI,JJ,JK+KKL))
+!!$ PPRCFR(JI,JJ,JK)=MAX(PPRCFR(JI,JJ,JK),PPRCFR(JI,JJ,JK+D%NKL))
!!$ IF (PPRCFR(JI,JJ,JK)==0) THEN
!!$ PPRCFR(JI,JJ,JK)=1.
!!$ END IF
@@ -153,14 +104,14 @@ WHERE(PICEFR(:,:,:)<1.E-10 .AND. PRIT(:,:,:)>XRTMIN(4) .AND. (NMOM_I.EQ.1 .OR. P
!!$END DO
!!$
!!$PPRCFR(:,:,:) = MAX(PCLDFR(:,:,:),PICEFR(:,:,:))
-!!$DO JI = KIB,KIE
-!!$ DO JJ = KJB, KJE
-!!$ DO JK=KKE-KKL, KKB, -KKL
+!!$DO JI = D%NIB,D%NIE
+!!$ DO JJ = D%NJB, D%NJE
+!!$ DO JK=D%NKE-D%NKL, D%NKB, -D%NKL
!!$ IF ( (PRRT(JI,JJ,JK).GT.0. .AND. PCRT(JI,JJ,JK).GT.0.) .OR. &
!!$ PRST(JI,JJ,JK).GT.0. .OR. &
!!$ PRGT(JI,JJ,JK).GT.0. .OR. &
!!$ PRHT(JI,JJ,JK).GT.0. ) THEN
-!!$ PPRCFR(JI,JJ,JK)=MAX(PPRCFR(JI,JJ,JK),PPRCFR(JI,JJ,JK+KKL))
+!!$ PPRCFR(JI,JJ,JK)=MAX(PPRCFR(JI,JJ,JK),PPRCFR(JI,JJ,JK+D%NKL))
!!$ IF (PPRCFR(JI,JJ,JK)==0) THEN
!!$ PPRCFR(JI,JJ,JK)=1.
!!$ END IF
@@ -186,3 +137,4 @@ WHERE ( (PRRT(:,:,:).GT.0. .AND. (NMOM_R.EQ.1 .OR. PCRT(:,:,:).GT.0.) ) .OR. &
!-------------------------------------------------------------------------------
!
END SUBROUTINE LIMA_COMPUTE_CLOUD_FRACTIONS
+END MODULE MODE_LIMA_COMPUTE_CLOUD_FRACTIONS
diff --git a/src/PHYEX/micro/mode_lima_conversion_melting_snow.f90 b/src/PHYEX/micro/mode_lima_conversion_melting_snow.f90
index ef46c794f37aee347aa52ea5bf8c338502b53801..0921e3f73188b680251bbae80789d0f74870c35c 100644
--- a/src/PHYEX/micro/mode_lima_conversion_melting_snow.f90
+++ b/src/PHYEX/micro/mode_lima_conversion_melting_snow.f90
@@ -3,42 +3,14 @@
!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_CONVERSION_MELTING_SNOW
-! #################################
-!
-INTERFACE
- SUBROUTINE LIMA_CONVERSION_MELTING_SNOW (LDCOMPUTE, &
- PRHODREF, PPRES, PT, PKA, PDV, PCJ, &
- PRVT, PRST, PCST, PLBDS, &
- P_RS_CMEL, P_CS_CMEL )
-!
-LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE
-!
-REAL, DIMENSION(:), INTENT(IN) :: PRHODREF ! Reference Exner function
-REAL, DIMENSION(:), INTENT(IN) :: PPRES !
-REAL, DIMENSION(:), INTENT(IN) :: PT !
-REAL, DIMENSION(:), INTENT(IN) :: PKA !
-REAL, DIMENSION(:), INTENT(IN) :: PDV !
-REAL, DIMENSION(:), INTENT(IN) :: PCJ !
-!
-REAL, DIMENSION(:), INTENT(IN) :: PRVT !
-REAL, DIMENSION(:), INTENT(IN) :: PRST ! Snow mr at t
-REAL, DIMENSION(:), INTENT(IN) :: PCST ! Snow C. at t
-REAL, DIMENSION(:), INTENT(IN) :: PLBDS !
-!
-REAL, DIMENSION(:), INTENT(OUT) :: P_RS_CMEL
-REAL, DIMENSION(:), INTENT(OUT) :: P_CS_CMEL
-!
-END SUBROUTINE LIMA_CONVERSION_MELTING_SNOW
-END INTERFACE
-END MODULE MODI_LIMA_CONVERSION_MELTING_SNOW
-!
+MODULE MODE_LIMA_CONVERSION_MELTING_SNOW
+ IMPLICIT NONE
+CONTAINS
! ##############################################################################
- SUBROUTINE LIMA_CONVERSION_MELTING_SNOW (LDCOMPUTE, &
- PRHODREF, PPRES, PT, PKA, PDV, PCJ, &
- PRVT, PRST, PCST, PLBDS, &
- P_RS_CMEL, P_CS_CMEL )
+ SUBROUTINE LIMA_CONVERSION_MELTING_SNOW (LDCOMPUTE, &
+ PRHODREF, PPRES, PT, PKA, PDV, PCJ, &
+ PRVT, PRST, PCST, PLBDS, &
+ P_RS_CMEL, P_CS_CMEL )
! ##############################################################################
!
!! PURPOSE
@@ -127,3 +99,4 @@ END WHERE
!-------------------------------------------------------------------------------
!
END SUBROUTINE LIMA_CONVERSION_MELTING_SNOW
+END MODULE MODE_LIMA_CONVERSION_MELTING_SNOW
diff --git a/src/PHYEX/micro/mode_lima_droplets_accretion.f90 b/src/PHYEX/micro/mode_lima_droplets_accretion.f90
index d183953cd21da3563c87d7fc851af9bd76d10539..8e0119a4380f264f99c14f7c3e76426f049c175e 100644
--- a/src/PHYEX/micro/mode_lima_droplets_accretion.f90
+++ b/src/PHYEX/micro/mode_lima_droplets_accretion.f90
@@ -3,43 +3,15 @@
!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_DROPLETS_ACCRETION
-! #################################
-!
-INTERFACE
- SUBROUTINE LIMA_DROPLETS_ACCRETION (LDCOMPUTE, &
- PRHODREF, &
- PRCT, PRRT, PCCT, PCRT, &
- PLBDC, PLBDC3, PLBDR, PLBDR3, &
- P_RC_ACCR, P_CC_ACCR )
-!
-LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE
-!
-REAL, DIMENSION(:), INTENT(IN) :: PRHODREF ! Reference Exner function
-!
-REAL, DIMENSION(:), INTENT(IN) :: PRCT ! Cloud water m.r. at t
-REAL, DIMENSION(:), INTENT(IN) :: PRRT ! Rain m.r. at t
-REAL, DIMENSION(:), INTENT(IN) :: PCCT ! Cloud water conc. at t
-REAL, DIMENSION(:), INTENT(IN) :: PCRT ! Rain conc. at t
-REAL, DIMENSION(:), INTENT(IN) :: PLBDC !
-REAL, DIMENSION(:), INTENT(IN) :: PLBDC3 !
-REAL, DIMENSION(:), INTENT(IN) :: PLBDR !
-REAL, DIMENSION(:), INTENT(IN) :: PLBDR3 !
-!
-REAL, DIMENSION(:), INTENT(OUT) :: P_RC_ACCR
-REAL, DIMENSION(:), INTENT(OUT) :: P_CC_ACCR
-!
-END SUBROUTINE LIMA_DROPLETS_ACCRETION
-END INTERFACE
-END MODULE MODI_LIMA_DROPLETS_ACCRETION
-!
+MODULE MODE_LIMA_DROPLETS_ACCRETION
+ IMPLICIT NONE
+CONTAINS
! #####################################################################
- SUBROUTINE LIMA_DROPLETS_ACCRETION (LDCOMPUTE, &
- PRHODREF, &
- PRCT, PRRT, PCCT, PCRT, &
- PLBDC, PLBDC3, PLBDR, PLBDR3, &
- P_RC_ACCR, P_CC_ACCR )
+ SUBROUTINE LIMA_DROPLETS_ACCRETION (LDCOMPUTE, &
+ PRHODREF, &
+ PRCT, PRRT, PCCT, PCRT, &
+ PLBDC, PLBDC3, PLBDR, PLBDR3, &
+ P_RC_ACCR, P_CC_ACCR )
! #####################################################################
!
!! PURPOSE
@@ -190,3 +162,4 @@ END IF
!-------------------------------------------------------------------------------
!
END SUBROUTINE LIMA_DROPLETS_ACCRETION
+END MODULE MODE_LIMA_DROPLETS_ACCRETION
diff --git a/src/PHYEX/micro/mode_lima_droplets_autoconversion.f90 b/src/PHYEX/micro/mode_lima_droplets_autoconversion.f90
index 3fa32e7a65c04cff7af42821ceaa37fcbf7b374e..fca3fbf804de1e6b60bc4fd54a9073a4b04eb369 100644
--- a/src/PHYEX/micro/mode_lima_droplets_autoconversion.f90
+++ b/src/PHYEX/micro/mode_lima_droplets_autoconversion.f90
@@ -3,38 +3,14 @@
!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_DROPLETS_AUTOCONVERSION
-! #################################
-!
-INTERFACE
- SUBROUTINE LIMA_DROPLETS_AUTOCONVERSION (LDCOMPUTE, &
- PRHODREF, &
- PRCT, PCCT, PLBDC, PLBDR, &
- P_RC_AUTO, P_CC_AUTO, P_CR_AUTO )
-!
-LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE
-!
-REAL, DIMENSION(:), INTENT(IN) :: PRHODREF ! Reference Exner function
-!
-REAL, DIMENSION(:), INTENT(IN) :: PRCT ! Cloud water m.r. at t
-REAL, DIMENSION(:), INTENT(IN) :: PCCT ! Cloud water conc. at t
-REAL, DIMENSION(:), INTENT(IN) :: PLBDC !
-REAL, DIMENSION(:), INTENT(IN) :: PLBDR !
-!
-REAL, DIMENSION(:), INTENT(OUT) :: P_RC_AUTO
-REAL, DIMENSION(:), INTENT(OUT) :: P_CC_AUTO
-REAL, DIMENSION(:), INTENT(OUT) :: P_CR_AUTO
-!
-END SUBROUTINE LIMA_DROPLETS_AUTOCONVERSION
-END INTERFACE
-END MODULE MODI_LIMA_DROPLETS_AUTOCONVERSION
-!
+MODULE MODE_LIMA_DROPLETS_AUTOCONVERSION
+ IMPLICIT NONE
+CONTAINS
! ##########################################################################
- SUBROUTINE LIMA_DROPLETS_AUTOCONVERSION (LDCOMPUTE, &
- PRHODREF, &
- PRCT, PCCT, PLBDC, PLBDR, &
- P_RC_AUTO, P_CC_AUTO, P_CR_AUTO )
+ SUBROUTINE LIMA_DROPLETS_AUTOCONVERSION (LDCOMPUTE, &
+ PRHODREF, &
+ PRCT, PCCT, PLBDC, PLBDR, &
+ P_RC_AUTO, P_CC_AUTO, P_CR_AUTO )
! ##########################################################################
!
!! PURPOSE
@@ -100,8 +76,8 @@ IF (NMOM_C.EQ.1 .AND. LKESSLERAC) THEN
P_RC_AUTO(:) = - 1.E-3 * MAX ( PRCT(:) - 0.5E-3 / PRHODREF(:), 0. )
ELSE IF (LKHKO) THEN
!
-! 1. Autoconversion of cloud droplets (Berry-Reinhardt parameterization)
-! ----------------------------------------------------------------------
+! 1. Autoconversion of cloud droplets
+! -----------------------------------
!
WHERE ( PRCT(:)>XRTMIN(2) .AND. PCCT(:)>XCTMIN(2) .AND. LDCOMPUTE(:) )
!
@@ -148,3 +124,4 @@ END IF
!-------------------------------------------------------------------------------
!
END SUBROUTINE LIMA_DROPLETS_AUTOCONVERSION
+END MODULE MODE_LIMA_DROPLETS_AUTOCONVERSION
diff --git a/src/PHYEX/micro/mode_lima_droplets_hom_freezing.f90 b/src/PHYEX/micro/mode_lima_droplets_hom_freezing.f90
index b33d7a3501fdf56c3925db691f50a11af30b2e5f..687e161ee34a2f9c138f4510f06f81b4e15035ba 100644
--- a/src/PHYEX/micro/mode_lima_droplets_hom_freezing.f90
+++ b/src/PHYEX/micro/mode_lima_droplets_hom_freezing.f90
@@ -2,40 +2,14 @@
!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_DROPLETS_HOM_FREEZING
-! #################################
-!
-INTERFACE
- SUBROUTINE LIMA_DROPLETS_HOM_FREEZING (PTSTEP, LDCOMPUTE, &
- PT, PLVFACT, PLSFACT, &
- PRCT, PCCT, PLBDC, &
- P_TH_HONC, P_RC_HONC, P_CC_HONC )
-!
-REAL, INTENT(IN) :: PTSTEP
-LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE
-!
-REAL, DIMENSION(:), INTENT(IN) :: PT !
-REAL, DIMENSION(:), INTENT(IN) :: PLVFACT !
-REAL, DIMENSION(:), INTENT(IN) :: PLSFACT !
-!
-REAL, DIMENSION(:), INTENT(IN) :: PRCT ! Cloud water m.r. at t
-REAL, DIMENSION(:), INTENT(IN) :: PCCT ! Cloud water C. at t
-REAL, DIMENSION(:), INTENT(IN) :: PLBDC ! Cloud water lambda
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_HONC
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RC_HONC
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CC_HONC
-!
-END SUBROUTINE LIMA_DROPLETS_HOM_FREEZING
-END INTERFACE
-END MODULE MODI_LIMA_DROPLETS_HOM_FREEZING
-!
+MODULE MODE_LIMA_DROPLETS_HOM_FREEZING
+ IMPLICIT NONE
+CONTAINS
! ##########################################################################
- SUBROUTINE LIMA_DROPLETS_HOM_FREEZING (PTSTEP, LDCOMPUTE, &
- PT, PLVFACT, PLSFACT, &
- PRCT, PCCT, PLBDC, &
- P_TH_HONC, P_RC_HONC, P_CC_HONC )
+ SUBROUTINE LIMA_DROPLETS_HOM_FREEZING (PTSTEP, LDCOMPUTE, &
+ PT, PLVFACT, PLSFACT, &
+ PRCT, PCCT, PLBDC, &
+ P_TH_HONC, P_RC_HONC, P_CC_HONC )
! ##########################################################################
!
!! PURPOSE
@@ -123,3 +97,4 @@ END WHERE
!-------------------------------------------------------------------------------
!
END SUBROUTINE LIMA_DROPLETS_HOM_FREEZING
+END MODULE MODE_LIMA_DROPLETS_HOM_FREEZING
diff --git a/src/PHYEX/micro/mode_lima_droplets_riming_snow.f90 b/src/PHYEX/micro/mode_lima_droplets_riming_snow.f90
index cd46682388de1ab48cd16f98169998029eb2dca6..70ab95d4787ed23f3b4e12fb544d6c25f3edcf40 100644
--- a/src/PHYEX/micro/mode_lima_droplets_riming_snow.f90
+++ b/src/PHYEX/micro/mode_lima_droplets_riming_snow.f90
@@ -3,53 +3,15 @@
!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_DROPLETS_RIMING_SNOW
-! #################################
-!
-INTERFACE
- 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 )
-!
-REAL, INTENT(IN) :: PTSTEP
-LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE
-!
-REAL, DIMENSION(:), INTENT(IN) :: PRHODREF !
-REAL, DIMENSION(:), INTENT(IN) :: PT !
-!
-REAL, DIMENSION(:), INTENT(IN) :: PRCT ! Cloud water mr at t
-REAL, DIMENSION(:), INTENT(IN) :: PCCT ! Cloud water C. at t
-REAL, DIMENSION(:), INTENT(IN) :: PRST ! Snow mr at t
-REAL, DIMENSION(:), INTENT(IN) :: PCST ! Snow C. at t
-REAL, DIMENSION(:), INTENT(IN) :: PLBDC !
-REAL, DIMENSION(:), INTENT(IN) :: PLBDS !
-REAL, DIMENSION(:), INTENT(IN) :: PLVFACT !
-REAL, DIMENSION(:), INTENT(IN) :: PLSFACT !
-!
-REAL, DIMENSION(:), INTENT(OUT) :: P_TH_RIM
-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_CS_RIM
-REAL, DIMENSION(:), INTENT(OUT) :: P_RG_RIM
-!
-REAL, DIMENSION(:), INTENT(OUT) :: P_RI_HMS
-REAL, DIMENSION(:), INTENT(OUT) :: P_CI_HMS
-REAL, DIMENSION(:), INTENT(OUT) :: P_RS_HMS
-!
-END SUBROUTINE LIMA_DROPLETS_RIMING_SNOW
-END INTERFACE
-END MODULE MODI_LIMA_DROPLETS_RIMING_SNOW
-!
+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, &
+ 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 )
! #########################################################################################
!
!! PURPOSE
@@ -234,3 +196,4 @@ END DO
!-------------------------------------------------------------------------------
!
END SUBROUTINE LIMA_DROPLETS_RIMING_SNOW
+END MODULE MODE_LIMA_DROPLETS_RIMING_SNOW
diff --git a/src/PHYEX/micro/mode_lima_droplets_self_collection.f90 b/src/PHYEX/micro/mode_lima_droplets_self_collection.f90
index 79312e8cb058055804d58a2d48c53f10a04deb65..6a4557c89610cb9cafac0c37c4c639926e4b9a90 100644
--- a/src/PHYEX/micro/mode_lima_droplets_self_collection.f90
+++ b/src/PHYEX/micro/mode_lima_droplets_self_collection.f90
@@ -3,34 +3,14 @@
!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_DROPLETS_SELF_COLLECTION
-! #################################
-!
-INTERFACE
- SUBROUTINE LIMA_DROPLETS_SELF_COLLECTION (LDCOMPUTE, &
- PRHODREF, &
- PCCT, PLBDC3, &
- P_CC_SELF )
-!
-LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE
-!
-REAL, DIMENSION(:), INTENT(IN) :: PRHODREF ! Reference Exner function
-!
-REAL, DIMENSION(:), INTENT(IN) :: PCCT ! Cloud water C. at t
-REAL, DIMENSION(:), INTENT(IN) :: PLBDC3 !
-!
-REAL, DIMENSION(:), INTENT(OUT) :: P_CC_SELF
-!
-END SUBROUTINE LIMA_DROPLETS_SELF_COLLECTION
-END INTERFACE
-END MODULE MODI_LIMA_DROPLETS_SELF_COLLECTION
-!
+MODULE MODE_LIMA_DROPLETS_SELF_COLLECTION
+ IMPLICIT NONE
+CONTAINS
! ######################################################################
- SUBROUTINE LIMA_DROPLETS_SELF_COLLECTION (LDCOMPUTE, &
- PRHODREF, &
- PCCT, PLBDC3, &
- P_CC_SELF )
+ SUBROUTINE LIMA_DROPLETS_SELF_COLLECTION (LDCOMPUTE, &
+ PRHODREF, &
+ PCCT, PLBDC3, &
+ P_CC_SELF )
! ######################################################################
!
!! PURPOSE
@@ -92,3 +72,4 @@ END WHERE
!-------------------------------------------------------------------------------
!
END SUBROUTINE LIMA_DROPLETS_SELF_COLLECTION
+END MODULE MODE_LIMA_DROPLETS_SELF_COLLECTION
diff --git a/src/PHYEX/micro/mode_lima_drops_break_up.f90 b/src/PHYEX/micro/mode_lima_drops_break_up.f90
index 697c682469036cd49ecd2f8906efd9bdd1bdb093..e2b36c2ab18e6bfa233bd9c9e27f5c40bbb62927 100644
--- a/src/PHYEX/micro/mode_lima_drops_break_up.f90
+++ b/src/PHYEX/micro/mode_lima_drops_break_up.f90
@@ -2,36 +2,14 @@
!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_DROPS_BREAK_UP
-! ###############################
-!
-INTERFACE
- SUBROUTINE LIMA_DROPS_BREAK_UP (LDCOMPUTE, &
- PCRT, PRRT, &
- P_CR_BRKU, &
- PB_CR )
-
-!
-LOGICAL, DIMENSION(:), INTENT(IN) :: LDCOMPUTE
-!
-REAL, DIMENSION(:), INTENT(IN) :: PCRT !
-REAL, DIMENSION(:), INTENT(IN) :: PRRT !
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CR_BRKU ! Concentration change (#/kg)
-REAL, DIMENSION(:), INTENT(INOUT) :: PB_CR ! Cumulated concentration change (#/kg)
-!
-END SUBROUTINE LIMA_DROPS_BREAK_UP
-END INTERFACE
-END MODULE MODI_LIMA_DROPS_BREAK_UP
-!
-!
+MODULE MODE_LIMA_DROPS_BREAK_UP
+ IMPLICIT NONE
+CONTAINS
! ##########################################
- SUBROUTINE LIMA_DROPS_BREAK_UP (LDCOMPUTE, &
- PCRT, PRRT, &
- P_CR_BRKU, &
- PB_CR )
-
+ SUBROUTINE LIMA_DROPS_BREAK_UP (LDCOMPUTE, &
+ PCRT, PRRT, &
+ P_CR_BRKU, &
+ PB_CR )
! ##########################################
!
!!
@@ -98,3 +76,4 @@ PB_CR(:) = PB_CR(:) + P_CR_BRKU(:)
!-------------------------------------------------------------------------------
!
END SUBROUTINE LIMA_DROPS_BREAK_UP
+END MODULE MODE_LIMA_DROPS_BREAK_UP
diff --git a/src/PHYEX/micro/mode_lima_drops_hom_freezing.f90 b/src/PHYEX/micro/mode_lima_drops_hom_freezing.f90
index b8382155bd2b89953b7a60ae0f54063d4c99af8e..1d3e289dbaad05153f76fc9dd95c23226010cec3 100644
--- a/src/PHYEX/micro/mode_lima_drops_hom_freezing.f90
+++ b/src/PHYEX/micro/mode_lima_drops_hom_freezing.f90
@@ -2,53 +2,16 @@
!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_DROPS_HOM_FREEZING
-! #################################
-!
-INTERFACE
- SUBROUTINE LIMA_DROPS_HOM_FREEZING (PTSTEP, LDCOMPUTE, &
- PEXNREF, PPABST, &
- PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
- PCRT, &
- P_TH_HONR, P_RR_HONR, P_CR_HONR, &
- PB_TH, PB_RR, PB_CR, PB_RG )
-!
-REAL, INTENT(IN) :: PTSTEP
-LOGICAL, DIMENSION(:), INTENT(IN) :: LDCOMPUTE
-!
-REAL, DIMENSION(:), INTENT(IN) :: PEXNREF ! Reference Exner function
-REAL, DIMENSION(:), INTENT(IN) :: PPABST ! abs. pressure at time t
-!
-REAL, DIMENSION(:), INTENT(IN) :: PTHT ! Theta at time t
-REAL, DIMENSION(:), INTENT(IN) :: PRVT ! Water vapor m.r. at t
-REAL, DIMENSION(:), INTENT(IN) :: PRCT ! Cloud water m.r. at t
-REAL, DIMENSION(:), INTENT(IN) :: PRRT ! Rain water m.r. at t
-REAL, DIMENSION(:), INTENT(IN) :: PRIT ! Cloud ice m.r. at t
-REAL, DIMENSION(:), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
-REAL, DIMENSION(:), INTENT(IN) :: PRGT ! Graupel m.r. at t
-!
-REAL, DIMENSION(:), INTENT(IN) :: PCRT ! Rain water C. at t
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_HONR
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RR_HONR
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CR_HONR
-REAL, DIMENSION(:), INTENT(INOUT) :: PB_TH
-REAL, DIMENSION(:), INTENT(INOUT) :: PB_RR
-REAL, DIMENSION(:), INTENT(INOUT) :: PB_CR
-REAL, DIMENSION(:), INTENT(INOUT) :: PB_RG
-!
-END SUBROUTINE LIMA_DROPS_HOM_FREEZING
-END INTERFACE
-END MODULE MODI_LIMA_DROPS_HOM_FREEZING
-!
+MODULE MODE_LIMA_DROPS_HOM_FREEZING
+ IMPLICIT NONE
+CONTAINS
! ###############################################################################
- SUBROUTINE LIMA_DROPS_HOM_FREEZING (PTSTEP, LDCOMPUTE, &
- PEXNREF, PPABST, &
- PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
- PCRT, &
- P_TH_HONR, P_RR_HONR, P_CR_HONR, &
- PB_TH, PB_RR, PB_CR, PB_RG )
+ SUBROUTINE LIMA_DROPS_HOM_FREEZING (PTSTEP, LDCOMPUTE, &
+ PEXNREF, PPABST, &
+ PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
+ PCRT, &
+ P_TH_HONR, P_RR_HONR, P_CR_HONR, &
+ PB_TH, PB_RR, PB_CR, PB_RG )
! ###############################################################################
!
!! PURPOSE
@@ -142,3 +105,4 @@ ENDWHERE
!-------------------------------------------------------------------------------
!
END SUBROUTINE LIMA_DROPS_HOM_FREEZING
+END MODULE MODE_LIMA_DROPS_HOM_FREEZING
diff --git a/src/PHYEX/micro/mode_lima_drops_self_collection.f90 b/src/PHYEX/micro/mode_lima_drops_self_collection.f90
index 3f064dfcdc0f19a5124562e4d8a5658f2a31a7c5..0c16b69b4d41c53ba69667de98731a79df209c38 100644
--- a/src/PHYEX/micro/mode_lima_drops_self_collection.f90
+++ b/src/PHYEX/micro/mode_lima_drops_self_collection.f90
@@ -3,35 +3,14 @@
!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_DROPS_SELF_COLLECTION
-! #################################
-!
-INTERFACE
- SUBROUTINE LIMA_DROPS_SELF_COLLECTION (LDCOMPUTE, &
- PRHODREF, &
- PCRT, PLBDR, PLBDR3, &
- P_CR_SCBU )
-!
-LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE
-!
-REAL, DIMENSION(:), INTENT(IN) :: PRHODREF ! Reference Exner function
-!
-REAL, DIMENSION(:), INTENT(IN) :: PCRT ! Cloud water C. at t
-REAL, DIMENSION(:), INTENT(IN) :: PLBDR !
-REAL, DIMENSION(:), INTENT(IN) :: PLBDR3 !
-!
-REAL, DIMENSION(:), INTENT(OUT) :: P_CR_SCBU
-!
-END SUBROUTINE LIMA_DROPS_SELF_COLLECTION
-END INTERFACE
-END MODULE MODI_LIMA_DROPS_SELF_COLLECTION
-!
+MODULE MODE_LIMA_DROPS_SELF_COLLECTION
+ IMPLICIT NONE
+CONTAINS
! #############################################################
- SUBROUTINE LIMA_DROPS_SELF_COLLECTION (LDCOMPUTE, &
- PRHODREF, &
- PCRT, PLBDR, PLBDR3, &
- P_CR_SCBU )
+ SUBROUTINE LIMA_DROPS_SELF_COLLECTION (LDCOMPUTE, &
+ PRHODREF, &
+ PCRT, PLBDR, PLBDR3, &
+ P_CR_SCBU )
! #############################################################
!
!! PURPOSE
@@ -121,3 +100,4 @@ P_CR_SCBU(:) = - ZW3(:) * PRHODREF(:)
!-------------------------------------------------------------------------------
!
END SUBROUTINE LIMA_DROPS_SELF_COLLECTION
+END MODULE MODE_LIMA_DROPS_SELF_COLLECTION
diff --git a/src/PHYEX/micro/mode_lima_drops_to_droplets_conv.f90 b/src/PHYEX/micro/mode_lima_drops_to_droplets_conv.f90
index b2c63fde29ab9a752faf1669c721d3cce9b47037..808bed2403a360d48509250e1925cea5d12a25ca 100644
--- a/src/PHYEX/micro/mode_lima_drops_to_droplets_conv.f90
+++ b/src/PHYEX/micro/mode_lima_drops_to_droplets_conv.f90
@@ -2,31 +2,12 @@
!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_DROPS_TO_DROPLETS_CONV
-! #################################
-!
-INTERFACE
- SUBROUTINE LIMA_DROPS_TO_DROPLETS_CONV (PRHODREF, PRCT, PRRT, PCCT, PCRT, &
- P_RR_CVRC, P_CR_CVRC )
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF! Cloud water m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCT ! Cloud water m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Rain water m.r. at t
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PCCT ! Cloud water C. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PCRT ! Rain water C. at t
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: P_RR_CVRC
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: P_CR_CVRC
-!
-END SUBROUTINE LIMA_DROPS_TO_DROPLETS_CONV
-END INTERFACE
-END MODULE MODI_LIMA_DROPS_TO_DROPLETS_CONV
-!
+MODULE MODE_LIMA_DROPS_TO_DROPLETS_CONV
+ IMPLICIT NONE
+CONTAINS
! ######################################################################
- SUBROUTINE LIMA_DROPS_TO_DROPLETS_CONV (PRHODREF, PRCT, PRRT, PCCT, PCRT, &
- P_RR_CVRC, P_CR_CVRC )
+ SUBROUTINE LIMA_DROPS_TO_DROPLETS_CONV (CST, PRHODREF, PRCT, PRRT, PCCT, PCRT, &
+ P_RR_CVRC, P_CR_CVRC )
! ######################################################################
!
!! PURPOSE
@@ -50,7 +31,7 @@ END MODULE MODI_LIMA_DROPS_TO_DROPLETS_CONV
!* 0. DECLARATIONS
! ------------
!
-USE MODD_CST, ONLY : XPI, XRHOLW
+USE MODD_CST, ONLY : CST_t
USE MODD_PARAM_LIMA, ONLY : XRTMIN, XCTMIN
USE MODD_PARAM_LIMA_WARM, ONLY : XLBR, XLBEXR, XLBC, XLBEXC, &
XACCR1, XACCR3, XACCR4, XACCR5
@@ -59,6 +40,8 @@ IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
!
+TYPE(CST_t), INTENT(IN) :: CST
+!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF! Cloud water m.r. at t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCT ! Cloud water m.r. at t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Rain water m.r. at t
@@ -88,7 +71,7 @@ ZDR(:,:,:) = 9999.
ZMASKR(:,:,:) = PRRT(:,:,:).GT.XRTMIN(3) .AND. PCRT(:,:,:).GT.XCTMIN(3)
ZMASKC(:,:,:) = PRCT(:,:,:).GT.XRTMIN(2) .AND. PCCT(:,:,:).GT.XCTMIN(2)
WHERE(ZMASKR(:,:,:))
- ZDR(:,:,:)=(6.*PRRT(:,:,:)/XPI/XRHOLW/PCRT(:,:,:))**0.33
+ ZDR(:,:,:)=(6.*PRRT(:,:,:)/CST%XPI/CST%XRHOLW/PCRT(:,:,:))**0.33
END WHERE
!
! Transfer all drops in droplets if out of cloud and Dr<82microns
@@ -101,3 +84,4 @@ END WHERE
!-------------------------------------------------------------------------------
!
END SUBROUTINE LIMA_DROPS_TO_DROPLETS_CONV
+END MODULE MODE_LIMA_DROPS_TO_DROPLETS_CONV
diff --git a/src/PHYEX/micro/mode_lima_functions.f90 b/src/PHYEX/micro/mode_lima_functions.f90
index b5a8f17d782405a0467ae9e39bc3d7cf8faf4b6a..c65e6e23cbca066c1e02102e150f1284118134eb 100644
--- a/src/PHYEX/micro/mode_lima_functions.f90
+++ b/src/PHYEX/micro/mode_lima_functions.f90
@@ -9,189 +9,100 @@
! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90
!-----------------------------------------------------------------
-!#################################
- MODULE MODI_LIMA_FUNCTIONS
-!#################################
-!
-INTERFACE
-!
-FUNCTION MOMG (PALPHA,PNU,PP) RESULT (PMOMG)
- REAL, INTENT(IN) :: PALPHA
- REAL, INTENT(IN) :: PNU
- REAL, INTENT(IN) :: PP
- REAL :: PMOMG
-END FUNCTION MOMG
-!
-FUNCTION RECT(PA,PB,PX,PX1,PX2) RESULT(PRECT)
- REAL, INTENT(IN) :: PA
- REAL, INTENT(IN) :: PB
- REAL, DIMENSION(:), INTENT(IN) :: PX
- REAL, INTENT(IN) :: PX1
- REAL, INTENT(IN) :: PX2
- REAL, DIMENSION(SIZE(PX,1)) :: PRECT
-END FUNCTION RECT
-!
-FUNCTION DELTA(PA,PB,PX,PX1,PX2) RESULT(PDELTA)
- REAL, INTENT(IN) :: PA
- REAL, INTENT(IN) :: PB
- REAL, DIMENSION(:), INTENT(IN) :: PX
- REAL, INTENT(IN) :: PX1
- REAL, INTENT(IN) :: PX2
- REAL, DIMENSION(SIZE(PX,1)) :: PDELTA
-END FUNCTION DELTA
-!
-FUNCTION DELTA_VEC(PA,PB,PX,PX1,PX2) RESULT(PDELTA_VEC)
- REAL, INTENT(IN) :: PA
- REAL, INTENT(IN) :: PB
- REAL, DIMENSION(:), INTENT(IN) :: PX
- REAL, DIMENSION(:), INTENT(IN) :: PX1
- REAL, DIMENSION(:), INTENT(IN) :: PX2
- REAL, DIMENSION(SIZE(PX,1)) :: PDELTA_VEC
-END FUNCTION DELTA_VEC
-!
-SUBROUTINE GAULAG(x,w,n,alf)
- INTEGER, INTENT(IN) :: n
- REAL, INTENT(IN) :: alf
- REAL, DIMENSION(n), INTENT(INOUT) :: w, x
-END SUBROUTINE GAULAG
-!
-SUBROUTINE GAUHER(x,w,n)
- INTEGER, INTENT(IN) :: n
- REAL, DIMENSION(n), INTENT(INOUT) :: w, x
-END SUBROUTINE GAUHER
-!
-END INTERFACE
-!
-END MODULE MODI_LIMA_FUNCTIONS
-!
-!------------------------------------------------------------------------------
-!
-!###########################################
-FUNCTION MOMG (PALPHA,PNU,PP) RESULT (PMOMG)
-!###########################################
-!
-! auxiliary routine used to compute the Pth moment order of the generalized
-! gamma law
-!
- USE MODI_GAMMA
-!
+MODULE MODE_LIMA_FUNCTIONS
IMPLICIT NONE
+CONTAINS
!
- REAL :: PALPHA ! first shape parameter of the dimensionnal distribution
- REAL :: PNU ! second shape parameter of the dimensionnal distribution
- REAL :: PP ! order of the moment
- REAL :: PMOMG ! result: moment of order ZP
-!
- PMOMG = GAMMA_X0D(PNU+PP/PALPHA)/GAMMA_X0D(PNU)
+!------------------------------------------------------------------------------
!
-END FUNCTION MOMG
+ FUNCTION MOMG (PALPHA,PNU,PP) RESULT (PMOMG)
+! Pth moment order of the generalized gamma law
+ USE MODI_GAMMA
+ IMPLICIT NONE
+ REAL :: PALPHA ! first shape parameter of the dimensionnal distribution
+ REAL :: PNU ! second shape parameter of the dimensionnal distribution
+ REAL :: PP ! order of the moment
+ REAL :: PMOMG ! result: moment of order ZP
+ PMOMG = GAMMA_X0D(PNU+PP/PALPHA)/GAMMA_X0D(PNU)
+ END FUNCTION MOMG
!
!------------------------------------------------------------------------------
!
-!#############################################
-FUNCTION RECT(PA,PB,PX,PX1,PX2) RESULT(PRECT)
-!#############################################
-!
+ FUNCTION RECT(PA,PB,PX,PX1,PX2) RESULT(PRECT)
! PRECT takes the value PA if PX1<=PX<PX2, and PB outside the [PX1;PX2[ interval
-!
- IMPLICIT NONE
-!
- REAL, INTENT(IN) :: PA
- REAL, INTENT(IN) :: PB
- REAL, DIMENSION(:), INTENT(IN) :: PX
- REAL, INTENT(IN) :: PX1
- REAL, INTENT(IN) :: PX2
- REAL, DIMENSION(SIZE(PX,1)) :: PRECT
-!
- PRECT(:) = PB
- WHERE (PX(:).GE.PX1 .AND. PX(:).LT.PX2)
- PRECT(:) = PA
- END WHERE
- RETURN
-!
-END FUNCTION RECT
+ IMPLICIT NONE
+ REAL, INTENT(IN) :: PA
+ REAL, INTENT(IN) :: PB
+ REAL, DIMENSION(:), INTENT(IN) :: PX
+ REAL, INTENT(IN) :: PX1
+ REAL, INTENT(IN) :: PX2
+ REAL, DIMENSION(SIZE(PX,1)) :: PRECT
+ PRECT(:) = PB
+ WHERE (PX(:).GE.PX1 .AND. PX(:).LT.PX2)
+ PRECT(:) = PA
+ END WHERE
+ RETURN
+ END FUNCTION RECT
!
!-------------------------------------------------------------------------------
!
-!###############################################
-FUNCTION DELTA(PA,PB,PX,PX1,PX2) RESULT(PDELTA)
-!###############################################
-!
+ FUNCTION DELTA(PA,PB,PX,PX1,PX2) RESULT(PDELTA)
! PDELTA takes the value PA if PX<PX1, and PB if PX>=PX2
! PDELTA is a cubic interpolation between PA and PB for PX between PX1 and PX2
-!
- IMPLICIT NONE
-!
- REAL, INTENT(IN) :: PA
- REAL, INTENT(IN) :: PB
- REAL, DIMENSION(:), INTENT(IN) :: PX
- REAL, INTENT(IN) :: PX1
- REAL, INTENT(IN) :: PX2
- REAL, DIMENSION(SIZE(PX,1)) :: PDELTA
-!
-!* local variable
-!
- REAL :: ZA
-!
- ZA = 6.0*(PA-PB)/(PX2-PX1)**3
- WHERE (PX(:).LT.PX1)
- PDELTA(:) = PA
- ELSEWHERE (PX(:).GE.PX2)
- PDELTA(:) = PB
- ELSEWHERE
- PDELTA(:) = PA + ZA*PX1**2*(PX1/6.0 - 0.5*PX2) &
- + ZA*PX1*PX2* (PX(:)) &
- - (0.5*ZA*(PX1+PX2))* (PX(:)**2) &
- + (ZA/3.0)* (PX(:)**3)
- END WHERE
- RETURN
-!
-END FUNCTION DELTA
+ IMPLICIT NONE
+ REAL, INTENT(IN) :: PA
+ REAL, INTENT(IN) :: PB
+ REAL, DIMENSION(:), INTENT(IN) :: PX
+ REAL, INTENT(IN) :: PX1
+ REAL, INTENT(IN) :: PX2
+ REAL, DIMENSION(SIZE(PX,1)) :: PDELTA
+ REAL :: ZA
+ ZA = 6.0*(PA-PB)/(PX2-PX1)**3
+ WHERE (PX(:).LT.PX1)
+ PDELTA(:) = PA
+ ELSEWHERE (PX(:).GE.PX2)
+ PDELTA(:) = PB
+ ELSEWHERE
+ PDELTA(:) = PA + ZA*PX1**2*(PX1/6.0 - 0.5*PX2) &
+ + ZA*PX1*PX2* (PX(:)) &
+ - (0.5*ZA*(PX1+PX2))* (PX(:)**2) &
+ + (ZA/3.0)* (PX(:)**3)
+ END WHERE
+ RETURN
+!
+ END FUNCTION DELTA
!
!-------------------------------------------------------------------------------
!
-!#######################################################
-FUNCTION DELTA_VEC(PA,PB,PX,PX1,PX2) RESULT(PDELTA_VEC)
-!#######################################################
-!
+ FUNCTION DELTA_VEC(PA,PB,PX,PX1,PX2) RESULT(PDELTA_VEC)
! Same as DELTA for vectorized PX1 and PX2 arguments
-!
- IMPLICIT NONE
-!
- REAL, INTENT(IN) :: PA
- REAL, INTENT(IN) :: PB
- REAL, DIMENSION(:), INTENT(IN) :: PX
- REAL, DIMENSION(:), INTENT(IN) :: PX1
- REAL, DIMENSION(:), INTENT(IN) :: PX2
- REAL, DIMENSION(SIZE(PX,1)) :: PDELTA_VEC
-!
-!* local variable
-!
- REAL, DIMENSION(SIZE(PX,1)) :: ZA
-!
- ZA(:) = 0.0
- wHERE (PX(:)<=PX1(:))
- PDELTA_VEC(:) = PA
- ELSEWHERE (PX(:)>=PX2(:))
- PDELTA_VEC(:) = PB
- ELSEWHERE
- ZA(:) = 6.0*(PA-PB)/(PX2(:)-PX1(:))**3
- PDELTA_VEC(:) = PA + ZA(:)*PX1(:)**2*(PX1(:)/6.0 - 0.5*PX2(:)) &
- + ZA(:)*PX1(:)*PX2(:)* (PX(:)) &
- - (0.5*ZA(:)*(PX1(:)+PX2(:)))* (PX(:)**2) &
- + (ZA(:)/3.0)* (PX(:)**3)
- END WHERE
- RETURN
-!
-END FUNCTION DELTA_VEC
+ IMPLICIT NONE
+ REAL, INTENT(IN) :: PA
+ REAL, INTENT(IN) :: PB
+ REAL, DIMENSION(:), INTENT(IN) :: PX
+ REAL, DIMENSION(:), INTENT(IN) :: PX1
+ REAL, DIMENSION(:), INTENT(IN) :: PX2
+ REAL, DIMENSION(SIZE(PX,1)) :: PDELTA_VEC
+ REAL, DIMENSION(SIZE(PX,1)) :: ZA
+ ZA(:) = 0.0
+ wHERE (PX(:)<=PX1(:))
+ PDELTA_VEC(:) = PA
+ ELSEWHERE (PX(:)>=PX2(:))
+ PDELTA_VEC(:) = PB
+ ELSEWHERE
+ ZA(:) = 6.0*(PA-PB)/(PX2(:)-PX1(:))**3
+ PDELTA_VEC(:) = PA + ZA(:)*PX1(:)**2*(PX1(:)/6.0 - 0.5*PX2(:)) &
+ + ZA(:)*PX1(:)*PX2(:)* (PX(:)) &
+ - (0.5*ZA(:)*(PX1(:)+PX2(:)))* (PX(:)**2) &
+ + (ZA(:)/3.0)* (PX(:)**3)
+ END WHERE
+ RETURN
+ END FUNCTION DELTA_VEC
!
!-------------------------------------------------------------------------------
!
-!###########################
SUBROUTINE gaulag(x,w,n,alf)
-!###########################
use modd_precision, only: MNHREAL64
-
INTEGER n,MAXIT
REAL alf,w(n),x(n)
REAL(kind=MNHREAL64) :: EPS
@@ -228,9 +139,7 @@ SUBROUTINE gaulag(x,w,n,alf)
1 x(i)=z
w(i)=-exp(gammln(alf+n)-gammln(real(n)))/(pp*n*p2)
13 continue
-!
! NORMALISATION
-!
SUMW = 0.0
DO 14 I=1,N
SUMW = SUMW + W(I)
@@ -244,11 +153,8 @@ END SUBROUTINE gaulag
!
!------------------------------------------------------------------------------
!
-!##########################################
SUBROUTINE gauher(x,w,n)
-!##########################################
use modd_precision, only: MNHREAL64
-
INTEGER n,MAXIT
REAL w(n),x(n)
REAL(kind=MNHREAL64) :: EPS,PIM4
@@ -290,9 +196,7 @@ SUBROUTINE gauher(x,w,n)
w(i)=2.0/(pp*pp)
w(n+1-i)=w(i)
13 continue
-!
! NORMALISATION
-!
SUMW = 0.0
DO 14 I=1,N
SUMW = SUMW + W(I)
@@ -305,3 +209,36 @@ SUBROUTINE gauher(x,w,n)
END SUBROUTINE gauher
!
!------------------------------------------------------------------------------
+!
+FUNCTION ARTH(FIRST,INCREMENT,N)
+ REAL,INTENT(IN) :: FIRST,INCREMENT
+ INTEGER,INTENT(IN) :: N
+ REAL,DIMENSION(N) :: ARTH
+ INTEGER :: K
+ DO K=1,N
+ ARTH(K)=FIRST+INCREMENT*(K-1)
+ END DO
+END FUNCTION ARTH
+!
+!------------------------------------------------------------------------------
+!
+FUNCTION gammln(xx)
+ IMPLICIT NONE
+ REAL, INTENT(IN) :: xx
+ REAL :: gammln
+ REAL :: tmp,x
+ REAL :: stp = 2.5066282746310005
+ REAL, DIMENSION(6) :: coef = (/76.18009172947146,&
+ -86.50532032941677,24.01409824083091,&
+ -1.231739572450155,0.1208650973866179e-2,&
+ -0.5395239384953e-5/)
+ x=xx
+ tmp=x+5.5
+ tmp=(x+0.5)*log(tmp)-tmp
+ gammln=tmp+log(stp*(1.000000000190015+&
+ sum(coef(:)/arth(x+1.,1.,size(coef))))/x)
+END FUNCTION gammln
+!
+!------------------------------------------------------------------------------
+!
+END MODULE MODE_LIMA_FUNCTIONS
diff --git a/src/PHYEX/micro/mode_lima_graupel.f90 b/src/PHYEX/micro/mode_lima_graupel.f90
index 8c96d2e0957a34003e2c4ff6ff5bf10b7bebcda1..42dfa71fbae577e18dab94b672e7be2cb42dae02 100644
--- a/src/PHYEX/micro/mode_lima_graupel.f90
+++ b/src/PHYEX/micro/mode_lima_graupel.f90
@@ -3,123 +3,24 @@
!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_GRAUPEL
-! #################################
-!
-INTERFACE
- SUBROUTINE LIMA_GRAUPEL (PTSTEP, LDCOMPUTE, &
- PRHODREF, PPRES, PT, PKA, PDV, PCJ, &
- PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
- PCCT, PCRT, PCIT, PCST, PCGT, &
- PLBDC, PLBDR, PLBDS, PLBDG, &
- PLVFACT, PLSFACT, &
- P_TH_WETG, P_RC_WETG, P_CC_WETG, P_RR_WETG, P_CR_WETG, &
- P_RI_WETG, P_CI_WETG, P_RS_WETG, P_CS_WETG, P_RG_WETG, P_CG_WETG, P_RH_WETG, &
- P_TH_DRYG, P_RC_DRYG, P_CC_DRYG, P_RR_DRYG, P_CR_DRYG, &
- P_RI_DRYG, P_CI_DRYG, P_RS_DRYG, P_CS_DRYG, P_RG_DRYG, &
- P_RI_HMG, P_CI_HMG, P_RG_HMG, &
- P_TH_GMLT, P_RR_GMLT, P_CR_GMLT, P_CG_GMLT, &
- PA_TH, PA_RC, PA_CC, PA_RR, PA_CR, &
- PA_RI, PA_CI, PA_RS, PA_CS, PA_RG, PA_CG, PA_RH, PA_CH )
-!
-REAL, INTENT(IN) :: PTSTEP
-LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE
-!
-REAL, DIMENSION(:), INTENT(IN) :: PRHODREF !
-REAL, DIMENSION(:), INTENT(IN) :: PPRES !
-REAL, DIMENSION(:), INTENT(IN) :: PT !
-REAL, DIMENSION(:), INTENT(IN) :: PKA !
-REAL, DIMENSION(:), INTENT(IN) :: PDV !
-REAL, DIMENSION(:), INTENT(IN) :: PCJ !
-!
-REAL, DIMENSION(:), INTENT(IN) :: PRVT !
-REAL, DIMENSION(:), INTENT(IN) :: PRCT !
-REAL, DIMENSION(:), INTENT(IN) :: PRRT !
-REAL, DIMENSION(:), INTENT(IN) :: PRIT !
-REAL, DIMENSION(:), INTENT(IN) :: PRST !
-REAL, DIMENSION(:), INTENT(IN) :: PRGT !
-!
-REAL, DIMENSION(:), INTENT(IN) :: PCCT !
-REAL, DIMENSION(:), INTENT(IN) :: PCRT !
-REAL, DIMENSION(:), INTENT(IN) :: PCIT !
-REAL, DIMENSION(:), INTENT(IN) :: PCST !
-REAL, DIMENSION(:), INTENT(IN) :: PCGT !
-!
-REAL, DIMENSION(:), INTENT(IN) :: PLBDC !
-REAL, DIMENSION(:), INTENT(IN) :: PLBDR !
-REAL, DIMENSION(:), INTENT(IN) :: PLBDS !
-REAL, DIMENSION(:), INTENT(IN) :: PLBDG !
-!
-REAL, DIMENSION(:), INTENT(IN) :: PLVFACT !
-REAL, DIMENSION(:), INTENT(IN) :: PLSFACT !
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_WETG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RC_WETG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CC_WETG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RR_WETG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CR_WETG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RI_WETG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CI_WETG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RS_WETG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CS_WETG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RG_WETG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CG_WETG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RH_WETG
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_DRYG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RC_DRYG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CC_DRYG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RR_DRYG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CR_DRYG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RI_DRYG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CI_DRYG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RS_DRYG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CS_DRYG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RG_DRYG
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RI_HMG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CI_HMG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RG_HMG
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_GMLT
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RR_GMLT
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CR_GMLT
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CG_GMLT
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_TH
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RC
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_CC
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RR
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_CR
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RI
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_CI
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RS
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_CS
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RG
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_CG
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RH
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_CH
-!
-END SUBROUTINE LIMA_GRAUPEL
-END INTERFACE
-END MODULE MODI_LIMA_GRAUPEL
-!
+MODULE MODE_LIMA_GRAUPEL
+ IMPLICIT NONE
+CONTAINS
! #################################################################################
- SUBROUTINE LIMA_GRAUPEL (PTSTEP, LDCOMPUTE, &
- PRHODREF, PPRES, PT, PKA, PDV, PCJ, &
- PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
- PCCT, PCRT, PCIT, PCST, PCGT, &
- PLBDC, PLBDR, PLBDS, PLBDG, &
- PLVFACT, PLSFACT, &
- P_TH_WETG, P_RC_WETG, P_CC_WETG, P_RR_WETG, P_CR_WETG, &
- P_RI_WETG, P_CI_WETG, P_RS_WETG, P_CS_WETG, P_RG_WETG, P_CG_WETG, P_RH_WETG, &
- P_TH_DRYG, P_RC_DRYG, P_CC_DRYG, P_RR_DRYG, P_CR_DRYG, &
- P_RI_DRYG, P_CI_DRYG, P_RS_DRYG, P_CS_DRYG, P_RG_DRYG, &
- P_RI_HMG, P_CI_HMG, P_RG_HMG, &
- P_TH_GMLT, P_RR_GMLT, P_CR_GMLT, P_CG_GMLT, &
- PA_TH, PA_RC, PA_CC, PA_RR, PA_CR, &
- PA_RI, PA_CI, PA_RS, PA_CS, PA_RG, PA_CG, PA_RH, PA_CH )
+ SUBROUTINE LIMA_GRAUPEL (PTSTEP, LDCOMPUTE, &
+ PRHODREF, PPRES, PT, PKA, PDV, PCJ, &
+ PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
+ PCCT, PCRT, PCIT, PCST, PCGT, &
+ PLBDC, PLBDR, PLBDS, PLBDG, &
+ PLVFACT, PLSFACT, &
+ P_TH_WETG, P_RC_WETG, P_CC_WETG, P_RR_WETG, P_CR_WETG, &
+ P_RI_WETG, P_CI_WETG, P_RS_WETG, P_CS_WETG, P_RG_WETG, P_CG_WETG, P_RH_WETG, &
+ P_TH_DRYG, P_RC_DRYG, P_CC_DRYG, P_RR_DRYG, P_CR_DRYG, &
+ P_RI_DRYG, P_CI_DRYG, P_RS_DRYG, P_CS_DRYG, P_RG_DRYG, &
+ P_RI_HMG, P_CI_HMG, P_RG_HMG, &
+ P_TH_GMLT, P_RR_GMLT, P_CR_GMLT, P_CG_GMLT, &
+ PA_TH, PA_RC, PA_CC, PA_RR, PA_CR, &
+ PA_RI, PA_CI, PA_RS, PA_CS, PA_RG, PA_CG, PA_RH, PA_CH )
! #################################################################################
!
!! PURPOSE
@@ -146,7 +47,7 @@ END MODULE MODI_LIMA_GRAUPEL
! ------------
!
USE MODD_CST, ONLY : XTT, XMD, XMV, XRD, XRV, XLVTT, XLMTT, XESTT, XCL, XCI, XCPV
-USE MODD_PARAM_LIMA, ONLY : XRTMIN, XCTMIN, XCEXVT, LHAIL
+USE MODD_PARAM_LIMA, ONLY : XRTMIN, XCTMIN, XCEXVT, NMOM_H
USE MODD_PARAM_LIMA_MIXED, ONLY : XCXG, XDG, X0DEPG, X1DEPG, NGAMINC, &
XFCDRYG, XFIDRYG, XCOLIG, XCOLSG, XCOLEXIG, XCOLEXSG, &
XFSDRYG, XLBSDRYG1, XLBSDRYG2, XLBSDRYG3, XKER_SDRYG, &
@@ -487,7 +388,7 @@ END WHERE
!
ZZW(:) = 0.0
NHAIL = 0.
-IF (LHAIL) NHAIL = 1.
+IF (NMOM_H.GE.1) NHAIL = 1.
WHERE( LDCOMPUTE(:) .AND. PRGT(:)>XRTMIN(6) .AND. PCGT(:)>XCTMIN(6) .AND. PT(:)<XTT .AND. &
(ZRDRYG(:)-ZZW2(:)-ZZW3(:))>=(ZRWETG(:)-ZZW5(:)-ZZW6(:)) .AND. ZRWETG(:)-ZZW5(:)-ZZW6(:)>0.0 )
!
@@ -668,3 +569,4 @@ CONTAINS
!-------------------------------------------------------------------------------
!
END SUBROUTINE LIMA_GRAUPEL
+END MODULE MODE_LIMA_GRAUPEL
diff --git a/src/PHYEX/micro/mode_lima_graupel_deposition.f90 b/src/PHYEX/micro/mode_lima_graupel_deposition.f90
index 83b28e3d202d33d6339b48fd0d81b7f5b79cdc5b..14e970084e17abc54a598dd2720b5e1e84156e84 100644
--- a/src/PHYEX/micro/mode_lima_graupel_deposition.f90
+++ b/src/PHYEX/micro/mode_lima_graupel_deposition.f90
@@ -3,37 +3,13 @@
!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_GRAUPEL_DEPOSITION
-! #################################
-!
-INTERFACE
- SUBROUTINE LIMA_GRAUPEL_DEPOSITION (LDCOMPUTE, PRHODREF, &
- PRGT, PCGT, PSSI, PLBDG, PAI, PCJ, PLSFACT, &
- P_TH_DEPG, P_RG_DEPG )
-!
-LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE
-REAL, DIMENSION(:), INTENT(IN) :: PRHODREF !
-!
-REAL, DIMENSION(:), INTENT(IN) :: PRGT ! graupel mr
-REAL, DIMENSION(:), INTENT(IN) :: PCGT ! graupel conc
-REAL, DIMENSION(:), INTENT(IN) :: PSSI !
-REAL, DIMENSION(:), INTENT(IN) :: PLBDG !
-REAL, DIMENSION(:), INTENT(IN) :: PAI !
-REAL, DIMENSION(:), INTENT(IN) :: PCJ !
-REAL, DIMENSION(:), INTENT(IN) :: PLSFACT !
-!
-REAL, DIMENSION(:), INTENT(OUT) :: P_TH_DEPG
-REAL, DIMENSION(:), INTENT(OUT) :: P_RG_DEPG
-!!
-END SUBROUTINE LIMA_GRAUPEL_DEPOSITION
-END INTERFACE
-END MODULE MODI_LIMA_GRAUPEL_DEPOSITION
-!
+MODULE MODE_LIMA_GRAUPEL_DEPOSITION
+ IMPLICIT NONE
+CONTAINS
! ###########################################################################
- SUBROUTINE LIMA_GRAUPEL_DEPOSITION (LDCOMPUTE, PRHODREF, &
- PRGT, PCGT, PSSI, PLBDG, PAI, PCJ, PLSFACT, &
- P_TH_DEPG, P_RG_DEPG )
+ SUBROUTINE LIMA_GRAUPEL_DEPOSITION (LDCOMPUTE, PRHODREF, &
+ PRGT, PCGT, PSSI, PLBDG, PAI, PCJ, PLSFACT, &
+ P_TH_DEPG, P_RG_DEPG )
! ###########################################################################
!
!! PURPOSE
@@ -98,3 +74,4 @@ END WHERE
!-------------------------------------------------------------------------------
!
END SUBROUTINE LIMA_GRAUPEL_DEPOSITION
+END MODULE MODE_LIMA_GRAUPEL_DEPOSITION
diff --git a/src/PHYEX/micro/mode_lima_hail.f90 b/src/PHYEX/micro/mode_lima_hail.f90
index 8392316ae4106fd1e9ed2cbb4f22d287b084818e..4d1fef9038708a7578e9491e8cccc2b215d2fb65 100644
--- a/src/PHYEX/micro/mode_lima_hail.f90
+++ b/src/PHYEX/micro/mode_lima_hail.f90
@@ -3,110 +3,22 @@
!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_HAIL
-! #################################
-!
-INTERFACE
- SUBROUTINE LIMA_HAIL (PTSTEP, LDCOMPUTE, &
- PRHODREF, PPRES, PT, PKA, PDV, PCJ, &
- PRVT, PRCT, PRRT, PRIT, PRST, PRGT, PRHT, &
- PCCT, PCRT, PCIT, PCST, PCGT, PCHT, &
- PLBDC, PLBDR, PLBDS, PLBDG, PLBDH, &
- PLVFACT, PLSFACT, &
- P_TH_WETH, P_RC_WETH, P_CC_WETH, P_RR_WETH, P_CR_WETH, &
- P_RI_WETH, P_CI_WETH, P_RS_WETH, P_CS_WETH, P_RG_WETH, P_CG_WETH, P_RH_WETH, &
- P_RG_COHG, P_CG_COHG, &
- P_TH_HMLT, P_RR_HMLT, P_CR_HMLT, P_CH_HMLT, &
- PA_TH, PA_RC, PA_CC, PA_RR, PA_CR, &
- PA_RI, PA_CI, PA_RS, PA_CS, PA_RG, PA_CG, PA_RH, PA_CH )
-!
-REAL, INTENT(IN) :: PTSTEP
-LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE
-!
-REAL, DIMENSION(:), INTENT(IN) :: PRHODREF !
-REAL, DIMENSION(:), INTENT(IN) :: PPRES !
-REAL, DIMENSION(:), INTENT(IN) :: PT !
-REAL, DIMENSION(:), INTENT(IN) :: PKA !
-REAL, DIMENSION(:), INTENT(IN) :: PDV !
-REAL, DIMENSION(:), INTENT(IN) :: PCJ !
-!
-REAL, DIMENSION(:), INTENT(IN) :: PRVT !
-REAL, DIMENSION(:), INTENT(IN) :: PRCT !
-REAL, DIMENSION(:), INTENT(IN) :: PRRT !
-REAL, DIMENSION(:), INTENT(IN) :: PRIT !
-REAL, DIMENSION(:), INTENT(IN) :: PRST !
-REAL, DIMENSION(:), INTENT(IN) :: PRGT !
-REAL, DIMENSION(:), INTENT(IN) :: PRHT !
-!
-REAL, DIMENSION(:), INTENT(IN) :: PCCT !
-REAL, DIMENSION(:), INTENT(IN) :: PCRT !
-REAL, DIMENSION(:), INTENT(IN) :: PCIT !
-REAL, DIMENSION(:), INTENT(IN) :: PCST !
-REAL, DIMENSION(:), INTENT(IN) :: PCGT !
-REAL, DIMENSION(:), INTENT(IN) :: PCHT !
-!
-REAL, DIMENSION(:), INTENT(IN) :: PLBDC !
-REAL, DIMENSION(:), INTENT(IN) :: PLBDR !
-REAL, DIMENSION(:), INTENT(IN) :: PLBDS !
-REAL, DIMENSION(:), INTENT(IN) :: PLBDG !
-REAL, DIMENSION(:), INTENT(IN) :: PLBDH !
-!
-REAL, DIMENSION(:), INTENT(IN) :: PLVFACT !
-REAL, DIMENSION(:), INTENT(IN) :: PLSFACT !
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_WETH
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RC_WETH
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CC_WETH
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RR_WETH
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CR_WETH
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RI_WETH
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CI_WETH
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RS_WETH
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CS_WETH
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RG_WETH
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CG_WETH
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RH_WETH
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RG_COHG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CG_COHG
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_HMLT
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RR_HMLT
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CR_HMLT
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CH_HMLT
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_TH
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RC
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_CC
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RR
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_CR
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RI
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_CI
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RS
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_CS
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RG
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_CG
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RH
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_CH
-!
-END SUBROUTINE LIMA_HAIL
-END INTERFACE
-END MODULE MODI_LIMA_HAIL
-!
+MODULE MODE_LIMA_HAIL
+ IMPLICIT NONE
+CONTAINS
! #################################################################################
- SUBROUTINE LIMA_HAIL (PTSTEP, LDCOMPUTE, &
- PRHODREF, PPRES, PT, PKA, PDV, PCJ, &
- PRVT, PRCT, PRRT, PRIT, PRST, PRGT, PRHT, &
- PCCT, PCRT, PCIT, PCST, PCGT, PCHT, &
- PLBDC, PLBDR, PLBDS, PLBDG, PLBDH, &
- PLVFACT, PLSFACT, &
- P_TH_WETH, P_RC_WETH, P_CC_WETH, P_RR_WETH, P_CR_WETH, &
- P_RI_WETH, P_CI_WETH, P_RS_WETH, P_CS_WETH, P_RG_WETH, P_CG_WETH, P_RH_WETH, &
- P_RG_COHG, P_CG_COHG, &
- P_TH_HMLT, P_RR_HMLT, P_CR_HMLT, P_CH_HMLT, &
- PA_TH, PA_RC, PA_CC, PA_RR, PA_CR, &
- PA_RI, PA_CI, PA_RS, PA_CS, PA_RG, PA_CG, PA_RH, PA_CH )
+ SUBROUTINE LIMA_HAIL (PTSTEP, LDCOMPUTE, &
+ PRHODREF, PPRES, PT, PKA, PDV, PCJ, &
+ PRVT, PRCT, PRRT, PRIT, PRST, PRGT, PRHT, &
+ PCCT, PCRT, PCIT, PCST, PCGT, PCHT, &
+ PLBDC, PLBDR, PLBDS, PLBDG, PLBDH, &
+ PLVFACT, PLSFACT, &
+ P_TH_WETH, P_RC_WETH, P_CC_WETH, P_RR_WETH, P_CR_WETH, &
+ P_RI_WETH, P_CI_WETH, P_RS_WETH, P_CS_WETH, P_RG_WETH, P_CG_WETH, P_RH_WETH, &
+ P_RG_COHG, P_CG_COHG, &
+ P_TH_HMLT, P_RR_HMLT, P_CR_HMLT, P_CH_HMLT, &
+ PA_TH, PA_RC, PA_CC, PA_RR, PA_CR, &
+ PA_RI, PA_CI, PA_RS, PA_CS, PA_RG, PA_CG, PA_RH, PA_CH )
! #################################################################################
!
!! PURPOSE
@@ -133,7 +45,7 @@ END MODULE MODI_LIMA_HAIL
! ------------
!
USE MODD_CST, ONLY : XTT, XMD, XMV, XRD, XRV, XLVTT, XLMTT, XESTT, XCL, XCI, XCPV
-USE MODD_PARAM_LIMA, ONLY : XRTMIN, XCTMIN, XCEXVT, LHAIL
+USE MODD_PARAM_LIMA, ONLY : XRTMIN, XCTMIN, XCEXVT
USE MODD_PARAM_LIMA_MIXED, ONLY : NWETLBDAG, XWETINTP1G, XWETINTP2G, &
NWETLBDAH, X0DEPH, X1DEPH, XDH, XEX0DEPH, XEX1DEPH, &
XFWETH, XWETINTP1H, XWETINTP2H, &
@@ -574,3 +486,4 @@ CONTAINS
!-------------------------------------------------------------------------------
!
END SUBROUTINE LIMA_HAIL
+END MODULE MODE_LIMA_HAIL
diff --git a/src/PHYEX/micro/mode_lima_hail_deposition.f90 b/src/PHYEX/micro/mode_lima_hail_deposition.f90
index 1b411138fdfc344c7ab8cdc4043bc37e737baa2e..50eae03d08804182d5da09f0eefcf8fc30bed701 100644
--- a/src/PHYEX/micro/mode_lima_hail_deposition.f90
+++ b/src/PHYEX/micro/mode_lima_hail_deposition.f90
@@ -3,37 +3,13 @@
!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_HAIL_DEPOSITION
-! #################################
-!
-INTERFACE
- SUBROUTINE LIMA_HAIL_DEPOSITION (LDCOMPUTE, PRHODREF, &
- PRHT, PCHT, PSSI, PLBDH, PAI, PCJ, PLSFACT, &
- P_TH_DEPH, P_RH_DEPH )
-!
-LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE
-REAL, DIMENSION(:), INTENT(IN) :: PRHODREF !
-!
-REAL, DIMENSION(:), INTENT(IN) :: PRHT ! hail mr
-REAL, DIMENSION(:), INTENT(IN) :: PCHT ! hail conc
-REAL, DIMENSION(:), INTENT(IN) :: PSSI !
-REAL, DIMENSION(:), INTENT(IN) :: PLBDH !
-REAL, DIMENSION(:), INTENT(IN) :: PAI !
-REAL, DIMENSION(:), INTENT(IN) :: PCJ !
-REAL, DIMENSION(:), INTENT(IN) :: PLSFACT !
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_DEPH
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RH_DEPH
-!!
-END SUBROUTINE LIMA_HAIL_DEPOSITION
-END INTERFACE
-END MODULE MODI_LIMA_HAIL_DEPOSITION
-!
+MODULE MODE_LIMA_HAIL_DEPOSITION
+ IMPLICIT NONE
+CONTAINS
! ###########################################################################
- SUBROUTINE LIMA_HAIL_DEPOSITION (LDCOMPUTE, PRHODREF, &
- PRHT, PCHT, PSSI, PLBDH, PAI, PCJ, PLSFACT, &
- P_TH_DEPH, P_RH_DEPH )
+ SUBROUTINE LIMA_HAIL_DEPOSITION (LDCOMPUTE, PRHODREF, &
+ PRHT, PCHT, PSSI, PLBDH, PAI, PCJ, PLSFACT, &
+ P_TH_DEPH, P_RH_DEPH )
! ###########################################################################
!
!! PURPOSE
@@ -98,3 +74,4 @@ END WHERE
!-------------------------------------------------------------------------------
!
END SUBROUTINE LIMA_HAIL_DEPOSITION
+END MODULE MODE_LIMA_HAIL_DEPOSITION
diff --git a/src/PHYEX/micro/mode_lima_ice4_nucleation.f90 b/src/PHYEX/micro/mode_lima_ice4_nucleation.f90
new file mode 100644
index 0000000000000000000000000000000000000000..082b3c3e5f86ba5343e2bf2a243c58feb3a98253
--- /dev/null
+++ b/src/PHYEX/micro/mode_lima_ice4_nucleation.f90
@@ -0,0 +1,147 @@
+!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+MODULE MODE_LIMA_ICE4_NUCLEATION
+IMPLICIT NONE
+CONTAINS
+SUBROUTINE LIMA_ICE4_NUCLEATION(CST, KSIZE, &
+ PTHT, PPABST, PRHODREF, PEXN, PLSFACT, PT, &
+ PRVT, &
+ PCIT, PRVHENI_MR)
+!!
+!!** PURPOSE
+!! -------
+!! Computes the nucleation
+!!
+!! AUTHOR
+!! ------
+!! S. Riette from the splitting of rain_ice source code (nov. 2014)
+!!
+!! MODIFICATIONS
+!! -------------
+!!
+!! R. El Khatib 24-Aug-2021 Optimizations
+!
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CST, ONLY: CST_t
+USE PARKIND1, ONLY : JPRB
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK
+USE MODD_PARAM_LIMA_COLD, ONLY : XALPHA1, XBETA1, XALPHA2, XBETA2, XNU10, XNU20, XMNU0
+USE MODD_PARAM_LIMA, ONLY: LFEEDBACKT, XRTMIN
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+TYPE(CST_t), INTENT(IN) :: CST
+INTEGER, INTENT(IN) :: KSIZE
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PTHT ! Theta at t
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PPABST ! absolute pressure at t
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHODREF! Reference density
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PEXN ! Exner function
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PLSFACT
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PT ! Temperature at time t
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PRVT ! Water vapor m.r. at t
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PCIT ! Pristine ice n.c. at t
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRVHENI_MR ! Mixing ratio change due to the heterogeneous nucleation
+!
+!* 0.2 declaration of local variables
+!
+REAL, DIMENSION(KSIZE) :: ZW ! work array
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+LOGICAL, DIMENSION(KSIZE) :: GNEGT ! Test where to compute the HEN process
+REAL, DIMENSION(KSIZE) :: ZZW, & ! Work array
+ ZUSW, & ! Undersaturation over water
+ ZSSI ! Supersaturation over ice
+INTEGER :: JI
+!-------------------------------------------------------------------------------
+!
+IF (LHOOK) CALL DR_HOOK('LIMA_ICE4_NUCLEATION', 0, ZHOOK_HANDLE)!
+!
+!$mnh_expand_where(JI=1:KSIZE)
+GNEGT(:)=PT(:)<CST%XTT .AND. PRVT(:)>XRTMIN(1)
+!$mnh_end_expand_where(JI=1:KSIZE)
+
+ZUSW(:)=0.
+ZZW(:)=0.
+!$mnh_expand_where(JI=1:KSIZE)
+WHERE(GNEGT(:))
+ ZZW(:)=ALOG(PT(:))
+ ZUSW(:)=EXP(CST%XALPW - CST%XBETAW/PT(:) - CST%XGAMW*ZZW(:)) ! es_w
+ ZZW(:)=EXP(CST%XALPI - CST%XBETAI/PT(:) - CST%XGAMI*ZZW(:)) ! es_i
+END WHERE
+!$mnh_end_expand_where(JI=1:KSIZE)
+
+ZSSI(:)=0.
+!$mnh_expand_where(JI=1:KSIZE)
+WHERE(GNEGT(:))
+ ZZW(:)=MIN(PPABST(:)/2., ZZW(:)) ! safety limitation
+ ZSSI(:)=PRVT(:)*(PPABST(:)-ZZW(:)) / (CST%XEPSILO*ZZW(:)) - 1.0
+ ! Supersaturation over ice
+ ZUSW(:)=MIN(PPABST(:)/2., ZUSW(:)) ! safety limitation
+ ZUSW(:)=(ZUSW(:)/ZZW(:))*((PPABST(:)-ZZW(:))/(PPABST(:)-ZUSW(:))) - 1.0
+ ! Supersaturation of saturated water vapor over ice
+ !
+ !* 3.1 compute the heterogeneous nucleation source RVHENI
+ !
+ !* 3.1.1 compute the cloud ice concentration
+ !
+ ZSSI(:)=MIN(ZSSI(:), ZUSW(:)) ! limitation of SSi according to SSw=0
+END WHERE
+!$mnh_end_expand_where(JI=1:KSIZE)
+
+ZZW(:)=0.
+DO JI=1,KSIZE
+ IF(GNEGT(JI)) THEN
+ IF(PT(JI)<CST%XTT-5.0 .AND. ZSSI(JI)>0.0) THEN
+ ZZW(JI)=XNU20*EXP(XALPHA2*ZSSI(JI)-XBETA2)
+ ELSEIF(PT(JI)<=CST%XTT-2.0 .AND. PT(JI)>=CST%XTT-5.0 .AND. ZSSI(JI)>0.0) THEN
+ ZZW(JI)=MAX(XNU20*EXP(-XBETA2 ), &
+ XNU10*EXP(-XBETA1*(PT(JI)-CST%XTT))*(ZSSI(JI)/ZUSW(JI))**XALPHA1)
+ ENDIF
+ ENDIF
+ENDDO
+!$mnh_expand_where(JI=1:KSIZE)
+WHERE(GNEGT(:))
+ ZZW(:)=ZZW(:)-PCIT(:)
+ ZZW(:)=MIN(ZZW(:), 50.E3) ! limitation provisoire a 50 l^-1
+END WHERE
+!$mnh_end_expand_where(JI=1:KSIZE)
+
+PRVHENI_MR(:)=0.
+!$mnh_expand_where(JI=1:KSIZE)
+WHERE(GNEGT(:))
+ !
+ !* 3.1.2 update the r_i and r_v mixing ratios
+ !
+ PRVHENI_MR(:)=MAX(ZZW(:), 0.0)*XMNU0/PRHODREF(:)
+ PRVHENI_MR(:)=MIN(PRVT(:), PRVHENI_MR(:))
+END WHERE
+!$mnh_end_expand_where(JI=1:KSIZE)
+!Limitation due to 0 crossing of temperature
+IF(LFEEDBACKT) THEN
+ ZW(:)=0.
+ !$mnh_expand_where(JI=1:KSIZE)
+ WHERE(GNEGT(:))
+ ZW(:)=MIN(PRVHENI_MR(:), &
+ MAX(0., (CST%XTT/PEXN(:)-PTHT(:))/PLSFACT(:))) / &
+ MAX(PRVHENI_MR(:), 1.E-20)
+ END WHERE
+ PRVHENI_MR(:)=PRVHENI_MR(:)*ZW(:)
+ ZZW(:)=ZZW(:)*ZW(:)
+ !$mnh_end_expand_where(JI=1:KSIZE)
+ENDIF
+!$mnh_expand_where(JI=1:KSIZE)
+WHERE(GNEGT(:))
+ PCIT(:)=MAX(ZZW(:)+PCIT(:), PCIT(:))
+END WHERE
+!$mnh_end_expand_where(JI=1:KSIZE)
+!
+IF (LHOOK) CALL DR_HOOK('LIMA_ICE4_NUCLEATION', 1, ZHOOK_HANDLE)
+END SUBROUTINE LIMA_ICE4_NUCLEATION
+END MODULE MODE_LIMA_ICE4_NUCLEATION
diff --git a/src/PHYEX/micro/mode_lima_ice_aggregation_snow.f90 b/src/PHYEX/micro/mode_lima_ice_aggregation_snow.f90
index 26b23005738fe4202944cb83e51d634d403aeede..03f4c10b228955877104f014612422e0374ce9d2 100644
--- a/src/PHYEX/micro/mode_lima_ice_aggregation_snow.f90
+++ b/src/PHYEX/micro/mode_lima_ice_aggregation_snow.f90
@@ -3,40 +3,14 @@
!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_ICE_AGGREGATION_SNOW
-! #################################
-!
-INTERFACE
- SUBROUTINE LIMA_ICE_AGGREGATION_SNOW (LDCOMPUTE, &
- PT, PRHODREF, &
- PRIT, PRST, PCIT, PCST, PLBDI, PLBDS, &
- P_RI_AGGS, P_CI_AGGS )
-!
-LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE
-!
-REAL, DIMENSION(:), INTENT(IN) :: PT
-REAL, DIMENSION(:), INTENT(IN) :: PRHODREF
-!
-REAL, DIMENSION(:), INTENT(IN) :: PRIT
-REAL, DIMENSION(:), INTENT(IN) :: PRST
-REAL, DIMENSION(:), INTENT(IN) :: PCIT
-REAL, DIMENSION(:), INTENT(IN) :: PCST
-REAL, DIMENSION(:), INTENT(IN) :: PLBDI
-REAL, DIMENSION(:), INTENT(IN) :: PLBDS
-!
-REAL, DIMENSION(:), INTENT(OUT) :: P_RI_AGGS
-REAL, DIMENSION(:), INTENT(OUT) :: P_CI_AGGS
-!
-END SUBROUTINE LIMA_ICE_AGGREGATION_SNOW
-END INTERFACE
-END MODULE MODI_LIMA_ICE_AGGREGATION_SNOW
-!
+MODULE MODE_LIMA_ICE_AGGREGATION_SNOW
+ IMPLICIT NONE
+CONTAINS
! #######################################################################
- SUBROUTINE LIMA_ICE_AGGREGATION_SNOW (LDCOMPUTE, &
- PT, PRHODREF, &
- PRIT, PRST, PCIT, PCST, PLBDI, PLBDS, &
- P_RI_AGGS, P_CI_AGGS )
+ SUBROUTINE LIMA_ICE_AGGREGATION_SNOW (LDCOMPUTE, &
+ PT, PRHODREF, &
+ PRIT, PRST, PCIT, PCST, PLBDI, PLBDS, &
+ P_RI_AGGS, P_CI_AGGS )
! #######################################################################
!
!! PURPOSE
@@ -134,3 +108,4 @@ END IF
!-------------------------------------------------------------------------------
!
END SUBROUTINE LIMA_ICE_AGGREGATION_SNOW
+END MODULE MODE_LIMA_ICE_AGGREGATION_SNOW
diff --git a/src/PHYEX/micro/mode_lima_ice_deposition.f90 b/src/PHYEX/micro/mode_lima_ice_deposition.f90
index b9ca8ed7558349a6f1da6296770fd7a5e0a4c3d2..ed7540ca238a6898c0c9c4a61ac52eaad60d2035 100644
--- a/src/PHYEX/micro/mode_lima_ice_deposition.f90
+++ b/src/PHYEX/micro/mode_lima_ice_deposition.f90
@@ -3,48 +3,15 @@
!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_ICE_DEPOSITION
-! #####################
-!
-INTERFACE
- SUBROUTINE LIMA_ICE_DEPOSITION (PTSTEP, LDCOMPUTE, &
- PRHODREF, PT, PSSI, PAI, PCJ, PLSFACT, &
- PRIT, PCIT, PLBDI, &
- P_TH_DEPI, P_RI_DEPI, &
- P_RI_CNVS, P_CI_CNVS )
-!
-REAL, INTENT(IN) :: PTSTEP
-LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE
-!
-REAL, DIMENSION(:), INTENT(IN) :: PRHODREF! Reference density
-REAL, DIMENSION(:), INTENT(IN) :: PT ! abs. pressure at time t
-REAL, DIMENSION(:), INTENT(IN) :: PSSI ! abs. pressure at time t
-REAL, DIMENSION(:), INTENT(IN) :: PAI ! abs. pressure at time t
-REAL, DIMENSION(:), INTENT(IN) :: PCJ ! abs. pressure at time t
-REAL, DIMENSION(:), INTENT(IN) :: PLSFACT ! abs. pressure at time t
-!
-REAL, DIMENSION(:), INTENT(IN) :: PRIT ! Cloud ice m.r. at t
-!
-REAL, DIMENSION(:), INTENT(IN) :: PCIT ! Ice crystal C. at t
-!
-REAL, DIMENSION(:), INTENT(IN) :: PLBDI ! Graupel m.r. at t
-!
-REAL, DIMENSION(:), INTENT(OUT) :: P_TH_DEPI
-REAL, DIMENSION(:), INTENT(OUT) :: P_RI_DEPI
-REAL, DIMENSION(:), INTENT(OUT) :: P_RI_CNVS
-REAL, DIMENSION(:), INTENT(OUT) :: P_CI_CNVS
-!
-END SUBROUTINE LIMA_ICE_DEPOSITION
-END INTERFACE
-END MODULE MODI_LIMA_ICE_DEPOSITION
-!
+MODULE MODE_LIMA_ICE_DEPOSITION
+ IMPLICIT NONE
+CONTAINS
! ##########################################################################
-SUBROUTINE LIMA_ICE_DEPOSITION (PTSTEP, LDCOMPUTE, &
- PRHODREF, PT, PSSI, PAI, PCJ, PLSFACT, &
- PRIT, PCIT, PLBDI, &
- P_TH_DEPI, P_RI_DEPI, &
- P_RI_CNVS, P_CI_CNVS )
+ SUBROUTINE LIMA_ICE_DEPOSITION (PTSTEP, LDCOMPUTE, &
+ PRHODREF, PT, PSSI, PAI, PCJ, PLSFACT, &
+ PRIT, PCIT, PLBDI, &
+ P_TH_DEPI, P_RI_DEPI, &
+ P_RI_CNVS, P_CI_CNVS )
! ##########################################################################
!
!! PURPOSE
@@ -74,7 +41,7 @@ SUBROUTINE LIMA_ICE_DEPOSITION (PTSTEP, LDCOMPUTE, &
! ------------
!
USE MODD_PARAM_LIMA, ONLY : XRTMIN, XCTMIN, XALPHAI, XALPHAS, XNUI, XNUS,&
- LSNOW, NMOM_I
+ NMOM_I, NMOM_S
USE MODD_PARAM_LIMA_COLD, ONLY : XCXS, XCCS, &
XLBDAS_MAX, XDSCNVI_LIM, XLBDASCNVI_MAX, &
XC0DEPSI, XC1DEPSI, XR0DEPSI, XR1DEPSI, &
@@ -177,9 +144,10 @@ ELSE
END WHERE
END IF
!
-IF (.NOT.LSNOW) THEN
+IF (NMOM_S.EQ.0) THEN
P_RI_CNVS(:) = 0.
P_CI_CNVS(:) = 0.
END IF
!
END SUBROUTINE LIMA_ICE_DEPOSITION
+END MODULE MODE_LIMA_ICE_DEPOSITION
diff --git a/src/PHYEX/micro/mode_lima_ice_melting.f90 b/src/PHYEX/micro/mode_lima_ice_melting.f90
index a95f45044056fda9664059a03b549d2395581639..e2e7b475ec9a9c622bab7d00b003b6f4997ce240 100644
--- a/src/PHYEX/micro/mode_lima_ice_melting.f90
+++ b/src/PHYEX/micro/mode_lima_ice_melting.f90
@@ -2,56 +2,16 @@
!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_ICE_MELTING
-! #################################
-!
-INTERFACE
- SUBROUTINE LIMA_ICE_MELTING (PTSTEP, LDCOMPUTE, &
- PEXNREF, PPABST, &
- PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
- PCIT, PINT, &
- P_TH_IMLT, P_RC_IMLT, P_CC_IMLT, &
- PB_TH, PB_RC, PB_CC, PB_RI, PB_CI, PB_IFNN)
-!
-REAL, INTENT(IN) :: PTSTEP
-LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE
-!
-REAL, DIMENSION(:), INTENT(IN) :: PEXNREF ! Reference Exner function
-REAL, DIMENSION(:), INTENT(IN) :: PPABST ! abs. pressure at time t
-!
-REAL, DIMENSION(:), INTENT(IN) :: PTHT ! Theta at time t
-REAL, DIMENSION(:), INTENT(IN) :: PRVT !
-REAL, DIMENSION(:), INTENT(IN) :: PRCT !
-REAL, DIMENSION(:), INTENT(IN) :: PRRT !
-REAL, DIMENSION(:), INTENT(IN) :: PRIT ! Cloud ice m.r. at t
-REAL, DIMENSION(:), INTENT(IN) :: PRST !
-REAL, DIMENSION(:), INTENT(IN) :: PRGT !
-!
-REAL, DIMENSION(:), INTENT(IN) :: PCIT ! Rain water C. at t
-REAL, DIMENSION(:,:), INTENT(IN) :: PINT ! Nucleated IFN C. at t
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_IMLT
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RC_IMLT
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CC_IMLT
-REAL, DIMENSION(:), INTENT(INOUT) :: PB_TH
-REAL, DIMENSION(:), INTENT(INOUT) :: PB_RC
-REAL, DIMENSION(:), INTENT(INOUT) :: PB_CC
-REAL, DIMENSION(:), INTENT(INOUT) :: PB_RI
-REAL, DIMENSION(:), INTENT(INOUT) :: PB_CI
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PB_IFNN
-!
-END SUBROUTINE LIMA_ICE_MELTING
-END INTERFACE
-END MODULE MODI_LIMA_ICE_MELTING
-!
+MODULE MODE_LIMA_ICE_MELTING
+ IMPLICIT NONE
+CONTAINS
! ########################################################################
- SUBROUTINE LIMA_ICE_MELTING (PTSTEP, LDCOMPUTE, &
- PEXNREF, PPABST, &
- PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
- PCIT, PINT, &
- P_TH_IMLT, P_RC_IMLT, P_CC_IMLT, &
- PB_TH, PB_RC, PB_CC, PB_RI, PB_CI, PB_IFNN)
+ SUBROUTINE LIMA_ICE_MELTING (PTSTEP, LDCOMPUTE, &
+ PEXNREF, PPABST, &
+ PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
+ PCIT, PINT, &
+ P_TH_IMLT, P_RC_IMLT, P_CC_IMLT, &
+ PB_TH, PB_RC, PB_CC, PB_RI, PB_CI, PB_IFNN)
! ########################################################################
!
!! PURPOSE
@@ -162,3 +122,4 @@ ENDDO
!-------------------------------------------------------------------------------
!
END SUBROUTINE LIMA_ICE_MELTING
+END MODULE MODE_LIMA_ICE_MELTING
diff --git a/src/PHYEX/micro/mode_lima_init_ccn_activation_spectrum.f90 b/src/PHYEX/micro/mode_lima_init_ccn_activation_spectrum.f90
index 4403f97025e2c04b8f823efd603eec3accbb28ef..c11b9222e8a25524ee32b40d0a16b49c0abd7077 100644
--- a/src/PHYEX/micro/mode_lima_init_ccn_activation_spectrum.f90
+++ b/src/PHYEX/micro/mode_lima_init_ccn_activation_spectrum.f90
@@ -3,27 +3,11 @@
!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_INIT_CCN_ACTIVATION_SPECTRUM
-INTERFACE
- SUBROUTINE LIMA_INIT_CCN_ACTIVATION_SPECTRUM (CTYPE_CCN,XD,XSIGMA,XLIMIT_FACTOR,XK,XMU,XBETA,XKAPPA)
- !
- CHARACTER(LEN=*), INTENT(IN) :: CTYPE_CCN ! Aerosol type
- REAL, INTENT(IN) :: XD ! Aerosol PSD modal diameter
- REAL, INTENT(IN) :: XSIGMA ! Aerosol PSD width
- REAL, INTENT(OUT) :: XLIMIT_FACTOR ! C/Naer
- REAL, INTENT(OUT) :: XK ! k
- REAL, INTENT(OUT) :: XMU ! mu
- REAL, INTENT(OUT) :: XBETA ! beta
- REAL, INTENT(OUT) :: XKAPPA ! kappa
-!
- END SUBROUTINE LIMA_INIT_CCN_ACTIVATION_SPECTRUM
-END INTERFACE
-END MODULE MODI_LIMA_INIT_CCN_ACTIVATION_SPECTRUM
-! ####################
-!
+MODULE MODE_LIMA_INIT_CCN_ACTIVATION_SPECTRUM
+ IMPLICIT NONE
+CONTAINS
! #############################################################
- SUBROUTINE LIMA_INIT_CCN_ACTIVATION_SPECTRUM (CTYPE_CCN,XD,XSIGMA,XLIMIT_FACTOR,XK,XMU,XBETA,XKAPPA)
+ SUBROUTINE LIMA_INIT_CCN_ACTIVATION_SPECTRUM (CTYPE_CCN,XD,XSIGMA,XLIMIT_FACTOR,XK,XMU,XBETA,XKAPPA)
! #############################################################
!!
@@ -456,3 +440,4 @@ END FUNCTION DSDD
!
!------------------------------------------------------------------------------
END SUBROUTINE LIMA_INIT_CCN_ACTIVATION_SPECTRUM
+END MODULE MODE_LIMA_INIT_CCN_ACTIVATION_SPECTRUM
diff --git a/src/PHYEX/micro/mode_lima_inst_procs.f90 b/src/PHYEX/micro/mode_lima_inst_procs.f90
index 6a5aa149ea7368975e06dead5a299fc9e96d8226..0deeb85fa8652fa12103407a5fc1b0ad2b8a7712 100644
--- a/src/PHYEX/micro/mode_lima_inst_procs.f90
+++ b/src/PHYEX/micro/mode_lima_inst_procs.f90
@@ -3,87 +3,22 @@
!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_INST_PROCS
-! ###############################
-!
-INTERFACE
- SUBROUTINE LIMA_INST_PROCS (PTSTEP, LDCOMPUTE, &
- PEXNREF, PPABST, &
- PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
- PCCT, PCRT, PCIT, &
- PINT, &
- P_CR_BRKU, & ! spontaneous break up of drops (BRKU) : Nr
- P_TH_HONR, P_RR_HONR, P_CR_HONR, & ! rain drops homogeneous freezing (HONR) : rr, Nr, rg=-rr, th
- P_TH_IMLT, P_RC_IMLT, P_CC_IMLT, & ! ice melting (IMLT) : rc, Nc, ri=-rc, Ni=-Nc, th, IFNF, IFNA
- PB_TH, PB_RV, PB_RC, PB_RR, PB_RI, PB_RG, &
- PB_CC, PB_CR, PB_CI, &
- PB_IFNN, &
- PCF1D, PIF1D, PPF1D )
-!
-REAL, INTENT(IN) :: PTSTEP ! Time step
-LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE
-!
-REAL, DIMENSION(:), INTENT(IN) :: PEXNREF ! Reference Exner function
-REAL, DIMENSION(:), INTENT(IN) :: PPABST ! abs. pressure at time t
-!
-REAL, DIMENSION(:), INTENT(IN) :: PTHT ! Theta at t
-REAL, DIMENSION(:), INTENT(IN) :: PRVT ! Water vapor m.r. at t
-REAL, DIMENSION(:), INTENT(IN) :: PRCT ! Cloud water m.r. at t
-REAL, DIMENSION(:), INTENT(IN) :: PRRT ! Rain water m.r. at t
-REAL, DIMENSION(:), INTENT(IN) :: PRIT ! 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(IN) :: PCCT ! Cloud water conc. at t
-REAL, DIMENSION(:), INTENT(IN) :: PCRT ! Rain water conc. at t
-REAL, DIMENSION(:), INTENT(IN) :: PCIT ! Prinstine ice conc. at t
-!
-REAL, DIMENSION(:,:), INTENT(IN) :: PINT ! IFN C. activated at t
-!
-REAL, DIMENSION(:) , INTENT(INOUT) :: P_CR_BRKU ! Concentration change (#/kg)
-REAL, DIMENSION(:) , INTENT(INOUT) :: P_TH_HONR !
-REAL, DIMENSION(:) , INTENT(INOUT) :: P_RR_HONR ! mr change (kg/kg)
-REAL, DIMENSION(:) , INTENT(INOUT) :: P_CR_HONR ! Concentration change (#/kg)
-REAL, DIMENSION(:) , INTENT(INOUT) :: P_TH_IMLT !
-REAL, DIMENSION(:) , INTENT(INOUT) :: P_RC_IMLT ! mr change (kg/kg)
-REAL, DIMENSION(:) , INTENT(INOUT) :: P_CC_IMLT ! Concentration change (#/kg)
-!
-REAL, DIMENSION(:) , INTENT(INOUT) :: PB_TH ! Cumulated theta change
-REAL, DIMENSION(:) , INTENT(INOUT) :: PB_RV ! Cumulated mr change (kg/kg)
-REAL, DIMENSION(:) , INTENT(INOUT) :: PB_RC ! Cumulated mr change (kg/kg)
-REAL, DIMENSION(:) , INTENT(INOUT) :: PB_RR ! Cumulated mr change (kg/kg)
-REAL, DIMENSION(:) , INTENT(INOUT) :: PB_RI ! Cumulated mr change (kg/kg)
-REAL, DIMENSION(:) , INTENT(INOUT) :: PB_RG ! Cumulated mr change (kg/kg)
-!
-REAL, DIMENSION(:) , INTENT(INOUT) :: PB_CC ! Cumulated concentration change (#/kg)
-REAL, DIMENSION(:) , INTENT(INOUT) :: PB_CR ! Cumulated concentration change (#/kg)
-REAL, DIMENSION(:) , INTENT(INOUT) :: PB_CI ! Cumulated concentration change (#/kg)
-!
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PB_IFNN ! Cumulated concentration change (#/kg)
-!
-REAL, DIMENSION(:) , INTENT(INOUT) :: PCF1D ! Liquid cloud fraction
-REAL, DIMENSION(:) , INTENT(INOUT) :: PIF1D ! Ice cloud fraction
-REAL, DIMENSION(:) , INTENT(INOUT) :: PPF1D ! Precipitation fraction
-!
- END SUBROUTINE LIMA_INST_PROCS
-END INTERFACE
-END MODULE MODI_LIMA_INST_PROCS
-!
-!
+MODULE MODE_LIMA_INST_PROCS
+ IMPLICIT NONE
+CONTAINS
! ###########################################################################
-SUBROUTINE LIMA_INST_PROCS (PTSTEP, LDCOMPUTE, &
- PEXNREF, PPABST, &
- PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
- PCCT, PCRT, PCIT, &
- PINT, &
- P_CR_BRKU, & ! spontaneous break up of drops (BRKU) : Nr
- P_TH_HONR, P_RR_HONR, P_CR_HONR, & ! rain drops homogeneous freezing (HONR) : rr, Nr, rg=-rr, th
- P_TH_IMLT, P_RC_IMLT, P_CC_IMLT, & ! ice melting (IMLT) : rc, Nc, ri=-rc, Ni=-Nc, th, IFNF, IFNA
- PB_TH, PB_RV, PB_RC, PB_RR, PB_RI, PB_RG, &
- PB_CC, PB_CR, PB_CI, &
- PB_IFNN, &
- PCF1D, PIF1D, PPF1D )
+ SUBROUTINE LIMA_INST_PROCS (PTSTEP, LDCOMPUTE, &
+ PEXNREF, PPABST, &
+ PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
+ PCCT, PCRT, PCIT, &
+ PINT, &
+ P_CR_BRKU, & ! spontaneous break up of drops (BRKU) : Nr
+ P_TH_HONR, P_RR_HONR, P_CR_HONR, & ! rain drops homogeneous freezing (HONR) : rr, Nr, rg=-rr, th
+ P_TH_IMLT, P_RC_IMLT, P_CC_IMLT, & ! ice melting (IMLT) : rc, Nc, ri=-rc, Ni=-Nc, th, IFNF, IFNA
+ PB_TH, PB_RV, PB_RC, PB_RR, PB_RI, PB_RG, &
+ PB_CC, PB_CR, PB_CI, &
+ PB_IFNN, &
+ PCF1D, PIF1D, PPF1D )
! ###########################################################################
!
!! PURPOSE
@@ -102,11 +37,11 @@ SUBROUTINE LIMA_INST_PROCS (PTSTEP, LDCOMPUTE,
!-------------------------------------------------------------------------------
!
!
-USE MODD_PARAM_LIMA, ONLY : LCOLD, LWARM, LRAIN, NMOM_R
+USE MODD_PARAM_LIMA, ONLY : NMOM_C, NMOM_R, NMOM_I, NMOM_G
!
-USE MODI_LIMA_DROPS_BREAK_UP
-USE MODI_LIMA_DROPS_HOM_FREEZING
-USE MODI_LIMA_ICE_MELTING
+USE MODE_LIMA_DROPS_BREAK_UP, ONLY: LIMA_DROPS_BREAK_UP
+USE MODE_LIMA_DROPS_HOM_FREEZING, ONLY: LIMA_DROPS_HOM_FREEZING
+USE MODE_LIMA_ICE_MELTING, ONLY: LIMA_ICE_MELTING
IMPLICIT NONE
@@ -159,7 +94,7 @@ REAL, DIMENSION(:) , INTENT(INOUT) :: PPF1D ! Precipitation fraction
!
!-------------------------------------------------------------------------------
!
-IF (LWARM .AND. LRAIN .AND. NMOM_R.GE.2) THEN
+IF (NMOM_R.GE.2) THEN
CALL LIMA_DROPS_BREAK_UP (LDCOMPUTE, & ! no dependance on CF, IF or PF
PCRT, PRRT, &
P_CR_BRKU, &
@@ -168,7 +103,7 @@ END IF
!
!-------------------------------------------------------------------------------
!
-IF (LCOLD .AND. LWARM .AND. LRAIN) THEN
+IF (NMOM_G.GE.1 .AND. NMOM_R.GE.1) THEN
CALL LIMA_DROPS_HOM_FREEZING (PTSTEP, LDCOMPUTE, & ! no dependance on CF, IF or PF
PEXNREF, PPABST, &
PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
@@ -179,7 +114,7 @@ END IF
!
!-------------------------------------------------------------------------------
!
-IF (LCOLD .AND. LWARM) THEN
+IF (NMOM_C.GE.1 .AND. NMOM_I.GE.1) THEN
CALL LIMA_ICE_MELTING (PTSTEP, LDCOMPUTE, & ! no dependance on CF, IF or PF
PEXNREF, PPABST, & ! but ice fraction becomes cloud fraction
PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, & ! -> where ?
@@ -195,3 +130,4 @@ END IF
!-------------------------------------------------------------------------------
!
END SUBROUTINE LIMA_INST_PROCS
+END MODULE MODE_LIMA_INST_PROCS
diff --git a/src/PHYEX/micro/mode_lima_meyers_nucleation.f90 b/src/PHYEX/micro/mode_lima_meyers_nucleation.f90
index f0c38fd6ad95ec88b8b3517646347640ce7f9091..989c3562cbcac6400404794c726c1c6f7237fe2d 100644
--- a/src/PHYEX/micro/mode_lima_meyers_nucleation.f90
+++ b/src/PHYEX/micro/mode_lima_meyers_nucleation.f90
@@ -3,58 +3,17 @@
!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_MEYERS_NUCLEATION
-! ##################################
-!
-INTERFACE
- SUBROUTINE LIMA_MEYERS_NUCLEATION (PTSTEP, &
- PRHODREF, PEXNREF, PPABST, &
- PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
- PCCT, PCIT, PINT, &
- P_TH_HIND, P_RI_HIND, P_CI_HIND, &
- P_TH_HINC, P_RC_HINC, P_CC_HINC, &
- PICEFR )
-!
-REAL, INTENT(IN) :: PTSTEP
-!
-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(INOUT) :: PTHT ! Theta at time 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 ! Cloud ice m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRGT ! Graupel m.r. at t
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCCT ! Cloud water C. at t
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCIT ! Ice crystal C. source
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PINT ! Activated ice nuclei C.
-!
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: P_TH_HIND
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: P_RI_HIND
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: P_CI_HIND
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: P_TH_HINC
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: P_RC_HINC
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: P_CC_HINC
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PICEFR
-!
-END SUBROUTINE LIMA_MEYERS_NUCLEATION
-END INTERFACE
-END MODULE MODI_LIMA_MEYERS_NUCLEATION
-!
+MODULE MODE_LIMA_MEYERS_NUCLEATION
+ IMPLICIT NONE
+CONTAINS
! #############################################################################
- SUBROUTINE LIMA_MEYERS_NUCLEATION (PTSTEP, &
- PRHODREF, PEXNREF, PPABST, &
- PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
- PCCT, PCIT, PINT, &
- P_TH_HIND, P_RI_HIND, P_CI_HIND, &
- P_TH_HINC, P_RC_HINC, P_CC_HINC, &
- PICEFR )
+ SUBROUTINE LIMA_MEYERS_NUCLEATION (CST, PTSTEP, &
+ PRHODREF, PEXNREF, PPABST, &
+ PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
+ PCCT, PCIT, PINT, &
+ P_TH_HIND, P_RI_HIND, P_CI_HIND, &
+ P_TH_HINC, P_RC_HINC, P_CC_HINC, &
+ PICEFR )
! #############################################################################
!!
!! PURPOSE
@@ -80,8 +39,7 @@ END MODULE MODI_LIMA_MEYERS_NUCLEATION
!* 0. DECLARATIONS
! ------------
!
-USE MODD_CST
-USE MODD_NSV, ONLY: NSV_LIMA_NC, NSV_LIMA_NI
+USE MODD_CST, ONLY: CST_t
USE MODD_PARAMETERS
USE MODD_PARAM_LIMA
USE MODD_PARAM_LIMA_COLD
@@ -92,6 +50,7 @@ IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
!
+TYPE(CST_t), INTENT(IN) :: CST
REAL, INTENT(IN) :: PTSTEP
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF! Reference density
@@ -188,12 +147,12 @@ IKE=SIZE(PTHT,3) - JPVEXT
!
! Temperature
!
-ZT(:,:,:) = PTHT(:,:,:) * ( PPABST(:,:,:)/XP00 ) ** (XRD/XCPD)
+ZT(:,:,:) = PTHT(:,:,:) * ( PPABST(:,:,:)/CST%XP00 ) ** (CST%XRD/CST%XCPD)
!
! Saturation over ice
!
-ZW(:,:,:) = EXP( XALPI - XBETAI/ZT(:,:,:) - XGAMI*ALOG(ZT(:,:,:) ) )
-ZW(:,:,:) = PRVT(:,:,:)*( PPABST(:,:,:)-ZW(:,:,:) ) / ( (XMV/XMD) * ZW(:,:,:) )
+ZW(:,:,:) = EXP( CST%XALPI - CST%XBETAI/ZT(:,:,:) - CST%XGAMI*ALOG(ZT(:,:,:) ) )
+ZW(:,:,:) = PRVT(:,:,:)*( PPABST(:,:,:)-ZW(:,:,:) ) / ( (CST%XMV/CST%XMD) * ZW(:,:,:) )
!
!
!-------------------------------------------------------------------------------
@@ -202,7 +161,7 @@ ZW(:,:,:) = PRVT(:,:,:)*( PPABST(:,:,:)-ZW(:,:,:) ) / ( (XMV/XMD) * ZW(:,:,:) )
! the temperature is negative only !!!
!
GNEGT(:,:,:) = .FALSE.
-GNEGT(IIB:IIE,IJB:IJE,IKB:IKE) = ZT(IIB:IIE,IJB:IJE,IKB:IKE)<XTT .AND. &
+GNEGT(IIB:IIE,IJB:IJE,IKB:IKE) = ZT(IIB:IIE,IJB:IJE,IKB:IKE)<CST%XTT .AND. &
ZW(IIB:IIE,IJB:IJE,IKB:IKE)>0.8
INEGT = COUNTJV( GNEGT(:,:,:),I1(:),I2(:),I3(:))
IF( INEGT >= 1 ) THEN
@@ -251,14 +210,14 @@ IF( INEGT >= 1 ) THEN
ALLOCATE(ZSSI(INEGT))
ALLOCATE(ZTCELSIUS(INEGT))
!
- ZZW(:) = ZEXNREF(:)*( XCPD+XCPV*ZRVT(:)+XCL*(ZRCT(:)+ZRRT(:)) &
- +XCI*(ZRIT(:)+ZRST(:)+ZRGT(:)) )
- ZTCELSIUS(:) = MAX( ZZT(:)-XTT,-50.0 )
- ZLSFACT(:) = (XLSTT+(XCPV-XCI)*ZTCELSIUS(:))/ZZW(:) ! L_s/(Pi_ref*C_ph)
- ZLVFACT(:) = (XLVTT+(XCPV-XCL)*ZTCELSIUS(:))/ZZW(:) ! L_v/(Pi_ref*C_ph)
+ ZZW(:) = ZEXNREF(:)*( CST%XCPD+CST%XCPV*ZRVT(:)+CST%XCL*(ZRCT(:)+ZRRT(:)) &
+ +CST%XCI*(ZRIT(:)+ZRST(:)+ZRGT(:)) )
+ ZTCELSIUS(:) = MAX( ZZT(:)-CST%XTT,-50.0 )
+ ZLSFACT(:) = (CST%XLSTT+(CST%XCPV-CST%XCI)*ZTCELSIUS(:))/ZZW(:) ! L_s/(Pi_ref*C_ph)
+ ZLVFACT(:) = (CST%XLVTT+(CST%XCPV-CST%XCL)*ZTCELSIUS(:))/ZZW(:) ! L_v/(Pi_ref*C_ph)
!
- ZZW(:) = EXP( XALPI - XBETAI/ZZT(:) - XGAMI*ALOG(ZZT(:)) ) ! es_i
- ZSSI(:) = ZRVT(:)*(ZPRES(:)-ZZW(:))/((XMV/XMD)*ZZW(:)) - 1.0
+ ZZW(:) = EXP( CST%XALPI - CST%XBETAI/ZZT(:) - CST%XGAMI*ALOG(ZZT(:)) ) ! es_i
+ ZSSI(:) = ZRVT(:)*(ZPRES(:)-ZZW(:))/((CST%XMV/CST%XMD)*ZZW(:)) - 1.0
! Supersaturation over ice
!
!---------------------------------------------------------------------------
@@ -272,7 +231,7 @@ IF( INEGT >= 1 ) THEN
ZZX(:) = 0.0
ZZY(:) = 0.0
!
- WHERE( ZZT(:)<XTT-5.0 .AND. ZSSI(:)>0.0 )
+ WHERE( ZZT(:)<CST%XTT-5.0 .AND. ZSSI(:)>0.0 )
ZZY(:) = XNUC_DEP*EXP( XEXSI_DEP*100.*MIN(1.,ZSSI(:))+XEX_DEP)/ZRHODREF(:)
ZZX(:) = MAX( ZZY(:)-ZINT(:,1) , 0.0 ) ! number of ice crystals formed at this time step #/kg
ZZW(:) = MIN( XMNU0*ZZX(:) , ZRVT(:) ) ! mass of ice formed at this time step (kg/kg)
@@ -299,7 +258,7 @@ IF( INEGT >= 1 ) THEN
ZZX(:) = 0.0
ZZY(:) = 0.0
!
- WHERE( ZZT(:)<XTT-2.0 .AND. ZCCT(:)>XCTMIN(2) .AND. ZRCT(:)>XRTMIN(2) )
+ WHERE( ZZT(:)<CST%XTT-2.0 .AND. ZCCT(:)>XCTMIN(2) .AND. ZRCT(:)>XRTMIN(2) )
ZZY(:) = MIN( XNUC_CON * EXP( XEXTT_CON*ZTCELSIUS(:)+XEX_CON ) &
/ZRHODREF(:) , ZCCT(:) )
ZZX(:) = MAX( ZZY(:)-ZINT(:,1),0.0 )
@@ -346,3 +305,4 @@ END IF
!-------------------------------------------------------------------------------
!
END SUBROUTINE LIMA_MEYERS_NUCLEATION
+END MODULE MODE_LIMA_MEYERS_NUCLEATION
diff --git a/src/PHYEX/micro/mode_lima_nucleation_procs.f90 b/src/PHYEX/micro/mode_lima_nucleation_procs.f90
index 07213550da89d9bb98882dbae62392b49d708ded..25da0089e5af66db5eac9d953eb9b35d100082f4 100644
--- a/src/PHYEX/micro/mode_lima_nucleation_procs.f90
+++ b/src/PHYEX/micro/mode_lima_nucleation_procs.f90
@@ -3,64 +3,17 @@
!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
-! ###############################
-!
-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
-!
-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
+MODULE MODE_LIMA_NUCLEATION_PROCS
+ IMPLICIT NONE
+CONTAINS
! #############################################################################
-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 )
+ 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 )
! #############################################################################
!
!! PURPOSE
@@ -82,25 +35,25 @@ SUBROUTINE LIMA_NUCLEATION_PROCS (PTSTEP, TPFILE, PRHODJ,
! 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_DIMPHYEX, ONLY: DIMPHYEX_t
+USE MODD_BUDGET, ONLY: TBUDGETDATA, TBUDGETCONF_t
+USE MODD_CST, ONLY: CST_t
+use modd_budget, only: NBUDGET_TH, NBUDGET_RV, NBUDGET_RC, NBUDGET_RI, NBUDGET_SV1
+!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, &
+USE MODD_PARAM_LIMA, ONLY : LNUCL, LMEYERS, LACTI, LHHONI, &
NMOD_CCN, NMOD_IFN, NMOD_IMM, XCTMIN, XRTMIN, LSPRO, NMOM_I, NMOM_C
USE MODD_TURB_n, ONLY : LSUBG_COND
-use mode_budget, only: Budget_store_add, Budget_store_init, Budget_store_end
+USE MODE_BUDGET_PHY, ONLY: BUDGET_STORE_ADD_PHY, BUDGET_STORE_INIT_PHY, BUDGET_STORE_END_PHY
-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
+USE MODE_LIMA_CCN_ACTIVATION, ONLY: LIMA_CCN_ACTIVATION
+USE MODE_LIMA_CCN_HOM_FREEZING, ONLY: LIMA_CCN_HOM_FREEZING
+USE MODE_LIMA_MEYERS_NUCLEATION, ONLY: LIMA_MEYERS_NUCLEATION
+USE MODE_LIMA_PHILLIPS_IFN_NUCLEATION, ONLY: LIMA_PHILLIPS_IFN_NUCLEATION
+USE MODE_LIMA_ICE4_NUCLEATION, ONLY: LIMA_ICE4_NUCLEATION
!
!-------------------------------------------------------------------------------
!
@@ -108,8 +61,14 @@ IMPLICIT NONE
!
!-------------------------------------------------------------------------------
!
-REAL, INTENT(IN) :: PTSTEP ! Double Time step
-TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+TYPE(CST_t), INTENT(IN) :: CST
+TYPE(TBUDGETCONF_t), INTENT(IN) :: BUCONF
+TYPE(TBUDGETDATA), DIMENSION(KBUDGETS), INTENT(INOUT) :: TBUDGETS
+INTEGER, INTENT(IN) :: KBUDGETS
+!
+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
@@ -126,6 +85,7 @@ 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(IN) :: PRHT ! Hail m.r. at t
!
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCCT ! Cloud water conc. at t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PCRT ! Rain water conc. at t
@@ -145,46 +105,52 @@ 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
+REAL, DIMENSION(SIZE(PT,1),SIZE(PT,2),SIZE(PT,3)) :: ZCIT, ZLSFACT, ZRVHENIMR
!
-integer :: idx
-INTEGER :: JL
+integer :: idx, jl
+INTEGER :: JI,JJ
!
!-------------------------------------------------------------------------------
!
-IF ( LWARM .AND. LACTI .AND. NMOD_CCN >=1 .AND. NMOM_C.GE.2) THEN
+IF ( 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 )
+ if ( BUCONF%lbu_enable ) then
+ if ( BUCONF%lbudget_th ) &
+ call BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_TH), 'HENU', ptht(:, :, :) * prhodj(:, :, :) / ptstep )
+ if ( BUCONF%lbudget_rv ) &
+ call BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RV), 'HENU', prvt(:, :, :) * prhodj(:, :, :) / ptstep )
+ if ( BUCONF%lbudget_rc ) &
+ call BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RC), 'HENU', prct(:, :, :) * prhodj(:, :, :) / ptstep )
+ if ( BUCONF%lbudget_sv ) then
+ call BUDGET_STORE_INIT_PHY(D, 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 )
+ call BUDGET_STORE_INIT_PHY(D, 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 )
+ call BUDGET_STORE_INIT_PHY(D, TBUDGETS(idx), 'HENU', pnat(:, :, :, jl) * prhodj(:, :, :) / ptstep )
end do
end if
end if
- CALL LIMA_CCN_ACTIVATION( TPFILE, &
+ CALL LIMA_CCN_ACTIVATION( CST, &
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 )
+ if ( BUCONF%lbu_enable ) then
+ if ( BUCONF%lbudget_th ) &
+ call BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_TH), 'HENU', ptht(:, :, :) * prhodj(:, :, :) / ptstep )
+ if ( BUCONF%lbudget_rv ) &
+ call BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_RV), 'HENU', prvt(:, :, :) * prhodj(:, :, :) / ptstep )
+ if ( BUCONF%lbudget_rc ) &
+ call BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_RC), 'HENU', prct(:, :, :) * prhodj(:, :, :) / ptstep )
+ if ( BUCONF%lbudget_sv ) then
+ call BUDGET_STORE_END_PHY(D, 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 )
+ call BUDGET_STORE_END_PHY(D, 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 )
+ call BUDGET_STORE_END_PHY(D, TBUDGETS(idx), 'HENU', pnat(:, :, :, jl) * prhodj(:, :, :) / ptstep )
end do
end if
end if
@@ -197,28 +163,28 @@ 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
+IF ( LNUCL .AND. NMOM_I>=2 .AND. .NOT.LMEYERS .AND. NMOD_IFN >= 1 ) THEN
+ if ( BUCONF%lbu_enable ) then
+ if ( BUCONF%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 )
+ call BUDGET_STORE_INIT_PHY(D, 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 )
+ call BUDGET_STORE_INIT_PHY(D, 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 )
+ call BUDGET_STORE_INIT_PHY(D, 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 )
+ call BUDGET_STORE_INIT_PHY(D, TBUDGETS(idx), 'HINC', pnit(:, :, :, jl) * prhodj(:, :, :) / ptstep )
end do
end if
end if
- CALL LIMA_PHILLIPS_IFN_NUCLEATION (PTSTEP, &
+ CALL LIMA_PHILLIPS_IFN_NUCLEATION (CST, PTSTEP, &
PRHODREF, PEXNREF, PPABST, &
PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
PCCT, PCIT, PNAT, PIFT, PINT, PNIT, &
@@ -227,35 +193,41 @@ IF ( LCOLD .AND. LNUCL .AND. NMOM_I>=2 .AND. .NOT.LMEYERS .AND. NMOD_IFN >= 1 )
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 ( BUCONF%lbu_enable ) then
+ if ( BUCONF%lbudget_th ) &
+ 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 )
+ if ( BUCONF%lbudget_ri ) &
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RI), 'HIND', z_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
idx = NBUDGET_SV1 - 1 + nsv_lima_ifn_free - 1 + jl
- call Budget_store_end( tbudgets(idx), 'HIND', pift(:, :, :, jl) * prhodj(:, :, :) / ptstep )
+ call BUDGET_STORE_END_PHY(D, 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 )
+ call BUDGET_STORE_END_PHY(D, 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 ( BUCONF%lbudget_th ) &
+ 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 )
+ if ( BUCONF%lbudget_ri ) &
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RI), 'HINC', -z_rc_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
+ if ( BUCONF%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 )
+ call BUDGET_STORE_ADD_PHY(D, 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 )
+ call BUDGET_STORE_ADD_PHY(D, 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 )
+ call BUDGET_STORE_END_PHY(D, 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 )
+ call BUDGET_STORE_END_PHY(D, TBUDGETS(idx), 'HINC', pnit(:, :, :, jl) * prhodj(:, :, :) / ptstep )
end do
end if
end if
@@ -263,8 +235,8 @@ END IF
!
!-------------------------------------------------------------------------------
!
-IF (LCOLD .AND. LNUCL .AND. NMOM_I>=2 .AND. LMEYERS) THEN
- CALL LIMA_MEYERS_NUCLEATION (PTSTEP, &
+IF (LNUCL .AND. NMOM_I>=2 .AND. LMEYERS) THEN
+ CALL LIMA_MEYERS_NUCLEATION (CST, PTSTEP, &
PRHODREF, PEXNREF, PPABST, &
PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
PCCT, PCIT, PINT, &
@@ -273,27 +245,33 @@ IF (LCOLD .AND. LNUCL .AND. NMOM_I>=2 .AND. LMEYERS) THEN
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 ( BUCONF%lbu_enable ) then
+ if ( BUCONF%lbudget_th ) &
+ 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 )
+ if ( BUCONF%lbudget_ri ) &
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RI), 'HIND', z_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 ) &
- call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ifn_nucl), 'HIND', &
+ call BUDGET_STORE_ADD_PHY(D, 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 ( BUCONF%lbudget_th ) &
+ 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 )
+ if ( BUCONF%lbudget_ri ) &
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RI), 'HINC', -z_rc_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
+ if ( BUCONF%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 )
+ call BUDGET_STORE_ADD_PHY(D, 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 )
+ call BUDGET_STORE_ADD_PHY(D, 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', &
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1-1+nsv_lima_ifn_nucl), 'HINC', &
-z_cc_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
end if
end if
@@ -301,49 +279,52 @@ END IF
!
!-------------------------------------------------------------------------------
!
-IF (LCOLD .AND. LNUCL .AND. NMOM_I.EQ.1) THEN
+IF (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)
+ ZLSFACT(:,:,:)=(CST%XLSTT+(CST%XCPV-CST%XCI)*(PT(:,:,:)-CST%XTT)) / &
+ ( ( CST%XCPD + &
+ CST%XCPV*PRVT(:,:,:) + &
+ CST%XCL*(PRCT(:,:,:)+PRRT(:,:,:)) + &
+ CST%XCI*(PRIT(:,:,:)+PRST(:,:,:)+PRGT(:,:,:)+PRHT(:,:,:)) ) * PEXNREF(:,:,:) )
+ DO JI = 1, SIZE(PTHT,1)
+ DO JJ = 1, SIZE(PTHT,2)
+ CALL LIMA_ICE4_NUCLEATION(CST, SIZE(PTHT,3), &
+ PTHT(JI,JJ,:), PPABST(JI,JJ,:), PRHODREF(JI,JJ,:), PEXNREF(JI,JJ,:), ZLSFACT(JI,JJ,:), PT(JI,JJ,:), &
+ PRVT(JI,JJ,:), &
+ ZCIT(JI,JJ,:), ZRVHENIMR(JI,JJ,:) )
+ END DO
+ END DO
!
! 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
+ PRIT(:,:,:)=PRIT(:,:,:)+ZRVHENIMR(:,:,:)
+ PTHT(:,:,:)=PTHT(:,:,:)+ZRVHENIMR(:,:,:)*ZLSFACT(:,:,:)
+ PRVT(:,:,:)=PRVT(:,:,:)-ZRVHENIMR(:,:,:)
! 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 ( BUCONF%lbu_enable ) then
+! if ( BUCONF%lbudget_th ) 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 )
+! if ( BUCONF%lbudget_ri ) call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RI), 'HIND', z_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 ) &
-! call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ifn_nucl), 'HIND', &
+! call BUDGET_STORE_ADD_PHY(D, 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 ( BUCONF%lbudget_th ) 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 )
+! if ( BUCONF%lbudget_ri ) call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RI), 'HINC', -z_rc_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
+! if ( BUCONF%lbudget_sv ) then
+! call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + nsv_lima_nc), 'HINC', z_cc_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
+! call BUDGET_STORE_ADD_PHY(D, 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', &
+! call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + nsv_lima_ifn_nucl), 'HINC', &
! -z_cc_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
! end if
! end if
@@ -351,38 +332,44 @@ 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 )
+IF ( LNUCL .AND. LHHONI .AND. NMOD_CCN >= 1 .AND. NMOM_I.GE.2) THEN
+ if ( BUCONF%lbu_enable ) then
+ if ( BUCONF%lbudget_th ) &
+ call BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_TH), 'HONH', PTHT(:, :, :) * prhodj(:, :, :) / ptstep )
+ if ( BUCONF%lbudget_rv ) &
+ call BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RV), 'HONH', PRVT(:, :, :) * prhodj(:, :, :) / ptstep )
+ if ( BUCONF%lbudget_ri ) &
+ call BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RI), 'HONH', PRIT(:, :, :) * prhodj(:, :, :) / ptstep )
+ if ( BUCONF%lbudget_sv ) then
+ call BUDGET_STORE_INIT_PHY(D,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 )
+ call BUDGET_STORE_INIT_PHY(D, 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 )
+ call BUDGET_STORE_INIT_PHY(D,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 )
+ CALL LIMA_CCN_HOM_FREEZING (CST, 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 )
+ if ( BUCONF%lbu_enable ) then
+ if ( BUCONF%lbudget_th ) &
+ call BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_TH), 'HONH', PTHT(:, :, :) * prhodj(:, :, :) / ptstep )
+ if ( BUCONF%lbudget_rv ) &
+ call BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_RV), 'HONH', PRVT(:, :, :) * prhodj(:, :, :) / ptstep )
+ if ( BUCONF%lbudget_ri ) &
+ call BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_RI), 'HONH', PRIT(:, :, :) * prhodj(:, :, :) / ptstep )
+ if ( BUCONF%lbudget_sv ) then
+ call BUDGET_STORE_END_PHY(D,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 )
+ call BUDGET_STORE_END_PHY(D, 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 )
+ call BUDGET_STORE_END_PHY(D,TBUDGETS(NBUDGET_SV1-1+nsv_lima_hom_haze),'HONH',PNHT(:, :, :)*prhodj(:, :, :)/ptstep)
end if
end if
ENDIF
@@ -390,3 +377,4 @@ ENDIF
!-------------------------------------------------------------------------------
!
END SUBROUTINE LIMA_NUCLEATION_PROCS
+END MODULE MODE_LIMA_NUCLEATION_PROCS
diff --git a/src/PHYEX/micro/mode_lima_phillips_ifn_nucleation.f90 b/src/PHYEX/micro/mode_lima_phillips_ifn_nucleation.f90
index 1010555ff86b477d3fd0dcebb638a0b9b0b32959..37d4b321f11f73814c63fb5fd163bd87b9ecf614 100644
--- a/src/PHYEX/micro/mode_lima_phillips_ifn_nucleation.f90
+++ b/src/PHYEX/micro/mode_lima_phillips_ifn_nucleation.f90
@@ -3,61 +3,17 @@
!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_PHILLIPS_IFN_NUCLEATION
-! ########################################
-!
-INTERFACE
- SUBROUTINE LIMA_PHILLIPS_IFN_NUCLEATION (PTSTEP, &
- PRHODREF, PEXNREF, PPABST, &
- PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
- PCCT, PCIT, PNAT, PIFT, PINT, PNIT, &
- P_TH_HIND, P_RI_HIND, P_CI_HIND, &
- P_TH_HINC, P_RC_HINC, P_CC_HINC, &
- PICEFR )
-!
-REAL, INTENT(IN) :: PTSTEP
-!
-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(INOUT) :: PTHT ! Theta at time 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 ! Cloud ice m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRST ! Snow/aggregate 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(INOUT) :: PCIT ! Cloud water conc. at t
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PNAT ! CCN conc. used for immersion nucl.
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PIFT ! Free IFN conc.
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PINT ! Nucleated IFN conc.
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PNIT ! Nucleated (by immersion) CCN conc.
-!
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: P_TH_HIND
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: P_RI_HIND
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: P_CI_HIND
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: P_TH_HINC
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: P_RC_HINC
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: P_CC_HINC
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PICEFR
-!
-END SUBROUTINE LIMA_PHILLIPS_IFN_NUCLEATION
-END INTERFACE
-END MODULE MODI_LIMA_PHILLIPS_IFN_NUCLEATION
-!
+MODULE MODE_LIMA_PHILLIPS_IFN_NUCLEATION
+ IMPLICIT NONE
+CONTAINS
! #################################################################################
- SUBROUTINE LIMA_PHILLIPS_IFN_NUCLEATION (PTSTEP, &
- PRHODREF, PEXNREF, PPABST, &
- PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
- PCCT, PCIT, PNAT, PIFT, PINT, PNIT, &
- P_TH_HIND, P_RI_HIND, P_CI_HIND, &
- P_TH_HINC, P_RC_HINC, P_CC_HINC, &
- PICEFR )
+ SUBROUTINE LIMA_PHILLIPS_IFN_NUCLEATION (CST, PTSTEP, &
+ PRHODREF, PEXNREF, PPABST, &
+ PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
+ PCCT, PCIT, PNAT, PIFT, PINT, PNIT, &
+ P_TH_HIND, P_RI_HIND, P_CI_HIND, &
+ P_TH_HINC, P_RC_HINC, P_CC_HINC, &
+ PICEFR )
! #################################################################################
!!
!! PURPOSE
@@ -115,10 +71,7 @@ END MODULE MODI_LIMA_PHILLIPS_IFN_NUCLEATION
!* 0. DECLARATIONS
! ------------
!
-USE MODD_CST, ONLY : XP00, XRD, XMV, XMD, XCPD, XCPV, XCL, XCI, &
- XTT, XLSTT, XLVTT, XALPI, XBETAI, XGAMI, &
- XALPW, XBETAW, XGAMW, XPI
-USE MODD_NSV, ONLY : NSV_LIMA_NC, NSV_LIMA_NI, NSV_LIMA_IFN_FREE
+USE MODD_CST, ONLY: CST_t
USE MODD_PARAMETERS, ONLY : JPHEXT, JPVEXT
USE MODD_PARAM_LIMA, ONLY : NMOD_IFN, NSPECIE, XFRAC, &
NMOD_CCN, NMOD_IMM, NIND_SPECIE, NINDICE_CCN_IMM, &
@@ -127,13 +80,14 @@ USE MODD_PARAM_LIMA_COLD, ONLY : XMNU0
use mode_tools, only: Countjv
-USE MODI_LIMA_PHILLIPS_INTEG
-USE MODI_LIMA_PHILLIPS_REF_SPECTRUM
+USE MODE_LIMA_PHILLIPS_INTEG, ONLY : LIMA_PHILLIPS_INTEG
+USE MODE_LIMA_PHILLIPS_REF_SPECTRUM, ONLY : LIMA_PHILLIPS_REF_SPECTRUM
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
!
+TYPE(CST_t), INTENT(IN) :: CST
REAL, INTENT(IN) :: PTSTEP
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF! Reference density
@@ -240,12 +194,12 @@ IKE=SIZE(PTHT,3) - JPVEXT
!
! Temperature
!
-ZT(:,:,:) = PTHT(:,:,:) * ( PPABST(:,:,:)/XP00 ) ** (XRD/XCPD)
+ZT(:,:,:) = PTHT(:,:,:) * ( PPABST(:,:,:)/CST%XP00 ) ** (CST%XRD/CST%XCPD)
!
! Saturation over ice
!
-ZW(:,:,:) = EXP( XALPI - XBETAI/ZT(:,:,:) - XGAMI*ALOG(ZT(:,:,:) ) )
-ZW(:,:,:) = PRVT(:,:,:)*( PPABST(:,:,:)-ZW(:,:,:) ) / ( (XMV/XMD) * ZW(:,:,:) )
+ZW(:,:,:) = EXP( CST%XALPI - CST%XBETAI/ZT(:,:,:) - CST%XGAMI*ALOG(ZT(:,:,:) ) )
+ZW(:,:,:) = PRVT(:,:,:)*( PPABST(:,:,:)-ZW(:,:,:) ) / ( (CST%XMV/CST%XMD) * ZW(:,:,:) )
!
!
!-------------------------------------------------------------------------------
@@ -256,7 +210,7 @@ ZW(:,:,:) = PRVT(:,:,:)*( PPABST(:,:,:)-ZW(:,:,:) ) / ( (XMV/XMD) * ZW(:,:,:) )
!
!
GNEGT(:,:,:) = .FALSE.
-GNEGT(IIB:IIE,IJB:IJE,IKB:IKE) = ZT(IIB:IIE,IJB:IJE,IKB:IKE)<XTT-2.0 .AND. &
+GNEGT(IIB:IIE,IJB:IJE,IKB:IKE) = ZT(IIB:IIE,IJB:IJE,IKB:IKE)<CST%XTT-2.0 .AND. &
ZW(IIB:IIE,IJB:IJE,IKB:IKE)>0.95
!
INEGT = COUNTJV( GNEGT(:,:,:),I1(:),I2(:),I3(:))
@@ -334,17 +288,17 @@ IF (INEGT > 0) THEN
! -----------------------------------------
!
!
- ZTCELSIUS(:) = ZZT(:)-XTT ! T [°C]
- ZZW(:) = ZEXNREF(:)*( XCPD+XCPV*ZRVT(:)+XCL*(ZRCT(:)+ZRRT(:)) &
- +XCI*(ZRIT(:)+ZRST(:)+ZRGT(:)) )
- ZLSFACT(:) = (XLSTT+(XCPV-XCI)*ZTCELSIUS(:))/ZZW(:) ! L_s/(Pi_ref*C_ph)
- ZLVFACT(:) = (XLVTT+(XCPV-XCL)*ZTCELSIUS(:))/ZZW(:) ! L_v/(Pi_ref*C_ph)
+ ZTCELSIUS(:) = ZZT(:)-CST%XTT ! T [°C]
+ ZZW(:) = ZEXNREF(:)*( CST%XCPD+CST%XCPV*ZRVT(:)+CST%XCL*(ZRCT(:)+ZRRT(:)) &
+ +CST%XCI*(ZRIT(:)+ZRST(:)+ZRGT(:)) )
+ ZLSFACT(:) = (CST%XLSTT+(CST%XCPV-CST%XCI)*ZTCELSIUS(:))/ZZW(:) ! L_s/(Pi_ref*C_ph)
+ ZLVFACT(:) = (CST%XLVTT+(CST%XCPV-CST%XCL)*ZTCELSIUS(:))/ZZW(:) ! L_v/(Pi_ref*C_ph)
!
- ZZW(:) = EXP( XALPI - XBETAI/ZZT(:) - XGAMI*ALOG(ZZT(:) ) ) ! es_i
- ZSI(:) = ZRVT(:)*(ZPRES(:)-ZZW(:))/((XMV/XMD)*ZZW(:)) ! Saturation over ice
+ ZZW(:) = EXP( CST%XALPI - CST%XBETAI/ZZT(:) - CST%XGAMI*ALOG(ZZT(:) ) ) ! es_i
+ ZSI(:) = ZRVT(:)*(ZPRES(:)-ZZW(:))/((CST%XMV/CST%XMD)*ZZW(:)) ! Saturation over ice
!
- ZZY(:) = EXP( XALPW - XBETAW/ZZT(:) - XGAMW*ALOG(ZZT(:) ) ) ! es_w
- ZSW(:) = ZRVT(:)*(ZPRES(:)-ZZY(:))/((XMV/XMD)*ZZY(:)) ! Saturation over water
+ ZZY(:) = EXP( CST%XALPW - CST%XBETAW/ZZT(:) - CST%XGAMW*ALOG(ZZT(:) ) ) ! es_w
+ ZSW(:) = ZRVT(:)*(ZPRES(:)-ZZY(:))/((CST%XMV/CST%XMD)*ZZY(:)) ! Saturation over water
!
ZSI_W(:)= ZZY(:)/ZZW(:) ! Saturation over ice at water saturation: es_w/es_i
!
@@ -373,12 +327,12 @@ IF (INEGT > 0) THEN
!
! Computation of the reference activity spectrum ( ZZY = N_{IN,1,*} )
!
- CALL LIMA_PHILLIPS_REF_SPECTRUM(ZZT, ZSI, ZSI_W, ZZY)
+ CALL LIMA_PHILLIPS_REF_SPECTRUM(CST, ZZT, ZSI, ZSI_W, ZZY)
!
! For each aerosol species (DM1, DM2, BC, O), compute the fraction that may be activated
! Z_FRAC_ACT(INEGT,NSPECIE) = fraction of each species that may be activated
!
- CALL LIMA_PHILLIPS_INTEG(ZZT, ZSI, ZSI0, ZSW, ZZY, Z_FRAC_ACT)
+ CALL LIMA_PHILLIPS_INTEG(CST, ZZT, ZSI, ZSI0, ZSW, ZZY, Z_FRAC_ACT)
!
!
!-------------------------------------------------------------------------------
@@ -510,3 +464,4 @@ END IF ! INEGT > 0
!-------------------------------------------------------------------------------
!
END SUBROUTINE LIMA_PHILLIPS_IFN_NUCLEATION
+END MODULE MODE_LIMA_PHILLIPS_IFN_NUCLEATION
diff --git a/src/PHYEX/micro/mode_lima_phillips_integ.f90 b/src/PHYEX/micro/mode_lima_phillips_integ.f90
index 3af3048c6be9e97c9e7f21db12995e446ec2c802..210dd08f9009aee84bcec0a9b8997d1cbe681e46 100644
--- a/src/PHYEX/micro/mode_lima_phillips_integ.f90
+++ b/src/PHYEX/micro/mode_lima_phillips_integ.f90
@@ -1,23 +1,8 @@
-! ###############################
- MODULE MODI_LIMA_PHILLIPS_INTEG
-! ###############################
-!
-INTERFACE
- SUBROUTINE LIMA_PHILLIPS_INTEG (ZZT, ZSI, ZSI0, ZSW, ZZY, Z_FRAC_ACT)
-!
-REAL, DIMENSION(:), INTENT(IN) :: ZZT
-REAL, DIMENSION(:), INTENT(IN) :: ZSI
-REAL, DIMENSION(:,:), INTENT(IN) :: ZSI0
-REAL, DIMENSION(:), INTENT(IN) :: ZSW
-REAL, DIMENSION(:), INTENT(IN) :: ZZY
-REAL, DIMENSION(:,:), INTENT(INOUT) :: Z_FRAC_ACT
-!
-END SUBROUTINE LIMA_PHILLIPS_INTEG
-END INTERFACE
-END MODULE MODI_LIMA_PHILLIPS_INTEG
-!
+MODULE MODE_LIMA_PHILLIPS_INTEG
+ IMPLICIT NONE
+CONTAINS
! ######################################################################
- SUBROUTINE LIMA_PHILLIPS_INTEG (ZZT, ZSI, ZSI0, ZSW, ZZY, Z_FRAC_ACT)
+ SUBROUTINE LIMA_PHILLIPS_INTEG (CST, ZZT, ZSI, ZSI0, ZSW, ZZY, Z_FRAC_ACT)
! ######################################################################
!!
!! PURPOSE
@@ -48,17 +33,18 @@ END MODULE MODI_LIMA_PHILLIPS_INTEG
!* 0. DECLARATIONS
! ------------
!
-USE MODD_CST, ONLY : XTT, XPI
+USE MODD_CST, ONLY: CST_t
USE MODD_PARAM_LIMA, ONLY : XMDIAM_IFN, XSIGMA_IFN, NSPECIE, XFRAC_REF, &
XH, XAREA1, XGAMMA, XABSCISS, XWEIGHT, NDIAM, &
XT0, XDT0, XDSI0, XSW0, XTX1, XTX2
-USE MODI_LIMA_FUNCTIONS, ONLY : DELTA, DELTA_VEC
+USE MODE_LIMA_FUNCTIONS, ONLY : DELTA, DELTA_VEC
USE MODI_GAMMA_INC
!
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
!
+TYPE(CST_t), INTENT(IN) :: CST
REAL, DIMENSION(:), INTENT(IN) :: ZZT
REAL, DIMENSION(:), INTENT(IN) :: ZSI
REAL, DIMENSION(:,:), INTENT(IN) :: ZSI0
@@ -105,15 +91,15 @@ DO JSPECIE = 1, NSPECIE ! = 4 = {DM1, DM2, BC, O} respectively
! For T warmer than -35°C, the integration is approximated with µ_X << 1
! Error function : GAMMA_INC(1/2, x**2) = ERF(x) !!! for x>=0 !!!
!
-! WHERE (ZZT(:)>(XTT-35.) .AND. ZEMBRYO(:)>1.0E-8)
-! ZZX(:) = ZZX(:) + ZEMBRYO(:) * XPI * (XMDIAM_IFN(JSPECIE))**2 / 2.0 &
+! WHERE (ZZT(:)>(CST%XTT-35.) .AND. ZEMBRYO(:)>1.0E-8)
+! ZZX(:) = ZZX(:) + ZEMBRYO(:) * CST%XPI * (XMDIAM_IFN(JSPECIE))**2 / 2.0 &
! * EXP(2*(LOG(XSIGMA_IFN(JSPECIE)))**2) &
! * (1.0+GAMMA_INC(0.5,(SQRT(2.0)*LOG(XSIGMA_IFN(JSPECIE))-XB)**2))
! END WHERE
DO JL = 1, SIZE(ZZT)
- IF (ZZT(JL)>(XTT-35.) .AND. ZEMBRYO(JL)>1.0E-8) THEN
- ZZX(JL) = ZZX(JL) + ZEMBRYO(JL) * XPI * (XMDIAM_IFN(JSPECIE))**2 / 2.0 &
+ IF (ZZT(JL)>(CST%XTT-35.) .AND. ZEMBRYO(JL)>1.0E-8) THEN
+ ZZX(JL) = ZZX(JL) + ZEMBRYO(JL) * CST%XPI * (XMDIAM_IFN(JSPECIE))**2 / 2.0 &
* EXP(2*(LOG(XSIGMA_IFN(JSPECIE)))**2) &
* (1.0+SIGN(1.,SQRT(2.0)*LOG(XSIGMA_IFN(JSPECIE))-XB)*GAMMA_INC(0.5,(SQRT(2.0)*LOG(XSIGMA_IFN(JSPECIE))-XB)**2))
END IF
@@ -124,12 +110,12 @@ DO JSPECIE = 1, NSPECIE ! = 4 = {DM1, DM2, BC, O} respectively
! quadrature method and integration between 0 and 0.1 uses e(x) ~ 1+x+O(x**2)
! Beware : here, weights are normalized : XWEIGHT = wi/sqrt(pi)
!
- GINTEG(:) = ZZT(:)<=(XTT-35.) .AND. ZSI(:)>1.0 .AND. ZEMBRYO(:)>1.0E-8
+ GINTEG(:) = ZZT(:)<=(CST%XTT-35.) .AND. ZSI(:)>1.0 .AND. ZEMBRYO(:)>1.0E-8
!
DO JL = 1, NDIAM
DO JL2 = 1, SIZE(GINTEG)
IF (GINTEG(JL2)) THEN
- ZZX(JL2) = ZZX(JL2) - XWEIGHT(JL)*EXP(-ZEMBRYO(JL2)*XPI*(XMDIAM_IFN(JSPECIE))**2 &
+ ZZX(JL2) = ZZX(JL2) - XWEIGHT(JL)*EXP(-ZEMBRYO(JL2)*CST%XPI*(XMDIAM_IFN(JSPECIE))**2 &
* EXP(2.0*SQRT(2.0)*LOG(XSIGMA_IFN(JSPECIE)) * XABSCISS(JL)) )
END IF
ENDDO
@@ -137,7 +123,7 @@ DO JSPECIE = 1, NSPECIE ! = 4 = {DM1, DM2, BC, O} respectively
!
! DO JL2 = 1, SIZE(GINTEG)
! IF (GINTEG(JL2)) THEN
-! ZZX(JL2) = ZZX(JL2) + 0.5* XPI*ZEMBRYO(JL2)*(XMDIAM_IFN(JSPECIE))**2 &
+! ZZX(JL2) = ZZX(JL2) + 0.5* CST%XPI*ZEMBRYO(JL2)*(XMDIAM_IFN(JSPECIE))**2 &
! * (1.0-( 1.0-GAMMA_INC(0.5,(SQRT(2.0)*LOG(XSIGMA_IFN(JSPECIE))-XB)**2)) &
! * EXP( 2.0*(LOG(XSIGMA_IFN(JSPECIE)))**2) )
! END IF
@@ -145,7 +131,7 @@ DO JSPECIE = 1, NSPECIE ! = 4 = {DM1, DM2, BC, O} respectively
DO JL2 = 1, SIZE(GINTEG)
IF (GINTEG(JL2)) THEN
ZZX(JL2) = 1 + ZZX(JL2) &
- - ( 0.5* XPI*ZEMBRYO(JL2)*(XMDIAM_IFN(JSPECIE))**2 * EXP( 2.0*(LOG(XSIGMA_IFN(JSPECIE)))**2) &
+ - ( 0.5* CST%XPI*ZEMBRYO(JL2)*(XMDIAM_IFN(JSPECIE))**2 * EXP( 2.0*(LOG(XSIGMA_IFN(JSPECIE)))**2) &
* ( 1.0-SIGN(1.,SQRT(2.0)*LOG(XSIGMA_IFN(JSPECIE))-XB)*GAMMA_INC(0.5,(SQRT(2.0)*LOG(XSIGMA_IFN(JSPECIE))-XB)**2)) )
END IF
ENDDO
@@ -161,3 +147,4 @@ DO JSPECIE = 1, NSPECIE ! = 4 = {DM1, DM2, BC, O} respectively
ENDDO
!
END SUBROUTINE LIMA_PHILLIPS_INTEG
+END MODULE MODE_LIMA_PHILLIPS_INTEG
diff --git a/src/PHYEX/micro/mode_lima_phillips_ref_spectrum.f90 b/src/PHYEX/micro/mode_lima_phillips_ref_spectrum.f90
index d549d7051fc8cb3c43ef7d755fe31da9060dd8b0..b1492d450bab9ae445a17bc7be1ec4594f091600 100644
--- a/src/PHYEX/micro/mode_lima_phillips_ref_spectrum.f90
+++ b/src/PHYEX/micro/mode_lima_phillips_ref_spectrum.f90
@@ -1,21 +1,8 @@
-! ######################################
- MODULE MODI_LIMA_PHILLIPS_REF_SPECTRUM
-! ######################################
-!
-INTERFACE
- SUBROUTINE LIMA_PHILLIPS_REF_SPECTRUM (ZZT, ZSI, ZSI_W, ZZY)
-!
-REAL, DIMENSION(:), INTENT(IN) :: ZZT ! Temperature
-REAL, DIMENSION(:), INTENT(IN) :: ZSI ! Saturation over ice
-REAL, DIMENSION(:), INTENT(IN) :: ZSI_W ! Saturation over ice at water sat.
-REAL, DIMENSION(:), INTENT(INOUT) :: ZZY ! Reference activity spectrum
-!
-END SUBROUTINE LIMA_PHILLIPS_REF_SPECTRUM
-END INTERFACE
-END MODULE MODI_LIMA_PHILLIPS_REF_SPECTRUM
-!
+MODULE MODE_LIMA_PHILLIPS_REF_SPECTRUM
+ IMPLICIT NONE
+CONTAINS
! ######################################################################
- SUBROUTINE LIMA_PHILLIPS_REF_SPECTRUM (ZZT, ZSI, ZSI_W, ZZY)
+ SUBROUTINE LIMA_PHILLIPS_REF_SPECTRUM (CST, ZZT, ZSI, ZSI_W, ZZY)
! ######################################################################
!!
!! PURPOSE
@@ -46,14 +33,15 @@ END MODULE MODI_LIMA_PHILLIPS_REF_SPECTRUM
!* 0. DECLARATIONS
! ------------
!
-USE MODD_CST, ONLY : XTT
+USE MODD_CST, ONLY: CST_t
USE MODD_PARAM_LIMA, ONLY : XGAMMA, XRHO_CFDC
-USE MODI_LIMA_FUNCTIONS, ONLY : RECT, DELTA
+USE MODE_LIMA_FUNCTIONS, ONLY : RECT, DELTA
!
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
!
+TYPE(CST_t), INTENT(IN) :: CST
REAL, DIMENSION(:), INTENT(IN) :: ZZT ! Temperature
REAL, DIMENSION(:), INTENT(IN) :: ZSI ! Saturation over ice
REAL, DIMENSION(:), INTENT(IN) :: ZSI_W ! Saturation over ice at water sat.
@@ -93,7 +81,7 @@ WHERE( ZSI(:)>1.0 )
!
ZZY(:) =1000.*XGAMMA/XRHO_CFDC &
* ( EXP(12.96*(MIN(ZSI2(:),7.)-1.1)) )**0.3 &
- * RECT(1.,0.,ZZT(:),(XTT-80.),(XTT-35.))
+ * RECT(1.,0.,ZZT(:),(CST%XTT-80.),(CST%XTT-35.))
!
!* -35 C < T <= -25 C (in Appendix A)
!
@@ -106,13 +94,13 @@ WHERE( ZSI(:)>1.0 )
!
ZMAX(:) =1000.*XGAMMA/XRHO_CFDC &
* ( EXP(12.96*(ZSI_W(:)-1.1)) )**0.3 &
- * RECT(1.,0.,ZZT(:),(XTT-35.),(XTT-30.))
+ * RECT(1.,0.,ZZT(:),(CST%XTT-35.),(CST%XTT-30.))
!
!* -30 C < T <= -25 C
!
ZMAX(:) = ZMAX(:) +1000.*XPSI &
* EXP( 12.96*(ZSI_W(:)-1.0)-0.639 ) &
- * RECT(1.,0.,ZZT(:),(XTT-30.),(XTT-25.))
+ * RECT(1.,0.,ZZT(:),(CST%XTT-30.),(CST%XTT-25.))
Z1(:) = MIN(ZZY1(:), ZMAX(:))
Z2(:) = MIN(ZZY2(:), ZMAX(:))
!
@@ -120,21 +108,20 @@ WHERE( ZSI(:)>1.0 )
!
ZZY(:) = ZZY(:) + 1000.*XPSI &
* EXP( 12.96*(MIN(ZSI2(:),7.)-1.0)-0.639 ) &
- * RECT(1.,0.,ZZT(:),(XTT-25.),(XTT-2.))
+ * RECT(1.,0.,ZZT(:),(CST%XTT-25.),(CST%XTT-2.))
END WHERE
!
WHERE (Z2(:)>0.0 .AND. Z1(:)>0.0)
- ZMOY(:) = Z2(:)*(Z1(:)/Z2(:))**DELTA(1.,0.,ZZT(:),(XTT-35.),(XTT-25.))
+ ZMOY(:) = Z2(:)*(Z1(:)/Z2(:))**DELTA(1.,0.,ZZT(:),(CST%XTT-35.),(CST%XTT-25.))
ZZY(:) = ZZY(:) + MIN(ZMOY(:),ZMAX(:)) ! N_{IN,1,*}
END WHERE
!
-!++cb++
DEALLOCATE(ZMAX)
DEALLOCATE(ZMOY)
DEALLOCATE(ZZY1)
DEALLOCATE(ZZY2)
DEALLOCATE(Z1)
DEALLOCATE(Z2)
-!--cb--
!
END SUBROUTINE LIMA_PHILLIPS_REF_SPECTRUM
+END MODULE MODE_LIMA_PHILLIPS_REF_SPECTRUM
diff --git a/src/PHYEX/micro/mode_lima_rain_accr_snow.f90 b/src/PHYEX/micro/mode_lima_rain_accr_snow.f90
index a63ac24a4b9c776d316c18074682e61dddff53ed..66f06a67fe17542a7f11409800e09a9ea9f75d8e 100644
--- a/src/PHYEX/micro/mode_lima_rain_accr_snow.f90
+++ b/src/PHYEX/micro/mode_lima_rain_accr_snow.f90
@@ -3,47 +3,14 @@
!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_RAIN_ACCR_SNOW
-! #################################
-!
-INTERFACE
- 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 )
-!
-REAL, INTENT(IN) :: PTSTEP
-LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE
-!
-REAL, DIMENSION(:), INTENT(IN) :: PRHODREF !
-REAL, DIMENSION(:), INTENT(IN) :: PT !
-!
-REAL, DIMENSION(:), INTENT(IN) :: PRRT ! Rain mr at t
-REAL, DIMENSION(:), INTENT(IN) :: PCRT ! Rain C. at t
-REAL, DIMENSION(:), INTENT(IN) :: PRST ! Snow mr at t
-REAL, DIMENSION(:), INTENT(IN) :: PCST ! Snow C. at t
-REAL, DIMENSION(:), INTENT(IN) :: PLBDR !
-REAL, DIMENSION(:), INTENT(IN) :: PLBDS !
-REAL, DIMENSION(:), INTENT(IN) :: PLVFACT !
-REAL, DIMENSION(:), INTENT(IN) :: PLSFACT !
-!
-REAL, DIMENSION(:), INTENT(OUT) :: P_TH_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_CS_ACC
-REAL, DIMENSION(:), INTENT(OUT) :: P_RG_ACC
-!
-END SUBROUTINE LIMA_RAIN_ACCR_SNOW
-END INTERFACE
-END MODULE MODI_LIMA_RAIN_ACCR_SNOW
-!
+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, &
+ P_TH_ACC, P_RR_ACC, P_CR_ACC, P_RS_ACC, P_CS_ACC, P_RG_ACC )
! ###################################################################################
!
!! PURPOSE
@@ -398,3 +365,4 @@ CONTAINS
!-------------------------------------------------------------------------------
!
END SUBROUTINE LIMA_RAIN_ACCR_SNOW
+END MODULE MODE_LIMA_RAIN_ACCR_SNOW
diff --git a/src/PHYEX/micro/mode_lima_rain_evaporation.f90 b/src/PHYEX/micro/mode_lima_rain_evaporation.f90
index c7211f2fcd62960a43373cb63f19c38314ea6d0f..86e59a8d7778eba2ba80b4263a1d9edea2980a3f 100644
--- a/src/PHYEX/micro/mode_lima_rain_evaporation.f90
+++ b/src/PHYEX/micro/mode_lima_rain_evaporation.f90
@@ -3,48 +3,15 @@
!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_RAIN_EVAPORATION
-! ##########################
-!
-INTERFACE
- SUBROUTINE LIMA_RAIN_EVAPORATION (PTSTEP, LDCOMPUTE, &
- PRHODREF, PT, PLV, PLVFACT, PEVSAT, PRVSAT, &
- PRVT, PRCT, PRRT, PCRT, PLBDR, &
- P_TH_EVAP, P_RR_EVAP, P_CR_EVAP, &
- PEVAP3D )
-!
-REAL, INTENT(IN) :: PTSTEP ! Time step
-LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE !
-!
-REAL, DIMENSION(:), INTENT(IN) :: PRHODREF ! Reference density
-REAL, DIMENSION(:), INTENT(IN) :: PT ! Temperature
-REAL, DIMENSION(:), INTENT(IN) :: PLV !
-REAL, DIMENSION(:), INTENT(IN) :: PLVFACT !
-REAL, DIMENSION(:), INTENT(IN) :: PEVSAT !
-REAL, DIMENSION(:), INTENT(IN) :: PRVSAT !
-!
-REAL, DIMENSION(:), INTENT(IN) :: PRVT ! Water vapor m.r. at t
-REAL, DIMENSION(:), INTENT(IN) :: PRCT ! Cloud water m.r. at t
-REAL, DIMENSION(:), INTENT(IN) :: PRRT ! Rain water m.r. at t
-REAL, DIMENSION(:), INTENT(IN) :: PCRT ! Rain water conc at t
-REAL, DIMENSION(:), INTENT(IN) :: PLBDR ! Lambda(rain)
-!
-REAL, DIMENSION(:), INTENT(OUT) :: P_TH_EVAP
-REAL, DIMENSION(:), INTENT(OUT) :: P_RR_EVAP
-REAL, DIMENSION(:), INTENT(OUT) :: P_CR_EVAP
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: PEVAP3D ! Rain evap profile
-!
-END SUBROUTINE LIMA_RAIN_EVAPORATION
-END INTERFACE
-END MODULE MODI_LIMA_RAIN_EVAPORATION
+MODULE MODE_LIMA_RAIN_EVAPORATION
+ IMPLICIT NONE
+CONTAINS
! ###############################################################################
- SUBROUTINE LIMA_RAIN_EVAPORATION (PTSTEP, LDCOMPUTE, &
- PRHODREF, PT, PLV, PLVFACT, PEVSAT, PRVSAT, &
- PRVT, PRCT, PRRT, PCRT, PLBDR, &
- P_TH_EVAP, P_RR_EVAP, P_CR_EVAP, &
- PEVAP3D )
+ SUBROUTINE LIMA_RAIN_EVAPORATION (PTSTEP, LDCOMPUTE, &
+ PRHODREF, PT, PLV, PLVFACT, PEVSAT, PRVSAT, &
+ PRVT, PRCT, PRRT, PCRT, PLBDR, &
+ P_TH_EVAP, P_RR_EVAP, P_CR_EVAP, &
+ PEVAP3D )
! ###############################################################################
!
!!
@@ -168,3 +135,4 @@ END IF
!-----------------------------------------------------------------------------
!
END SUBROUTINE LIMA_RAIN_EVAPORATION
+END MODULE MODE_LIMA_RAIN_EVAPORATION
diff --git a/src/PHYEX/micro/mode_lima_rain_freezing.f90 b/src/PHYEX/micro/mode_lima_rain_freezing.f90
index a6c9504a1cef696a5003a099c293a41060ed4fa7..b3bee2145b48b566fd0673e947a804fe0f37a8d4 100644
--- a/src/PHYEX/micro/mode_lima_rain_freezing.f90
+++ b/src/PHYEX/micro/mode_lima_rain_freezing.f90
@@ -3,44 +3,14 @@
!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_RAIN_FREEZING
-! #################################
-!
-INTERFACE
- SUBROUTINE LIMA_RAIN_FREEZING (LDCOMPUTE, &
- PRHODREF, PT, PLVFACT, PLSFACT, &
- PRRT, PCRT, PRIT, PCIT, PLBDR, &
- P_TH_CFRZ, P_RR_CFRZ, P_CR_CFRZ, P_RI_CFRZ, P_CI_CFRZ )
-!
-LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE
-!
-REAL, DIMENSION(:), INTENT(IN) :: PRHODREF ! Reference Exner function
-REAL, DIMENSION(:), INTENT(IN) :: PT !
-REAL, DIMENSION(:), INTENT(IN) :: PLVFACT !
-REAL, DIMENSION(:), INTENT(IN) :: PLSFACT !
-!
-REAL, DIMENSION(:), INTENT(IN) :: PRRT !
-REAL, DIMENSION(:), INTENT(IN) :: PCRT !
-REAL, DIMENSION(:), INTENT(IN) :: PRIT !
-REAL, DIMENSION(:), INTENT(IN) :: PCIT !
-REAL, DIMENSION(:), INTENT(IN) :: PLBDR !
-!
-REAL, DIMENSION(:), INTENT(OUT) :: P_TH_CFRZ
-REAL, DIMENSION(:), INTENT(OUT) :: P_RR_CFRZ
-REAL, DIMENSION(:), INTENT(OUT) :: P_CR_CFRZ
-REAL, DIMENSION(:), INTENT(OUT) :: P_RI_CFRZ
-REAL, DIMENSION(:), INTENT(OUT) :: P_CI_CFRZ
-!
-END SUBROUTINE LIMA_RAIN_FREEZING
-END INTERFACE
-END MODULE MODI_LIMA_RAIN_FREEZING
-!
+MODULE MODE_LIMA_RAIN_FREEZING
+ IMPLICIT NONE
+CONTAINS
! #######################################################################################
- SUBROUTINE LIMA_RAIN_FREEZING (LDCOMPUTE, &
- PRHODREF, PT, PLVFACT, PLSFACT, &
- PRRT, PCRT, PRIT, PCIT, PLBDR, &
- P_TH_CFRZ, P_RR_CFRZ, P_CR_CFRZ, P_RI_CFRZ, P_CI_CFRZ )
+ SUBROUTINE LIMA_RAIN_FREEZING (LDCOMPUTE, &
+ PRHODREF, PT, PLVFACT, PLSFACT, &
+ PRRT, PCRT, PRIT, PCIT, PLBDR, &
+ P_TH_CFRZ, P_RR_CFRZ, P_CR_CFRZ, P_RI_CFRZ, P_CI_CFRZ )
! #######################################################################################
!
!! PURPOSE
@@ -133,3 +103,4 @@ END WHERE
!-------------------------------------------------------------------------------
!
END SUBROUTINE LIMA_RAIN_FREEZING
+END MODULE MODE_LIMA_RAIN_FREEZING
diff --git a/src/PHYEX/micro/mode_lima_raindrop_shattering_freezing.f90 b/src/PHYEX/micro/mode_lima_raindrop_shattering_freezing.f90
index dc7c14066214dfb589ad8428291dbc1c9262706d..43f20e08f1825fe23736064c7fb91e1c1694c8ad 100644
--- a/src/PHYEX/micro/mode_lima_raindrop_shattering_freezing.f90
+++ b/src/PHYEX/micro/mode_lima_raindrop_shattering_freezing.f90
@@ -3,41 +3,15 @@
!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_RAINDROP_SHATTERING_FREEZING
-! #############################################
-!
-INTERFACE
- SUBROUTINE LIMA_RAINDROP_SHATTERING_FREEZING (LDCOMPUTE, &
- PRHODREF, &
- PRRT, PCRT, PRIT, PCIT, PRGT, &
- PLBDR, &
- P_RI_RDSF, P_CI_RDSF )
-!
-LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE
-!
-REAL, DIMENSION(:), INTENT(IN) :: PRHODREF
-!
-REAL, DIMENSION(:), INTENT(IN) :: PRRT
-REAL, DIMENSION(:), INTENT(IN) :: PCRT
-REAL, DIMENSION(:), INTENT(IN) :: PRIT
-REAL, DIMENSION(:), INTENT(IN) :: PCIT
-REAL, DIMENSION(:), INTENT(IN) :: PRGT
-REAL, DIMENSION(:), INTENT(IN) :: PLBDR
-!
-REAL, DIMENSION(:), INTENT(OUT) :: P_RI_RDSF
-REAL, DIMENSION(:), INTENT(OUT) :: P_CI_RDSF
-!
-END SUBROUTINE LIMA_RAINDROP_SHATTERING_FREEZING
-END INTERFACE
-END MODULE MODI_LIMA_RAINDROP_SHATTERING_FREEZING
-!
+MODULE MODE_LIMA_RAINDROP_SHATTERING_FREEZING
+ IMPLICIT NONE
+CONTAINS
! #######################################################################
- SUBROUTINE LIMA_RAINDROP_SHATTERING_FREEZING (LDCOMPUTE, &
- PRHODREF, &
- PRRT, PCRT, PRIT, PCIT, PRGT, &
- PLBDR, &
- P_RI_RDSF, P_CI_RDSF )
+ SUBROUTINE LIMA_RAINDROP_SHATTERING_FREEZING (LDCOMPUTE, &
+ PRHODREF, &
+ PRRT, PCRT, PRIT, PCIT, PRGT, &
+ PLBDR, &
+ P_RI_RDSF, P_CI_RDSF )
! #######################################################################
!
!! PURPOSE
@@ -157,3 +131,4 @@ ENDIF
!-------------------------------------------------------------------------------
!
END SUBROUTINE LIMA_RAINDROP_SHATTERING_FREEZING
+END MODULE MODE_LIMA_RAINDROP_SHATTERING_FREEZING
diff --git a/src/PHYEX/micro/mode_lima_read_xker_gweth.f90 b/src/PHYEX/micro/mode_lima_read_xker_gweth.f90
index 25a567ec83399fb73d1774df9bacf5d879b67240..b0a514a0ba2fce4e6724da3ed87984e1d1496e74 100644
--- a/src/PHYEX/micro/mode_lima_read_xker_gweth.f90
+++ b/src/PHYEX/micro/mode_lima_read_xker_gweth.f90
@@ -3,49 +3,14 @@
!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 microph 2006/05/18 13:07:25
-!-----------------------------------------------------------------
-! ###########################
- MODULE MODI_LIMA_READ_XKER_GWETH
-! ###########################
-!
-INTERFACE
- SUBROUTINE LIMA_READ_XKER_GWETH (KWETLBDAH,KWETLBDAG,KND, &
- PALPHAH,PNUH,PALPHAG,PNUG,PEHG,PBG,PCH,PDH,PCG,PDG, &
- PWETLBDAH_MAX,PWETLBDAG_MAX,PWETLBDAH_MIN,PWETLBDAG_MIN, &
- PFDINFTY,PKER_GWETH )
-!
-INTEGER, INTENT(OUT) :: KND,KWETLBDAH,KWETLBDAG
-REAL, INTENT(OUT) :: PALPHAH
-REAL, INTENT(OUT) :: PNUH
-REAL, INTENT(OUT) :: PALPHAG
-REAL, INTENT(OUT) :: PNUG
-REAL, INTENT(OUT) :: PEHG
-REAL, INTENT(OUT) :: PBG
-REAL, INTENT(OUT) :: PCH
-REAL, INTENT(OUT) :: PDH
-REAL, INTENT(OUT) :: PCG
-REAL, INTENT(OUT) :: PDG
-REAL, INTENT(OUT) :: PWETLBDAH_MAX
-REAL, INTENT(OUT) :: PWETLBDAG_MAX
-REAL, INTENT(OUT) :: PWETLBDAH_MIN
-REAL, INTENT(OUT) :: PWETLBDAG_MIN
-REAL, INTENT(OUT) :: PFDINFTY
-REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL :: PKER_GWETH
-!
-END SUBROUTINE LIMA_READ_XKER_GWETH
-!
-END INTERFACE
-!
-END MODULE MODI_LIMA_READ_XKER_GWETH
+MODULE MODE_LIMA_READ_XKER_GWETH
+ IMPLICIT NONE
+CONTAINS
! ########################################################################
- SUBROUTINE LIMA_READ_XKER_GWETH (KWETLBDAH,KWETLBDAG,KND, &
- PALPHAH,PNUH,PALPHAG,PNUG,PEHG,PBG,PCH,PDH,PCG,PDG, &
- PWETLBDAH_MAX,PWETLBDAG_MAX,PWETLBDAH_MIN,PWETLBDAG_MIN, &
- PFDINFTY,PKER_GWETH )
+ SUBROUTINE LIMA_READ_XKER_GWETH (KWETLBDAH,KWETLBDAG,KND, &
+ PALPHAH,PNUH,PALPHAG,PNUG,PEHG,PBG,PCH,PDH,PCG,PDG, &
+ PWETLBDAH_MAX,PWETLBDAG_MAX,PWETLBDAH_MIN,PWETLBDAG_MIN, &
+ PFDINFTY,PKER_GWETH )
! ########################################################################
!
!!**** * * - initialize the kernels for the graupel-hail wet growth process
@@ -1735,3 +1700,4 @@ PKER_GWETH( 40, 40) = 0.197923E-01
END IF
!
END SUBROUTINE LIMA_READ_XKER_GWETH
+END MODULE MODE_LIMA_READ_XKER_GWETH
diff --git a/src/PHYEX/micro/mode_lima_read_xker_raccs.f90 b/src/PHYEX/micro/mode_lima_read_xker_raccs.f90
index 5a75adf255339c49ec3c786f1d70c08083274e16..55afa459085921cb76b02b6471ce22c7da2a5612 100644
--- a/src/PHYEX/micro/mode_lima_read_xker_raccs.f90
+++ b/src/PHYEX/micro/mode_lima_read_xker_raccs.f90
@@ -3,53 +3,14 @@
!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/05/18 13:07:25
-!-----------------------------------------------------------------
-! ###########################
- MODULE MODI_LIMA_READ_XKER_RACCS
-! ###########################
-!
-INTERFACE
- SUBROUTINE LIMA_READ_XKER_RACCS (KACCLBDAS,KACCLBDAR,KND, &
- PALPHAS,PNUS,PALPHAR,PNUR,PESR,PBS,PBR,PCS,PDS,PFVELOS,PCR,PDR, &
- PACCLBDAS_MAX,PACCLBDAR_MAX,PACCLBDAS_MIN,PACCLBDAR_MIN, &
- PFDINFTY,PKER_RACCSS,PKER_RACCS,PKER_SACCRG )
-!
-INTEGER, INTENT(OUT) :: KND,KACCLBDAS,KACCLBDAR
-REAL, INTENT(OUT) :: PALPHAS
-REAL, INTENT(OUT) :: PNUS
-REAL, INTENT(OUT) :: PALPHAR
-REAL, INTENT(OUT) :: PNUR
-REAL, INTENT(OUT) :: PESR
-REAL, INTENT(OUT) :: PBS
-REAL, INTENT(OUT) :: PBR
-REAL, INTENT(OUT) :: PCS
-REAL, INTENT(OUT) :: PDS
-REAL, INTENT(OUT) :: PFVELOS
-REAL, INTENT(OUT) :: PCR
-REAL, INTENT(OUT) :: PDR
-REAL, INTENT(OUT) :: PACCLBDAS_MAX
-REAL, INTENT(OUT) :: PACCLBDAR_MAX
-REAL, INTENT(OUT) :: PACCLBDAS_MIN
-REAL, INTENT(OUT) :: PACCLBDAR_MIN
-REAL, INTENT(OUT) :: PFDINFTY
-REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL :: PKER_RACCSS
-REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL :: PKER_RACCS
-REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL :: PKER_SACCRG
-!
-END SUBROUTINE LIMA_READ_XKER_RACCS
-!
-END INTERFACE
-!
-END MODULE MODI_LIMA_READ_XKER_RACCS
+MODULE MODE_LIMA_READ_XKER_RACCS
+ IMPLICIT NONE
+CONTAINS
! ##########################################################################
- SUBROUTINE LIMA_READ_XKER_RACCS (KACCLBDAS,KACCLBDAR,KND, &
- PALPHAS,PNUS,PALPHAR,PNUR,PESR,PBS,PBR,PCS,PDS,PFVELOS,PCR,PDR, &
- PACCLBDAS_MAX,PACCLBDAR_MAX,PACCLBDAS_MIN,PACCLBDAR_MIN, &
- PFDINFTY,PKER_RACCSS,PKER_RACCS,PKER_SACCRG )
+ SUBROUTINE LIMA_READ_XKER_RACCS (KACCLBDAS,KACCLBDAR,KND, &
+ PALPHAS,PNUS,PALPHAR,PNUR,PESR,PBS,PBR,PCS,PDS,PFVELOS,PCR,PDR, &
+ PACCLBDAS_MAX,PACCLBDAR_MAX,PACCLBDAS_MIN,PACCLBDAR_MIN, &
+ PFDINFTY,PKER_RACCSS,PKER_RACCS,PKER_SACCRG )
! ##########################################################################
!
!!**** * * - initialize the kernels for the rain-snow accretion process
@@ -4951,3 +4912,4 @@ IF( PRESENT(PKER_SACCRG) ) THEN
END IF
!
END SUBROUTINE LIMA_READ_XKER_RACCS
+END MODULE MODE_LIMA_READ_XKER_RACCS
diff --git a/src/PHYEX/micro/mode_lima_read_xker_rdryg.f90 b/src/PHYEX/micro/mode_lima_read_xker_rdryg.f90
index de1a4287401dc151fb785ab4e23b24010b8988e0..160392c58731e22c56e5fb8a5b96b161d6bcccde 100644
--- a/src/PHYEX/micro/mode_lima_read_xker_rdryg.f90
+++ b/src/PHYEX/micro/mode_lima_read_xker_rdryg.f90
@@ -3,49 +3,14 @@
!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/05/18 13:07:25
-!-----------------------------------------------------------------
-! ###########################
- MODULE MODI_LIMA_READ_XKER_RDRYG
-! ###########################
-!
-INTERFACE
- SUBROUTINE LIMA_READ_XKER_RDRYG (KDRYLBDAG,KDRYLBDAR,KND, &
- PALPHAG,PNUG,PALPHAR,PNUR,PEGR,PBR,PCG,PDG,PCR,PDR, &
- PDRYLBDAG_MAX,PDRYLBDAR_MAX,PDRYLBDAG_MIN,PDRYLBDAR_MIN, &
- PFDINFTY,PKER_RDRYG )
-!
-INTEGER, INTENT(OUT) :: KND,KDRYLBDAG,KDRYLBDAR
-REAL, INTENT(OUT) :: PALPHAG
-REAL, INTENT(OUT) :: PNUG
-REAL, INTENT(OUT) :: PALPHAR
-REAL, INTENT(OUT) :: PNUR
-REAL, INTENT(OUT) :: PEGR
-REAL, INTENT(OUT) :: PBR
-REAL, INTENT(OUT) :: PCG
-REAL, INTENT(OUT) :: PDG
-REAL, INTENT(OUT) :: PCR
-REAL, INTENT(OUT) :: PDR
-REAL, INTENT(OUT) :: PDRYLBDAG_MAX
-REAL, INTENT(OUT) :: PDRYLBDAR_MAX
-REAL, INTENT(OUT) :: PDRYLBDAG_MIN
-REAL, INTENT(OUT) :: PDRYLBDAR_MIN
-REAL, INTENT(OUT) :: PFDINFTY
-REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL :: PKER_RDRYG
-!
-END SUBROUTINE LIMA_READ_XKER_RDRYG
-!
-END INTERFACE
-!
-END MODULE MODI_LIMA_READ_XKER_RDRYG
+MODULE MODE_LIMA_READ_XKER_RDRYG
+ IMPLICIT NONE
+CONTAINS
! ########################################################################
- SUBROUTINE LIMA_READ_XKER_RDRYG (KDRYLBDAG,KDRYLBDAR,KND, &
- PALPHAG,PNUG,PALPHAR,PNUR,PEGR,PBR,PCG,PDG,PCR,PDR, &
- PDRYLBDAG_MAX,PDRYLBDAR_MAX,PDRYLBDAG_MIN,PDRYLBDAR_MIN, &
- PFDINFTY,PKER_RDRYG )
+ SUBROUTINE LIMA_READ_XKER_RDRYG (KDRYLBDAG,KDRYLBDAR,KND, &
+ PALPHAG,PNUG,PALPHAR,PNUR,PEGR,PBR,PCG,PDG,PCR,PDR, &
+ PDRYLBDAG_MAX,PDRYLBDAR_MAX,PDRYLBDAG_MIN,PDRYLBDAR_MIN, &
+ PFDINFTY,PKER_RDRYG )
! ########################################################################
!
!!**** * * - initialize the kernels for the snow-graupel dry growth process
@@ -1734,3 +1699,4 @@ PKER_RDRYG( 40, 40) = 0.603544E-02
END IF
!
END SUBROUTINE LIMA_READ_XKER_RDRYG
+END MODULE MODE_LIMA_READ_XKER_RDRYG
diff --git a/src/PHYEX/micro/mode_lima_read_xker_sdryg.f90 b/src/PHYEX/micro/mode_lima_read_xker_sdryg.f90
index f3c2377e598d75bfa99128901bc11047e768d4ee..d12ca6142379d89ae956366a15b105784e13f08c 100644
--- a/src/PHYEX/micro/mode_lima_read_xker_sdryg.f90
+++ b/src/PHYEX/micro/mode_lima_read_xker_sdryg.f90
@@ -3,50 +3,14 @@
!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/05/18 13:07:25
-!-----------------------------------------------------------------
-! ###########################
- MODULE MODI_LIMA_READ_XKER_SDRYG
-! ###########################
-!
-INTERFACE
- SUBROUTINE LIMA_READ_XKER_SDRYG (KDRYLBDAG,KDRYLBDAS,KND, &
- PALPHAG,PNUG,PALPHAS,PNUS,PEGS,PBS,PCG,PDG,PCS,PDS,PFVELOS, &
- PDRYLBDAG_MAX,PDRYLBDAS_MAX,PDRYLBDAG_MIN,PDRYLBDAS_MIN, &
- PFDINFTY,PKER_SDRYG )
-!
-INTEGER, INTENT(OUT) :: KND,KDRYLBDAG,KDRYLBDAS
-REAL, INTENT(OUT) :: PALPHAG
-REAL, INTENT(OUT) :: PNUG
-REAL, INTENT(OUT) :: PALPHAS
-REAL, INTENT(OUT) :: PNUS
-REAL, INTENT(OUT) :: PEGS
-REAL, INTENT(OUT) :: PBS
-REAL, INTENT(OUT) :: PCG
-REAL, INTENT(OUT) :: PDG
-REAL, INTENT(OUT) :: PCS
-REAL, INTENT(OUT) :: PDS
-REAL, INTENT(OUT) :: PFVELOS
-REAL, INTENT(OUT) :: PDRYLBDAG_MAX
-REAL, INTENT(OUT) :: PDRYLBDAS_MAX
-REAL, INTENT(OUT) :: PDRYLBDAG_MIN
-REAL, INTENT(OUT) :: PDRYLBDAS_MIN
-REAL, INTENT(OUT) :: PFDINFTY
-REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL :: PKER_SDRYG
-!
-END SUBROUTINE LIMA_READ_XKER_SDRYG
-!
-END INTERFACE
-!
-END MODULE MODI_LIMA_READ_XKER_SDRYG
+MODULE MODE_LIMA_READ_XKER_SDRYG
+ IMPLICIT NONE
+CONTAINS
! ########################################################################
- SUBROUTINE LIMA_READ_XKER_SDRYG (KDRYLBDAG,KDRYLBDAS,KND, &
- PALPHAG,PNUG,PALPHAS,PNUS,PEGS,PBS,PCG,PDG,PCS,PDS,PFVELOS, &
- PDRYLBDAG_MAX,PDRYLBDAS_MAX,PDRYLBDAG_MIN,PDRYLBDAS_MIN, &
- PFDINFTY,PKER_SDRYG )
+ SUBROUTINE LIMA_READ_XKER_SDRYG (KDRYLBDAG,KDRYLBDAS,KND, &
+ PALPHAG,PNUG,PALPHAS,PNUS,PEGS,PBS,PCG,PDG,PCS,PDS,PFVELOS, &
+ PDRYLBDAG_MAX,PDRYLBDAS_MAX,PDRYLBDAG_MIN,PDRYLBDAS_MIN, &
+ PFDINFTY,PKER_SDRYG )
! ########################################################################
!
!!**** * * - initialize the kernels for the snow-graupel dry growth process
@@ -3338,3 +3302,4 @@ PKER_SDRYG( 40, 80) = 0.332823E+00
END IF
!
END SUBROUTINE LIMA_READ_XKER_SDRYG
+END MODULE MODE_LIMA_READ_XKER_SDRYG
diff --git a/src/PHYEX/micro/mode_lima_read_xker_sweth.f90 b/src/PHYEX/micro/mode_lima_read_xker_sweth.f90
index a034ec708a09071c4185be149cc4ef3c89d294fa..fe423f89a53fda3abfc716d9fdc36d6d52f0ef64 100644
--- a/src/PHYEX/micro/mode_lima_read_xker_sweth.f90
+++ b/src/PHYEX/micro/mode_lima_read_xker_sweth.f90
@@ -3,50 +3,14 @@
!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 microph 2006/05/18 13:07:25
-!-----------------------------------------------------------------
-! ###########################
- MODULE MODI_LIMA_READ_XKER_SWETH
-! ###########################
-!
-INTERFACE
- SUBROUTINE LIMA_READ_XKER_SWETH (KWETLBDAH,KWETLBDAS,KND, &
- PALPHAH,PNUH,PALPHAS,PNUS,PEHS,PBS,PCH,PDH,PCS,PDS,PFVELOS, &
- PWETLBDAH_MAX,PWETLBDAS_MAX,PWETLBDAH_MIN,PWETLBDAS_MIN, &
- PFDINFTY,PKER_SWETH )
-!
-INTEGER, INTENT(OUT) :: KND,KWETLBDAH,KWETLBDAS
-REAL, INTENT(OUT) :: PALPHAH
-REAL, INTENT(OUT) :: PNUH
-REAL, INTENT(OUT) :: PALPHAS
-REAL, INTENT(OUT) :: PNUS
-REAL, INTENT(OUT) :: PEHS
-REAL, INTENT(OUT) :: PBS
-REAL, INTENT(OUT) :: PCH
-REAL, INTENT(OUT) :: PDH
-REAL, INTENT(OUT) :: PCS
-REAL, INTENT(OUT) :: PDS
-REAL, INTENT(OUT) :: PFVELOS
-REAL, INTENT(OUT) :: PWETLBDAH_MAX
-REAL, INTENT(OUT) :: PWETLBDAS_MAX
-REAL, INTENT(OUT) :: PWETLBDAH_MIN
-REAL, INTENT(OUT) :: PWETLBDAS_MIN
-REAL, INTENT(OUT) :: PFDINFTY
-REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL :: PKER_SWETH
-!
-END SUBROUTINE LIMA_READ_XKER_SWETH
-!
-END INTERFACE
-!
-END MODULE MODI_LIMA_READ_XKER_SWETH
+MODULE MODE_LIMA_READ_XKER_SWETH
+ IMPLICIT NONE
+CONTAINS
! ########################################################################
- SUBROUTINE LIMA_READ_XKER_SWETH (KWETLBDAH,KWETLBDAS,KND, &
- PALPHAH,PNUH,PALPHAS,PNUS,PEHS,PBS,PCH,PDH,PCS,PDS,PFVELOS, &
- PWETLBDAH_MAX,PWETLBDAS_MAX,PWETLBDAH_MIN,PWETLBDAS_MIN, &
- PFDINFTY,PKER_SWETH )
+ SUBROUTINE LIMA_READ_XKER_SWETH (KWETLBDAH,KWETLBDAS,KND, &
+ PALPHAH,PNUH,PALPHAS,PNUS,PEHS,PBS,PCH,PDH,PCS,PDS,PFVELOS, &
+ PWETLBDAH_MAX,PWETLBDAS_MAX,PWETLBDAH_MIN,PWETLBDAS_MIN, &
+ PFDINFTY,PKER_SWETH )
! ########################################################################
!
!!**** * * - initialize the kernels for the snow-hail wet growth process
@@ -3338,3 +3302,4 @@ PKER_SWETH( 40, 80) = 0.310319E+00
END IF
!
END SUBROUTINE LIMA_READ_XKER_SWETH
+END MODULE MODE_LIMA_READ_XKER_SWETH
diff --git a/src/PHYEX/micro/mode_lima_sedimentation.f90 b/src/PHYEX/micro/mode_lima_sedimentation.f90
index 23072bb81dab233cfbfdb920e0ee5b995c6a6848..dc6164d492aedbacd1aa7819285d9289d210e909 100644
--- a/src/PHYEX/micro/mode_lima_sedimentation.f90
+++ b/src/PHYEX/micro/mode_lima_sedimentation.f90
@@ -3,40 +3,13 @@
!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_SEDIMENTATION
-! ###################################
-!
-INTERFACE
- SUBROUTINE LIMA_SEDIMENTATION (KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKTB, KKTE, KKT, KKL, &
- HPHASE, KMOMENTS, KID, KSPLITG, PTSTEP, PDZZ, PRHODREF, &
- PPABST, PT, PRT_SUM, PCPT, PRS, PCS, PINPR )
-!
-INTEGER, INTENT(IN) :: KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKTB, KKTE, KKT, KKL
-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, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! Height (z)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Reference density
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! abs. pressure at time t
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PT ! Temperature
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRT_SUM ! total water mixing ratio
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCPT ! Cp
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRS ! m.r. source
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCS ! C. source
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPR ! Instant precip rate
-!
-END SUBROUTINE LIMA_SEDIMENTATION
-END INTERFACE
-END MODULE MODI_LIMA_SEDIMENTATION
-!
-!
+MODULE MODE_LIMA_SEDIMENTATION
+ IMPLICIT NONE
+CONTAINS
! ######################################################################
- SUBROUTINE LIMA_SEDIMENTATION (KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKTB, KKTE, KKT, KKL, &
- HPHASE, KMOMENTS, KID, KSPLITG, PTSTEP, PDZZ, PRHODREF, &
- PPABST, PT, PRT_SUM, PCPT, PRS, PCS, PINPR )
+ SUBROUTINE LIMA_SEDIMENTATION (D, CST, &
+ HPHASE, KMOMENTS, KID, KSPLITG, PTSTEP, PDZZ, PRHODREF, &
+ PPABST, PT, PRT_SUM, PCPT, PRS, PCS, PINPR, PFPR )
! ######################################################################
!
!! PURPOSE
@@ -72,7 +45,8 @@ END MODULE MODI_LIMA_SEDIMENTATION
!* 0. DECLARATIONS
! ------------
!
-USE MODD_CST, ONLY: XRHOLW, XCL, XCI, XPI
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+USE MODD_CST, ONLY: CST_t
USE MODD_PARAMETERS, ONLY: JPHEXT, JPVEXT
USE MODD_PARAM_LIMA, ONLY: XCEXVT, XRTMIN, XCTMIN, NSPLITSED, &
XLB, XLBEX, XD, XFSEDR, XFSEDC, &
@@ -89,7 +63,8 @@ IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
!
-INTEGER, INTENT(IN) :: KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKTB, KKTE, KKT, KKL
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+TYPE(CST_t), INTENT(IN) :: CST
CHARACTER(1), INTENT(IN) :: HPHASE ! Liquid or solid hydrometeors
INTEGER, INTENT(IN) :: KMOMENTS ! Number of moments
INTEGER, INTENT(IN) :: KID ! Hydrometeor ID
@@ -104,6 +79,7 @@ REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCPT ! Cp
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
!
!* 0.2 Declarations of local variables :
!
@@ -114,9 +90,10 @@ LOGICAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) &
:: GSEDIM ! Test where to compute the SED processes
REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) &
:: ZW, & ! Work array
- ZWSEDR, & ! Sedimentation of MMR
- ZWSEDC, & ! Sedimentation of number conc.
ZWDT ! Temperature change
+REAL, DIMENSION(D%NIT,D%NJT,0:D%NKT+1) &
+ :: ZWSEDR, & ! Sedimentation of MMR
+ ZWSEDC ! Sedimentation of number conc.
!
REAL, DIMENSION(:), ALLOCATABLE &
:: ZRS, & ! m.r. source
@@ -147,19 +124,21 @@ ZTSPLITG= PTSTEP / REAL(NSPLITSED(KID))
!
ZWDT=0.
PINPR(:,:) = 0.
+ZWSEDR(:,:,:) = 0.
+ZWSEDC(:,:,:) = 0.
!
PRS(:,:,:) = PRS(:,:,:) * PTSTEP
IF (KMOMENTS==2) PCS(:,:,:) = PCS(:,:,:) * PTSTEP
-DO JK = KKTB , KKTE
+DO JK = D%NKTB , D%NKTE
ZW(:,:,JK)=ZTSPLITG/PDZZ(:,:,JK)
END DO
!
-IF (HPHASE=='L') ZC=XCL
-IF (HPHASE=='I') ZC=XCI
+IF (HPHASE=='L') ZC=CST%XCL
+IF (HPHASE=='I') ZC=CST%XCI
!
IF (KID==4 .AND. ZMOMENTS==1) THEN
ZMOMENTS=2
- WHERE(PRS(:,:,:)>0) PCS(:,:,:)=1/(4*XPI*900.) * PRS(:,:,:) * &
+ WHERE(PRS(:,:,:)>0) PCS(:,:,:)=1/(4*CST%XPI*900.) * PRS(:,:,:) * &
MAX(0.05E6,-0.15319E6-0.021454E6*ALOG(PRHODREF(:,:,:)*PRS(:,:,:)))**3
END IF
!
@@ -170,7 +149,7 @@ END IF
DO JN = 1 , NSPLITSED(KID)
! Computation only where enough ice, snow, graupel or hail
GSEDIM(:,:,:) = .FALSE.
- GSEDIM(KIB:KIE,KJB:KJE,KKTB:KKTE) = PRS(KIB:KIE,KJB:KJE,KKTB:KKTE)>XRTMIN(KID)
+ 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)
ISEDIM = COUNTJV( GSEDIM(:,:,:),I1(:),I2(:),I3(:))
!
@@ -224,26 +203,29 @@ DO JN = 1 , NSPLITSED(KID)
ZZX(:) = ZCC(:) * ZZX(:)
END IF
- ZWSEDR(:,:,:) = UNPACK( ZZW(:),MASK=GSEDIM(:,:,:),FIELD=0.0 )
- ZWSEDR(:,:,KKTB:KKTE) = MIN( ZWSEDR(:,:,KKTB:KKTE), PRS(:,:,KKTB:KKTE) * PRHODREF(:,:,KKTB:KKTE) / ZW(:,:,KKTB:KKTE) )
+ 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) )
IF (KMOMENTS==2) THEN
- ZWSEDC(:,:,:) = UNPACK( ZZX(:),MASK=GSEDIM(:,:,:),FIELD=0.0 )
- ZWSEDC(:,:,KKTB:KKTE) = MIN( ZWSEDC(:,:,KKTB:KKTE), PCS(:,:,KKTB:KKTE) * PRHODREF(:,:,KKTB:KKTE) / ZW(:,:,KKTB:KKTE) )
+ 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) )
END IF
- DO JK = KKTB , KKTE
+ DO JK = D%NKTB , D%NKTE
PRS(:,:,JK) = PRS(:,:,JK) + ZW(:,:,JK)* &
- (ZWSEDR(:,:,JK+KKL)-ZWSEDR(:,:,JK))/PRHODREF(:,:,JK)
+ (ZWSEDR(:,:,JK+D%NKL)-ZWSEDR(:,:,JK))/PRHODREF(:,:,JK)
+ PFPR(:,:,JK) = ZWSEDR(:,:,JK)
IF (KMOMENTS==2) PCS(:,:,JK) = PCS(:,:,JK) + ZW(:,:,JK)* &
- (ZWSEDC(:,:,JK+KKL)-ZWSEDC(:,:,JK))/PRHODREF(:,:,JK)
+ (ZWSEDC(:,:,JK+D%NKL)-ZWSEDC(:,:,JK))/PRHODREF(:,:,JK)
! Heat transport
- !PRT_SUM(:,:,JK-KKL) = PRT_SUM(:,:,JK-KKL) + ZW(:,:,JK-KKL)*ZWSEDR(:,:,JK)/PRHODREF(:,:,JK-KKL)
+ !PRT_SUM(:,:,JK-D%NKL) = PRT_SUM(:,:,JK-D%NKL) + ZW(:,:,JK-D%NKL)*ZWSEDR(:,:,JK)/PRHODREF(:,:,JK-D%NKL)
!PRT_SUM(:,:,JK) = PRT_SUM(:,:,JK) - ZW(:,:,JK)*ZWSEDR(:,:,JK)/PRHODREF(:,:,JK)
- !PCPT(:,:,JK-KKL) = PCPT(:,:,JK-KKL) + ZC * (ZW(:,:,JK-KKL)*ZWSEDR(:,:,JK)/PRHODREF(:,:,JK-KKL))
+ !PCPT(:,:,JK-D%NKL) = PCPT(:,:,JK-D%NKL) + ZC * (ZW(:,:,JK-D%NKL)*ZWSEDR(:,:,JK)/PRHODREF(:,:,JK-D%NKL))
!PCPT(:,:,JK) = PCPT(:,:,JK) - ZC * (ZW(:,:,JK)*ZWSEDR(:,:,JK)/PRHODREF(:,:,JK))
- !ZWDT(:,:,JK) =(PRHODREF(:,:,JK+KKL)*(1.+PRT_SUM(:,:,JK))*PCPT(:,:,JK)*PT(:,:,JK) + &
- ! ZW(:,:,JK)*ZWSEDR(:,:,JK+1)*ZC*PT(:,:,JK+KKL)) / &
- ! (PRHODREF(:,:,JK+KKL)*(1.+PRT_SUM(:,:,JK))*PCPT(:,:,JK) + ZW(:,:,JK)*ZWSEDR(:,:,JK+KKL)*ZC)
+ !ZWDT(:,:,JK) =(PRHODREF(:,:,JK+D%NKL)*(1.+PRT_SUM(:,:,JK))*PCPT(:,:,JK)*PT(:,:,JK) + &
+ ! 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)
END DO
DEALLOCATE(ZRHODREF)
@@ -257,7 +239,7 @@ DO JN = 1 , NSPLITSED(KID)
DEALLOCATE(ZZX)
DEALLOCATE(ZZY)
!
- PINPR(:,:) = PINPR(:,:) + ZWSEDR(:,:,KKB)/XRHOLW/NSPLITSED(KID) ! in m/s
+ PINPR(:,:) = PINPR(:,:) + ZWSEDR(:,:,D%NKB)/CST%XRHOLW/NSPLITSED(KID) ! in m/s
!PT(:,:,:) = PT(:,:,:) + ZWDT(:,:,:)
END IF
@@ -267,5 +249,4 @@ PRS(:,:,:) = PRS(:,:,:) / PTSTEP
IF (KMOMENTS==2) PCS(:,:,:) = PCS(:,:,:) / PTSTEP
!
END SUBROUTINE LIMA_SEDIMENTATION
-!
-!-------------------------------------------------------------------------------
+END MODULE MODE_LIMA_SEDIMENTATION
diff --git a/src/PHYEX/micro/mode_lima_snow_deposition.f90 b/src/PHYEX/micro/mode_lima_snow_deposition.f90
index 3bd8d0141f23ef6c013ba7738e1da65518be4811..0a520c063aa1e96b4c6631a836ab3c4470b62023 100644
--- a/src/PHYEX/micro/mode_lima_snow_deposition.f90
+++ b/src/PHYEX/micro/mode_lima_snow_deposition.f90
@@ -3,45 +3,15 @@
!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_SNOW_DEPOSITION
-! #####################
-!
-INTERFACE
- SUBROUTINE LIMA_SNOW_DEPOSITION (LDCOMPUTE, &
- PRHODREF, PSSI, PAI, PCJ, PLSFACT, &
- PRST, PCST, PLBDS, &
- P_RI_CNVI, P_CI_CNVI, &
- P_TH_DEPS, P_RS_DEPS )
-!
-LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE
-!
-REAL, DIMENSION(:), INTENT(IN) :: PRHODREF! Reference density
-REAL, DIMENSION(:), INTENT(IN) :: PSSI ! abs. pressure at time t
-REAL, DIMENSION(:), INTENT(IN) :: PAI ! abs. pressure at time t
-REAL, DIMENSION(:), INTENT(IN) :: PCJ ! abs. pressure at time t
-REAL, DIMENSION(:), INTENT(IN) :: PLSFACT ! abs. pressure at time t
-!
-REAL, DIMENSION(:), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
-REAL, DIMENSION(:), INTENT(IN) :: PCST ! Snow/aggregate concentration
-!
-REAL, DIMENSION(:), INTENT(IN) :: PLBDS ! Graupel m.r. at t
-!
-REAL, DIMENSION(:), INTENT(OUT) :: P_RI_CNVI
-REAL, DIMENSION(:), INTENT(OUT) :: P_CI_CNVI
-REAL, DIMENSION(:), INTENT(OUT) :: P_TH_DEPS
-REAL, DIMENSION(:), INTENT(OUT) :: P_RS_DEPS
-!
-END SUBROUTINE LIMA_SNOW_DEPOSITION
-END INTERFACE
-END MODULE MODI_LIMA_SNOW_DEPOSITION
-!
+MODULE MODE_LIMA_SNOW_DEPOSITION
+ IMPLICIT NONE
+CONTAINS
! ##########################################################################
-SUBROUTINE LIMA_SNOW_DEPOSITION (LDCOMPUTE, &
- PRHODREF, PSSI, PAI, PCJ, PLSFACT, &
- PRST, PCST, PLBDS, &
- P_RI_CNVI, P_CI_CNVI, &
- P_TH_DEPS, P_RS_DEPS )
+ SUBROUTINE LIMA_SNOW_DEPOSITION (LDCOMPUTE, &
+ PRHODREF, PSSI, PAI, PCJ, PLSFACT, &
+ PRST, PCST, PLBDS, &
+ P_RI_CNVI, P_CI_CNVI, &
+ P_TH_DEPS, P_RS_DEPS )
! ##########################################################################
!
!! PURPOSE
@@ -177,3 +147,4 @@ ELSE
END IF
!
END SUBROUTINE LIMA_SNOW_DEPOSITION
+END MODULE MODE_LIMA_SNOW_DEPOSITION
diff --git a/src/PHYEX/micro/mode_lima_snow_self_collection.f90 b/src/PHYEX/micro/mode_lima_snow_self_collection.f90
index ea38870b87d715c9d5d556b1ea1d9353c44bf41e..50339a87f9cfab882ee4e4ea81fea509d1aebfd2 100644
--- a/src/PHYEX/micro/mode_lima_snow_self_collection.f90
+++ b/src/PHYEX/micro/mode_lima_snow_self_collection.f90
@@ -3,36 +3,14 @@
!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_SNOW_SELF_COLLECTION
-! #################################
-!
-INTERFACE
- SUBROUTINE LIMA_SNOW_SELF_COLLECTION (LDCOMPUTE, &
- PRHODREF, PT, &
- PRST, PCST, PLBDS, &
- P_CS_SSC )
-!
-LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE
-!
-REAL, DIMENSION(:), INTENT(IN) :: PRHODREF ! Reference Exner function
-REAL, DIMENSION(:), INTENT(IN) :: PT ! Temperature
-!
-REAL, DIMENSION(:), INTENT(IN) :: PRST ! Snow mr at t
-REAL, DIMENSION(:), INTENT(IN) :: PCST ! Snow C. at t
-REAL, DIMENSION(:), INTENT(IN) :: PLBDS !
-!
-REAL, DIMENSION(:), INTENT(OUT) :: P_CS_SSC
-!
-END SUBROUTINE LIMA_SNOW_SELF_COLLECTION
-END INTERFACE
-END MODULE MODI_LIMA_SNOW_SELF_COLLECTION
-!
+MODULE MODE_LIMA_SNOW_SELF_COLLECTION
+ IMPLICIT NONE
+CONTAINS
! #############################################################
- SUBROUTINE LIMA_SNOW_SELF_COLLECTION (LDCOMPUTE, &
- PRHODREF, PT, &
- PRST, PCST, PLBDS, &
- P_CS_SSC )
+ SUBROUTINE LIMA_SNOW_SELF_COLLECTION (LDCOMPUTE, &
+ PRHODREF, PT, &
+ PRST, PCST, PLBDS, &
+ P_CS_SSC )
! #############################################################
!
!! PURPOSE
@@ -147,3 +125,4 @@ END IF
!-------------------------------------------------------------------------------
!
END SUBROUTINE LIMA_SNOW_SELF_COLLECTION
+END MODULE MODE_LIMA_SNOW_SELF_COLLECTION
diff --git a/src/PHYEX/micro/mode_lima_tendencies.f90 b/src/PHYEX/micro/mode_lima_tendencies.f90
index d8c8d18d9c1ee8371d6c0ef6274f5af50d85ac3d..d25250bcc03b6020789d727a7b4d915fce8ef20c 100644
--- a/src/PHYEX/micro/mode_lima_tendencies.f90
+++ b/src/PHYEX/micro/mode_lima_tendencies.f90
@@ -3,273 +3,50 @@
!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_TENDENCIES
-!###############################
- INTERFACE
- SUBROUTINE LIMA_TENDENCIES (PTSTEP, LDCOMPUTE, &
- PEXNREF, PRHODREF, PPABST, PTHT, &
- PRVT, PRCT, PRRT, PRIT, PRST, PRGT, PRHT, &
- PCCT, PCRT, PCIT, PCST, PCGT, PCHT, &
- P_TH_HONC, P_RC_HONC, P_CC_HONC, &
- P_CC_SELF, &
- P_RC_AUTO, P_CC_AUTO, P_CR_AUTO, &
- P_RC_ACCR, P_CC_ACCR, &
- P_CR_SCBU, &
- P_TH_EVAP, P_RR_EVAP, P_CR_EVAP, &
- P_RI_CNVI, P_CI_CNVI, &
- P_TH_DEPS, P_RS_DEPS, &
- P_TH_DEPI, P_RI_DEPI, &
- P_RI_CNVS, P_CI_CNVS, &
- P_CS_SSC, &
- 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, &
- 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_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, &
- P_RI_RDSF, P_CI_RDSF, &
- P_TH_WETG, P_RC_WETG, P_CC_WETG, P_RR_WETG, P_CR_WETG, &
- P_RI_WETG, P_CI_WETG, P_RS_WETG, P_CS_WETG, P_RG_WETG, P_CG_WETG, P_RH_WETG, &
- P_TH_DRYG, P_RC_DRYG, P_CC_DRYG, P_RR_DRYG, P_CR_DRYG, &
- P_RI_DRYG, P_CI_DRYG, P_RS_DRYG, P_CS_DRYG, P_RG_DRYG, &
- P_RI_HMG, P_CI_HMG, P_RG_HMG, &
- P_TH_GMLT, P_RR_GMLT, P_CR_GMLT, P_CG_GMLT, &
- P_TH_DEPH, P_RH_DEPH, &
- P_TH_WETH, P_RC_WETH, P_CC_WETH, P_RR_WETH, P_CR_WETH, &
- P_RI_WETH, P_CI_WETH, P_RS_WETH, P_CS_WETH, P_RG_WETH, P_CG_WETH, P_RH_WETH, &
- P_RG_COHG, P_CG_COHG, &
- P_TH_HMLT, P_RR_HMLT, P_CR_HMLT, P_CH_HMLT, &
- 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 )
-!
-REAL, INTENT(IN) :: PTSTEP
-LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE
-!
-REAL, DIMENSION(:), INTENT(IN) :: PEXNREF !
-REAL, DIMENSION(:), INTENT(IN) :: PRHODREF !
-REAL, DIMENSION(:), INTENT(IN) :: PPABST ! Pressure
-REAL, DIMENSION(:), INTENT(IN) :: PTHT ! Potential temperature
-!
-REAL, DIMENSION(:), INTENT(IN) :: PRVT !
-REAL, DIMENSION(:), INTENT(IN) :: PRCT !
-REAL, DIMENSION(:), INTENT(IN) :: PRRT !
-REAL, DIMENSION(:), INTENT(IN) :: PRIT !
-REAL, DIMENSION(:), INTENT(IN) :: PRST !
-REAL, DIMENSION(:), INTENT(IN) :: PRGT !
-REAL, DIMENSION(:), INTENT(IN) :: PRHT ! Mixing ratios (kg/kg)
-!
-REAL, DIMENSION(:), INTENT(IN) :: PCCT !
-REAL, DIMENSION(:), INTENT(IN) :: PCRT !
-REAL, DIMENSION(:), INTENT(IN) :: PCIT !
-REAL, DIMENSION(:), INTENT(IN) :: PCST !
-REAL, DIMENSION(:), INTENT(IN) :: PCGT !
-REAL, DIMENSION(:), INTENT(IN) :: PCHT ! Number concentrations (/kg)
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_HONC
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RC_HONC
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CC_HONC ! droplets homogeneous freezing (HONC) : rc, Nc, ri=-rc, Ni=-Nc, th
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CC_SELF ! self collection of droplets (SELF) : Nc
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RC_AUTO
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CC_AUTO
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CR_AUTO ! autoconversion of cloud droplets (AUTO) : rc, Nc, rr=-rc, Nr
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RC_ACCR
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CC_ACCR ! accretion of droplets by rain drops (ACCR) : rc, Nc, rr=-rr
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CR_SCBU ! self collectio break up of drops (SCBU) : Nr
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_EVAP
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RR_EVAP
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CR_EVAP ! evaporation of rain drops (EVAP) : rr, Nr, rv=-rr
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RI_CNVI
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CI_CNVI ! conversion snow -> ice (CNVI) : ri, Ni, rs=-ri
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_DEPS
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RS_DEPS ! deposition of vapor on snow (DEPS) : rv=-rs, rs, th
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_DEPI
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RI_DEPI ! deposition of vapor on ice (DEPI) : rv=-ri, ri, th
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RI_CNVS
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CI_CNVS ! conversion ice -> snow (CNVS) : ri, Ni, rs=-ri
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CS_SSC ! self collection of snow (SSC) : Ns
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RI_AGGS
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CI_AGGS ! aggregation of ice on snow (AGGS) : ri, Ni, rs=-ri
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_DEPG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RG_DEPG ! deposition of vapor on graupel (DEPG) : rv=-rg, rg, th
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_BERFI
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RC_BERFI ! Bergeron (BERFI) : rc, ri=-rc, th
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_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_CS_RIM
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RG_RIM ! cloud droplet riming (RIM) : rc, Nc, rs, Ns, rg, Ng=-Ns, th
-!
-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
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_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_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_RS_CMEL
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CS_CMEL ! conversion-melting (CMEL) : rs, Ns, rg=-rs, Ng=-Ns
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_CFRZ
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RR_CFRZ
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CR_CFRZ
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RI_CFRZ
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CI_CFRZ ! rain freezing (CFRZ) : rr, Nr, ri, Ni, rg=-rr-ri, th
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RI_CIBU
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CI_CIBU ! collisional ice break-up (CIBU) : ri, Ni, rs=-ri
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RI_RDSF
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CI_RDSF ! rain drops freezing shattering (RDSF) : ri, Ni, rg=-ri
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_WETG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RC_WETG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CC_WETG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RR_WETG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CR_WETG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RI_WETG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CI_WETG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RS_WETG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CS_WETG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RG_WETG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CG_WETG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RH_WETG ! wet growth of graupel (WETG) : rc, NC, rr, Nr, ri, Ni, rs, Ns, rg, Ng, rh, Nh=-Ng, th
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_DRYG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RC_DRYG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CC_DRYG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RR_DRYG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CR_DRYG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RI_DRYG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CI_DRYG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RS_DRYG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CS_DRYG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RG_DRYG ! dry growth of graupel (DRYG) : rc, Nc, rr, Nr, ri, Ni, rs, Ns, rg, th
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RI_HMG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CI_HMG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RG_HMG ! hallett mossop graupel (HMG) : ri, Ni, rg
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_GMLT
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RR_GMLT
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CR_GMLT
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CG_GMLT ! graupel melting (GMLT) : rr, Nr, rg=-rr, Ng, th
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_DEPH
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RH_DEPH ! deposition of vapor on hail (DEPH) : rv=-rh, rh, th
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_WETH
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RC_WETH
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CC_WETH
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RR_WETH
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CR_WETH
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RI_WETH
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CI_WETH
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RS_WETH
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CS_WETH
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RG_WETH
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CG_WETH
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RH_WETH ! wet growth of hail (WETH) : rc, NC, rr, Nr, ri, Ni, rs, Ns, rg, Ng, rh, th
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RG_COHG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CG_COHG ! conversion hail -> graupel (COHG) : rg, Ng, rh=-rg; Nh=-Ng
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_HMLT
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RR_HMLT
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CR_HMLT
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CH_HMLT ! hail melting (HMLT) : rr, Nr, rh=-rr, Nh, th
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_TH
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RV
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RC
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_CC
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RR
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_CR
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RI
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_CI
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RS
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_CS
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RG
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_CG
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RH
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_CH
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: PEVAP3D
-!
-REAL, DIMENSION(:), INTENT(IN) :: PCF1D
-REAL, DIMENSION(:), INTENT(IN) :: PIF1D
-REAL, DIMENSION(:), INTENT(IN) :: PPF1D
-!
- END SUBROUTINE LIMA_TENDENCIES
- END INTERFACE
-END MODULE MODI_LIMA_TENDENCIES
-!#####################################################################
-!
+MODULE MODE_LIMA_TENDENCIES
+ IMPLICIT NONE
+CONTAINS
!#####################################################################
-SUBROUTINE LIMA_TENDENCIES (PTSTEP, LDCOMPUTE, &
- PEXNREF, PRHODREF, PPABST, PTHT, &
- PRVT, PRCT, PRRT, PRIT, PRST, PRGT, PRHT, &
- PCCT, PCRT, PCIT, PCST, PCGT, PCHT, &
- P_TH_HONC, P_RC_HONC, P_CC_HONC, &
- P_CC_SELF, &
- P_RC_AUTO, P_CC_AUTO, P_CR_AUTO, &
- P_RC_ACCR, P_CC_ACCR, &
- P_CR_SCBU, &
- P_TH_EVAP, P_RR_EVAP, P_CR_EVAP, &
- P_RI_CNVI, P_CI_CNVI, &
- P_TH_DEPS, P_RS_DEPS, &
- P_TH_DEPI, P_RI_DEPI, &
- P_RI_CNVS, P_CI_CNVS, &
- P_CS_SSC, &
- 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, &
- 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_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, &
- P_RI_RDSF, P_CI_RDSF, &
- P_TH_WETG, P_RC_WETG, P_CC_WETG, P_RR_WETG, P_CR_WETG, &
- P_RI_WETG, P_CI_WETG, P_RS_WETG, P_CS_WETG, P_RG_WETG, P_CG_WETG, P_RH_WETG, &
- P_TH_DRYG, P_RC_DRYG, P_CC_DRYG, P_RR_DRYG, P_CR_DRYG, &
- P_RI_DRYG, P_CI_DRYG, P_RS_DRYG, P_CS_DRYG, P_RG_DRYG, &
- P_RI_HMG, P_CI_HMG, P_RG_HMG, &
- P_TH_GMLT, P_RR_GMLT, P_CR_GMLT, P_CG_GMLT, &
- P_TH_DEPH, P_RH_DEPH, &
- P_TH_WETH, P_RC_WETH, P_CC_WETH, P_RR_WETH, P_CR_WETH, &
- P_RI_WETH, P_CI_WETH, P_RS_WETH, P_CS_WETH, P_RG_WETH, P_CG_WETH, P_RH_WETH, &
- P_RG_COHG, P_CG_COHG, &
- P_TH_HMLT, P_RR_HMLT, P_CR_HMLT, P_CH_HMLT, &
- 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 )
+ SUBROUTINE LIMA_TENDENCIES (PTSTEP, LDCOMPUTE, &
+ PEXNREF, PRHODREF, PPABST, PTHT, &
+ PRVT, PRCT, PRRT, PRIT, PRST, PRGT, PRHT, &
+ PCCT, PCRT, PCIT, PCST, PCGT, PCHT, &
+ P_TH_HONC, P_RC_HONC, P_CC_HONC, &
+ P_CC_SELF, &
+ P_RC_AUTO, P_CC_AUTO, P_CR_AUTO, &
+ P_RC_ACCR, P_CC_ACCR, &
+ P_CR_SCBU, &
+ P_TH_EVAP, P_RR_EVAP, P_CR_EVAP, &
+ P_RI_CNVI, P_CI_CNVI, &
+ P_TH_DEPS, P_RS_DEPS, &
+ P_TH_DEPI, P_RI_DEPI, &
+ P_RI_CNVS, P_CI_CNVS, &
+ P_CS_SSC, &
+ 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, &
+ 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_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, &
+ P_RI_RDSF, P_CI_RDSF, &
+ P_TH_WETG, P_RC_WETG, P_CC_WETG, P_RR_WETG, P_CR_WETG, &
+ P_RI_WETG, P_CI_WETG, P_RS_WETG, P_CS_WETG, P_RG_WETG, P_CG_WETG, P_RH_WETG, &
+ P_TH_DRYG, P_RC_DRYG, P_CC_DRYG, P_RR_DRYG, P_CR_DRYG, &
+ P_RI_DRYG, P_CI_DRYG, P_RS_DRYG, P_CS_DRYG, P_RG_DRYG, &
+ P_RI_HMG, P_CI_HMG, P_RG_HMG, &
+ P_TH_GMLT, P_RR_GMLT, P_CR_GMLT, P_CG_GMLT, &
+ P_TH_DEPH, P_RH_DEPH, &
+ P_TH_WETH, P_RC_WETH, P_CC_WETH, P_RR_WETH, P_CR_WETH, &
+ P_RI_WETH, P_CI_WETH, P_RS_WETH, P_CS_WETH, P_RG_WETH, P_CG_WETH, P_RH_WETH, &
+ P_RG_COHG, P_CG_COHG, &
+ P_TH_HMLT, P_RR_HMLT, P_CR_HMLT, P_CH_HMLT, &
+ 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 )
! ######################################################################
!!
!! PURPOSE
@@ -296,35 +73,35 @@ SUBROUTINE LIMA_TENDENCIES (PTSTEP, LDCOMPUTE,
USE MODD_CST, ONLY : XP00, XRD, XRV, XMD, XMV, XCPD, XCPV, XCL, XCI, XLVTT, XLSTT, XTT, &
XALPW, XBETAW, XGAMW, XALPI, XBETAI, XGAMI
USE MODD_PARAM_LIMA, ONLY : XRTMIN, XCTMIN, XNUS, LCIBU, LRDSF, &
- LCOLD, LNUCL, LSNOW, LHAIL, LWARM, LACTI, LRAIN, LKHKO, LSNOW_T, &
+ LNUCL, LACTI, LKHKO, LSNOW_T, &
NMOM_C, NMOM_R, NMOM_I, NMOM_S, NMOM_G, NMOM_H
USE MODD_PARAM_LIMA_WARM, ONLY : XLBC, XLBEXC, XLBR, XLBEXR, XCCR, XCXR
USE MODD_PARAM_LIMA_MIXED, ONLY : XLBG, XLBEXG, XCCG, XCXG, XLBH, XLBEXH, XCCH, XCXH, XLBDAG_MAX
USE MODD_PARAM_LIMA_COLD, ONLY : XSCFAC, XLBI, XLBEXI, XLBS, XLBEXS, XLBDAS_MAX, XTRANS_MP_GAMMAS, &
XFVELOS, XLBDAS_MIN, XCCS, XCXS, XBS, XNS
!
-USE MODI_LIMA_DROPLETS_HOM_FREEZING
-USE MODI_LIMA_DROPLETS_SELF_COLLECTION
-USE MODI_LIMA_DROPLETS_AUTOCONVERSION
-USE MODI_LIMA_DROPLETS_ACCRETION
-USE MODI_LIMA_DROPS_SELF_COLLECTION
-USE MODI_LIMA_RAIN_EVAPORATION
-USE MODI_LIMA_ICE_DEPOSITION
-USE MODI_LIMA_SNOW_DEPOSITION
-USE MODI_LIMA_SNOW_SELF_COLLECTION
-USE MODI_LIMA_ICE_AGGREGATION_SNOW
-USE MODI_LIMA_GRAUPEL_DEPOSITION
-USE MODI_LIMA_DROPLETS_RIMING_SNOW
-USE MODI_LIMA_RAIN_ACCR_SNOW
-USE MODI_LIMA_CONVERSION_MELTING_SNOW
-USE MODI_LIMA_RAIN_FREEZING
-USE MODI_LIMA_COLLISIONAL_ICE_BREAKUP
-USE MODI_LIMA_RAINDROP_SHATTERING_FREEZING
-USE MODI_LIMA_GRAUPEL
-USE MODI_LIMA_HAIL_DEPOSITION
-USE MODI_LIMA_HAIL
-!
-USE MODI_LIMA_BERGERON
+USE MODE_LIMA_DROPLETS_HOM_FREEZING, ONLY: LIMA_DROPLETS_HOM_FREEZING
+USE MODE_LIMA_DROPLETS_SELF_COLLECTION, ONLY: LIMA_DROPLETS_SELF_COLLECTION
+USE MODE_LIMA_DROPLETS_AUTOCONVERSION, ONLY: LIMA_DROPLETS_AUTOCONVERSION
+USE MODE_LIMA_DROPLETS_ACCRETION, ONLY: LIMA_DROPLETS_ACCRETION
+USE MODE_LIMA_DROPS_SELF_COLLECTION, ONLY: LIMA_DROPS_SELF_COLLECTION
+USE MODE_LIMA_RAIN_EVAPORATION, ONLY: LIMA_RAIN_EVAPORATION
+USE MODE_LIMA_ICE_DEPOSITION, ONLY: LIMA_ICE_DEPOSITION
+USE MODE_LIMA_SNOW_DEPOSITION, ONLY: LIMA_SNOW_DEPOSITION
+USE MODE_LIMA_SNOW_SELF_COLLECTION, ONLY: LIMA_SNOW_SELF_COLLECTION
+USE MODE_LIMA_ICE_AGGREGATION_SNOW, ONLY: LIMA_ICE_AGGREGATION_SNOW
+USE MODE_LIMA_GRAUPEL_DEPOSITION, ONLY: LIMA_GRAUPEL_DEPOSITION
+USE MODE_LIMA_DROPLETS_RIMING_SNOW, ONLY: LIMA_DROPLETS_RIMING_SNOW
+USE MODE_LIMA_RAIN_ACCR_SNOW, ONLY: LIMA_RAIN_ACCR_SNOW
+USE MODE_LIMA_CONVERSION_MELTING_SNOW, ONLY: LIMA_CONVERSION_MELTING_SNOW
+USE MODE_LIMA_RAIN_FREEZING, ONLY: LIMA_RAIN_FREEZING
+USE MODE_LIMA_COLLISIONAL_ICE_BREAKUP, ONLY: LIMA_COLLISIONAL_ICE_BREAKUP
+USE MODE_LIMA_RAINDROP_SHATTERING_FREEZING, ONLY: LIMA_RAINDROP_SHATTERING_FREEZING
+USE MODE_LIMA_GRAUPEL, ONLY: LIMA_GRAUPEL
+USE MODE_LIMA_HAIL_DEPOSITION, ONLY: LIMA_HAIL_DEPOSITION
+USE MODE_LIMA_HAIL, ONLY: LIMA_HAIL
+!
+USE MODE_LIMA_BERGERON, ONLY: LIMA_BERGERON
!
IMPLICIT NONE
!
@@ -722,7 +499,7 @@ END IF
!-------------------------------------------------------------------------------
! Call microphysical processes
!
-IF (LCOLD .AND. LWARM) THEN
+IF (NMOM_C.GE.1 .AND. NMOM_I.GE.1) THEN
CALL LIMA_DROPLETS_HOM_FREEZING (PTSTEP, LDCOMPUTE, & ! independent from CF,IF,PF
ZT, ZLVFACT, ZLSFACT, &
ZRCT, PCCT, ZLBDC, &
@@ -735,7 +512,7 @@ IF (LCOLD .AND. LWARM) THEN
PA_TH(:) = PA_TH(:) + P_TH_HONC(:)
END IF
!
-IF (LWARM .AND. LRAIN .AND. (.NOT. LKHKO) .AND. NMOM_C.GE.2) THEN
+IF ((.NOT. LKHKO) .AND. NMOM_C.GE.2) THEN
CALL LIMA_DROPLETS_SELF_COLLECTION (LDCOMPUTE, & ! depends on CF
PRHODREF, &
PCCT/ZCF1D, ZLBDC3, &
@@ -744,7 +521,7 @@ IF (LWARM .AND. LRAIN .AND. (.NOT. LKHKO) .AND. NMOM_C.GE.2) THEN
PA_CC(:) = PA_CC(:) + P_CC_SELF(:)
END IF
!
-IF (LWARM .AND. LRAIN) THEN
+IF (NMOM_C.GE.1 .AND. NMOM_R.GE.1) THEN
CALL LIMA_DROPLETS_AUTOCONVERSION (LDCOMPUTE, & ! depends on CF
PRHODREF, &
ZRCT/ZCF1D, PCCT/ZCF1D, ZLBDC, ZLBDR, &
@@ -759,7 +536,7 @@ IF (LWARM .AND. LRAIN) THEN
IF (NMOM_R.GE.2) PA_CR(:) = PA_CR(:) + P_CR_AUTO(:)
END IF
!
-IF (LWARM .AND. LRAIN) THEN
+IF (NMOM_C.GE.1 .AND. NMOM_R.GE.1) THEN
CALL LIMA_DROPLETS_ACCRETION (LDCOMPUTE, & ! depends on CF, PF
PRHODREF, &
ZRCT/ZCF1D, ZRRT/ZPF1D, PCCT/ZCF1D, PCRT/ZPF1D,&
@@ -774,7 +551,7 @@ IF (LWARM .AND. LRAIN) THEN
PA_RR(:) = PA_RR(:) - P_RC_ACCR(:)
END IF
!
-IF (LWARM .AND. LRAIN .AND. (.NOT. LKHKO) .AND. NMOM_R.GE.2) THEN
+IF ((.NOT. LKHKO) .AND. NMOM_R.GE.2) THEN
CALL LIMA_DROPS_SELF_COLLECTION (LDCOMPUTE, & ! depends on PF
PRHODREF, &
PCRT/ZPF1D(:), ZLBDR, ZLBDR3, &
@@ -785,7 +562,7 @@ IF (LWARM .AND. LRAIN .AND. (.NOT. LKHKO) .AND. NMOM_R.GE.2) THEN
PA_CR(:) = PA_CR(:) + P_CR_SCBU(:)
END IF
!
-IF (LWARM .AND. LRAIN) THEN
+IF (NMOM_R.GE.2) 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, &
@@ -802,7 +579,7 @@ IF (LWARM .AND. LRAIN) THEN
IF (NMOM_R.GE.2) PA_CR(:) = PA_CR(:) + P_CR_EVAP(:)
END IF
!
-IF (LCOLD) THEN
+IF (NMOM_I.GE.1) THEN
!
! Includes vapour deposition on ice, ice -> snow conversion
!
@@ -826,7 +603,7 @@ IF (LCOLD) THEN
END IF
!
-IF (LCOLD .AND. LSNOW) THEN
+IF (NMOM_S.GE.1) THEN
!
! Includes vapour deposition on snow, snow -> ice conversion
!
@@ -850,7 +627,7 @@ IF (LCOLD .AND. LSNOW) THEN
END IF
!
-IF (LSNOW .AND. NMOM_S.GE.2) THEN
+IF (NMOM_S.GE.2) THEN
CALL LIMA_SNOW_SELF_COLLECTION (LDCOMPUTE, & ! depends on PF
PRHODREF, &
ZRST(:)/ZPF1D(:), PCST/ZPF1D(:), ZLBDS, ZLBDS3, &
@@ -867,7 +644,7 @@ END IF
!ZLBDS(:) = MIN( XLBDAS_MAX, ZLBDS(:))
!
!
-IF (LCOLD .AND. LSNOW) THEN
+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, &
@@ -880,7 +657,7 @@ IF (LCOLD .AND. LSNOW) THEN
PA_RS(:) = PA_RS(:) - P_RI_AGGS(:)
END IF
!
-IF (LWARM .AND. LCOLD) THEN
+IF (NMOM_G.GE.1) THEN
CALL LIMA_GRAUPEL_DEPOSITION (LDCOMPUTE, PRHODREF, & ! depends on PF ?
ZRGT/ZPF1D, PCGT/ZPF1D, ZSSI, ZLBDG, ZAI, ZCJ, ZLSFACT, &
P_TH_DEPG, P_RG_DEPG )
@@ -892,7 +669,7 @@ IF (LWARM .AND. LCOLD) THEN
PA_TH(:) = PA_TH(:) + P_TH_DEPG(:)
END IF
!
-IF (LWARM .AND. LCOLD .AND. NMOM_I.EQ.1) THEN
+IF (NMOM_C.GE.1 .AND. NMOM_I.EQ.1) THEN
CALL LIMA_BERGERON (LDCOMPUTE, & ! depends on CF, IF
ZRCT/ZCF1D, ZRIT/ZIF1D, PCIT/ZIF1D, ZLBDI, &
ZSSIW, ZAI, ZCJ, ZLVFACT, ZLSFACT, &
@@ -905,7 +682,7 @@ IF (LWARM .AND. LCOLD .AND. NMOM_I.EQ.1) THEN
PA_TH(:) = PA_TH(:) + P_TH_BERFI(:)
END IF
!
-IF (LWARM .AND. LCOLD .AND. LSNOW) THEN
+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)
@@ -937,7 +714,7 @@ IF (LWARM .AND. LCOLD .AND. LSNOW) THEN
END IF
!
-IF (LWARM .AND. LRAIN .AND. LCOLD .AND. LSNOW) THEN
+IF (NMOM_R.GE.1 .AND. NMOM_S.GE.1) THEN
CALL LIMA_RAIN_ACCR_SNOW (PTSTEP, LDCOMPUTE, & ! depends on PF
PRHODREF, ZT, &
ZRRT/ZPF1D, PCRT/ZPF1D, ZRST/ZPF1D, PCST/ZPF1D, ZLBDR, ZLBDS, ZLVFACT, ZLSFACT, &
@@ -959,7 +736,7 @@ IF (LWARM .AND. LRAIN .AND. LCOLD .AND. LSNOW) THEN
END IF
!
-IF (LWARM .AND. LCOLD .AND. LSNOW) THEN
+IF (NMOM_S.GE.1) THEN
!
! Conversion melting of snow should account for collected droplets and drops where T>0C, but does not !
! Some thermodynamical computations inside, to externalize ?
@@ -978,7 +755,7 @@ IF (LWARM .AND. LCOLD .AND. LSNOW) THEN
END IF
!
-IF (LWARM .AND. LRAIN .AND. LCOLD ) THEN
+IF (NMOM_R.GE.1) THEN
CALL LIMA_RAIN_FREEZING (LDCOMPUTE, & ! depends on PF, IF
PRHODREF, ZT, ZLVFACT, ZLSFACT, &
ZRRT/ZPF1D, PCRT/ZPF1D, ZRIT/ZIF1D, PCIT/ZIF1D, ZLBDR, &
@@ -999,7 +776,7 @@ IF (LWARM .AND. LRAIN .AND. LCOLD ) THEN
END IF
!
-IF (LWARM .AND. LCOLD .AND. LSNOW .AND. LCIBU) THEN
+IF (NMOM_S.GE.1 .AND. NMOM_G.GE.1 .AND. LCIBU) THEN
!
! Conversion melting of snow should account for collected droplets and drops where T>0C, but does not !
! Some thermodynamical computations inside, to externalize ?
@@ -1018,7 +795,7 @@ IF (LWARM .AND. LCOLD .AND. LSNOW .AND. LCIBU) THEN
END IF
!
-IF (LWARM .AND. LRAIN .AND. LCOLD .AND. LSNOW .AND. LRDSF) THEN
+IF (NMOM_R.GE.1 .AND. NMOM_I.GE.1 .AND. LRDSF) THEN
!
! Conversion melting of snow should account for collected droplets and drops where T>0C, but does not !
! Some thermodynamical computations inside, to externalize ?
@@ -1037,7 +814,7 @@ IF (LWARM .AND. LRAIN .AND. LCOLD .AND. LSNOW .AND. LRDSF) THEN
END IF
!
-IF (LWARM .AND. LCOLD) THEN
+IF (NMOM_G.GE.1) THEN
!
! Melting of graupel should account for collected droplets and drops where T>0C, but does not !
! Collection and water shedding should also happen where T>0C, but do not !
@@ -1061,7 +838,7 @@ IF (LWARM .AND. LCOLD) THEN
PA_RI, PA_CI, PA_RS, PA_CS, PA_RG, PA_CG, PA_RH, PA_CH )
END IF
!
-IF (LWARM .AND. LCOLD .AND. LHAIL) THEN
+IF (NMOM_H.GE.1) THEN
CALL LIMA_HAIL_DEPOSITION (LDCOMPUTE, PRHODREF, & ! depends on PF ?
ZRHT/ZPF1D, PCHT/ZPF1D, ZSSI, ZLBDH, ZAI, ZCJ, ZLSFACT, &
P_TH_DEPH, P_RH_DEPH )
@@ -1087,3 +864,4 @@ IF (LWARM .AND. LCOLD .AND. LHAIL) THEN
END IF
!
END SUBROUTINE LIMA_TENDENCIES
+END MODULE MODE_LIMA_TENDENCIES
diff --git a/src/PHYEX/micro/mode_nrcolss.f90 b/src/PHYEX/micro/mode_nrcolss.f90
index d21be2bd3b12000a5c5871c47e9ba5faa22d84f5..3da87d0a49abb048b03c968b8334228ac906dd62 100644
--- a/src/PHYEX/micro/mode_nrcolss.f90
+++ b/src/PHYEX/micro/mode_nrcolss.f90
@@ -3,60 +3,14 @@
!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
+MODULE MODE_NRCOLSS
+ IMPLICIT NONE
+CONTAINS
! ########################################################################
- SUBROUTINE NRCOLSS( KND, PALPHAS, PNUS, PALPHAR, PNUR, &
- PESR, PFALLS, PEXFALLS, PFALLEXPS, PFALLR, PEXFALLR,&
- PLBDASMAX, PLBDARMAX, PLBDASMIN, PLBDARMIN, &
- PDINFTY, PNRCOLSS, PAG, PBS, PAS )
+ SUBROUTINE NRCOLSS( KND, PALPHAS, PNUS, PALPHAR, PNUR, &
+ PESR, PFALLS, PEXFALLS, PFALLEXPS, PFALLR, PEXFALLR,&
+ PLBDASMAX, PLBDARMAX, PLBDASMIN, PLBDARMIN, &
+ PDINFTY, PNRCOLSS, PAG, PBS, PAS )
! ########################################################################
!
!
@@ -314,3 +268,4 @@ DO JLBDAS = 1,SIZE(PNRCOLSS(:,:),1)
END DO
!
END SUBROUTINE NRCOLSS
+END MODULE MODE_NRCOLSS
diff --git a/src/PHYEX/micro/mode_nscolrg.f90 b/src/PHYEX/micro/mode_nscolrg.f90
index 790a01f76a32fef7603ff99d7ad1339a657fbb80..593d838d6951769c140653ea40fecdaac2352948 100644
--- a/src/PHYEX/micro/mode_nscolrg.f90
+++ b/src/PHYEX/micro/mode_nscolrg.f90
@@ -3,60 +3,14 @@
!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
+MODULE MODE_NSCOLRG
+ IMPLICIT NONE
+CONTAINS
! ########################################################################
- SUBROUTINE NSCOLRG( KND, PALPHAS, PZNUS, PALPHAR, PNUR, &
- PESR, PFALLS, PEXFALLS, PFALLEXPS, PFALLR, PEXFALLR,&
- PLBDASMAX, PLBDARMAX, PLBDASMIN, PLBDARMIN, &
- PDINFTY, PNSCOLRG,PAG, PBS, PAS )
+ SUBROUTINE NSCOLRG( KND, PALPHAS, PZNUS, PALPHAR, PNUR, &
+ PESR, PFALLS, PEXFALLS, PFALLEXPS, PFALLR, PEXFALLR,&
+ PLBDASMAX, PLBDARMAX, PLBDASMIN, PLBDARMIN, &
+ PDINFTY, PNSCOLRG,PAG, PBS, PAS )
! ########################################################################
!
!
@@ -315,3 +269,4 @@ DO JLBDAR = 1,SIZE(PNSCOLRG(:,:),1)
END DO
!
END SUBROUTINE NSCOLRG
+END MODULE MODE_NSCOLRG
diff --git a/src/PHYEX/micro/mode_nzcolx.f90 b/src/PHYEX/micro/mode_nzcolx.f90
index e4493c2e60f617e81998e2466d534e887891feaf..5a3932bf461543d85ba4226d0c1d02531cd242fe 100644
--- a/src/PHYEX/micro/mode_nzcolx.f90
+++ b/src/PHYEX/micro/mode_nzcolx.f90
@@ -3,62 +3,15 @@
!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/05/18 13:07:25
-!-----------------------------------------------------------------
-! ##################
- MODULE MODI_NZCOLX
-! ##################
-!
-INTERFACE
-!
- SUBROUTINE NZCOLX( KND, PALPHAX, PNUX, PALPHAZ, PNUZ, &
- PEXZ, PFALLX, PEXFALLX, PFALLEXPX, &
- PFALLZ, PEXFALLZ, PFALLEXPZ, &
- PLBDAXMAX, PLBDAZMAX, PLBDAXMIN, PLBDAZMIN, &
- PDINFTY, PNZCOLX )
-!
-INTEGER, INTENT(IN) :: KND ! Number of discrete size intervals in DX and DZ
-!
-!
-REAL, INTENT(IN) :: PALPHAX ! First shape parameter of the specy X
- ! size distribution (generalized gamma law)
-REAL, INTENT(IN) :: PNUX ! Second shape parameter of the specy X
- ! size distribution (generalized gamma law)
-REAL, INTENT(IN) :: PALPHAZ ! First shape parameter of the specy Z
- ! size distribution (generalized gamma law)
-REAL, INTENT(IN) :: PNUZ ! Second shape parameter of the specy Z
-REAL, INTENT(IN) :: PEXZ ! Efficiency of specy X collecting specy Z
-REAL, INTENT(IN) :: PFALLX ! Fall speed constant of specy X
-REAL, INTENT(IN) :: PEXFALLX ! Fall speed exponent of specy X
-REAL, INTENT(IN) :: PFALLEXPX ! Fall speed exponential constant of specy X
-REAL, INTENT(IN) :: PFALLZ ! Fall speed constant of specy Z
-REAL, INTENT(IN) :: PEXFALLZ ! Fall speed exponent of specy Z
-REAL, INTENT(IN) :: PFALLEXPZ ! Fall speed exponential constant of specy Z
-REAL, INTENT(IN) :: PLBDAXMAX ! Maximun slope of size distribution of specy X
-REAL, INTENT(IN) :: PLBDAZMAX ! Maximun slope of size distribution of specy Z
-REAL, INTENT(IN) :: PLBDAXMIN ! Minimun slope of size distribution of specy X
-REAL, INTENT(IN) :: PLBDAZMIN ! Minimun slope of size distribution of specy Z
-REAL, INTENT(IN) :: PDINFTY ! Factor to define the largest diameter up to
- ! which the diameter integration is performed
-!
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PNZCOLX ! Scaled fall speed difference in
- ! the mass collection kernel as a
- ! function of LAMBDAX and LAMBDAZ
-!
- END SUBROUTINE NZCOLX
-!
-END INTERFACE
-!
- END MODULE MODI_NZCOLX
+MODULE MODE_NZCOLX
+ IMPLICIT NONE
+CONTAINS
! ################################################################
- SUBROUTINE NZCOLX( KND, PALPHAX, PNUX, PALPHAZ, PNUZ, &
- PEXZ, PFALLX, PEXFALLX, PFALLEXPX, &
- PFALLZ, PEXFALLZ, PFALLEXPZ, &
- PLBDAXMAX, PLBDAZMAX, PLBDAXMIN, PLBDAZMIN, &
- PDINFTY, PNZCOLX )
+ SUBROUTINE NZCOLX( KND, PALPHAX, PNUX, PALPHAZ, PNUZ, &
+ PEXZ, PFALLX, PEXFALLX, PFALLEXPX, &
+ PFALLZ, PEXFALLZ, PFALLEXPZ, &
+ PLBDAXMAX, PLBDAZMAX, PLBDAXMIN, PLBDAZMIN, &
+ PDINFTY, PNZCOLX )
! ################################################################
!
!
@@ -276,3 +229,4 @@ DO JLBDAX = 1,SIZE(PNZCOLX(:,:),1)
END DO
!
END SUBROUTINE NZCOLX
+END MODULE MODE_NZCOLX
diff --git a/src/PHYEX/micro/mode_set_conc_lima.f90 b/src/PHYEX/micro/mode_set_conc_lima.f90
index 09e6bc1e51c5658584cd908ebddbd8803ee797db..6c132a78edde92569f54a608e1d145f4ad1ebb8e 100644
--- a/src/PHYEX/micro/mode_set_conc_lima.f90
+++ b/src/PHYEX/micro/mode_set_conc_lima.f90
@@ -73,16 +73,16 @@ contains
!* 0. DECLARATIONS
! ------------
!
-USE MODD_PARAM_LIMA, ONLY : XRTMIN, XCTMIN, LCOLD, LWARM, LRAIN, NMOD_CCN, NMOD_IFN, &
+USE MODD_PARAM_LIMA, ONLY : XRTMIN, XCTMIN, NMOD_CCN, NMOD_IFN, &
NMOM_C, NMOM_R, NMOM_I
USE MODD_PARAM_LIMA_COLD, ONLY : XAI, XBI, XAS, XBS
USE MODD_PARAM_LIMA_MIXED,ONLY : XAG, XBG, XAH, XBH
USE MODD_NSV, ONLY : NSV_LIMA_BEG_A, NSV_LIMA_NC_A, NSV_LIMA_NR_A, NSV_LIMA_CCN_ACTI_A, &
- NSV_LIMA_NI_A, NSV_LIMA_NS_A, NSV_LIMA_NG_A, NSV_LIMA_NH_A, NSV_LIMA_IFN_NUCL_A
+ NSV_LIMA_NI_A, NSV_LIMA_NS_A, NSV_LIMA_NG_A, NSV_LIMA_NH_A, NSV_LIMA_IFN_NUCL_A, &
+ NSV_LIMA_BEG, NSV_LIMA_NC, NSV_LIMA_NR, NSV_LIMA_CCN_ACTI, &
+ NSV_LIMA_NI, NSV_LIMA_NS, NSV_LIMA_NG, NSV_LIMA_NH, NSV_LIMA_IFN_NUCL
USE MODD_CST, ONLY : XPI, XRHOLW, XRHOLI
USE MODD_CONF, ONLY : NVERB
-USE MODD_CONF_n, ONLY : NRR
-USE MODD_LUNIT_n, ONLY : TLUOUT
!
IMPLICIT NONE
!
@@ -94,76 +94,75 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Reference density
!
REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRT ! microphysical mixing ratios
!
-REAL, DIMENSION(:,:,:,NSV_LIMA_BEG_A(kmi):), INTENT(INOUT):: PSVT ! microphys. concentrations
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVT ! microphys. concentrations
!
!
!* 0.2 Declarations of local variables :
!
-INTEGER :: IRESP ! Return code of FM routines
-INTEGER :: ILUOUT ! Logical unit number of output-listing
REAL :: ZCONC
+INTEGER :: ISV_LIMA_NC, ISV_LIMA_NR, ISV_LIMA_CCN_ACTI
+INTEGER :: ISV_LIMA_NI, ISV_LIMA_NS, ISV_LIMA_NG, ISV_LIMA_NH, ISV_LIMA_IFN_NUCL
!
!-------------------------------------------------------------------------------
!* 1. RETRIEVE LOGICAL UNIT NUMBER
! ----------------------------
!
-ILUOUT = TLUOUT%NLU
+ISV_LIMA_NC = NSV_LIMA_NC - NSV_LIMA_BEG + 1
+ISV_LIMA_NR = NSV_LIMA_NR - NSV_LIMA_BEG + 1
+ISV_LIMA_CCN_ACTI = NSV_LIMA_CCN_ACTI - NSV_LIMA_BEG + 1
+ISV_LIMA_NI = NSV_LIMA_NI - NSV_LIMA_BEG + 1
+ISV_LIMA_NS = NSV_LIMA_NS - NSV_LIMA_BEG + 1
+ISV_LIMA_NG = NSV_LIMA_NG - NSV_LIMA_BEG + 1
+ISV_LIMA_NH = NSV_LIMA_NH - NSV_LIMA_BEG + 1
+ISV_LIMA_IFN_NUCL = NSV_LIMA_IFN_NUCL - NSV_LIMA_BEG + 1
!
!* 2. INITIALIZATION
! --------------
!
-IF (LWARM .AND. NRR.GE.2 .AND. NMOM_C.GE.2) THEN
+IF (NMOM_C.GE.2) THEN
!
! droplets
!
ZCONC = 300.E6 ! droplet concentration set at 300 cm-3
WHERE ( PRT(:,:,:,2) > 1.E-11 )
- PSVT(:,:,:,NSV_LIMA_NC_A(kmi)) = ZCONC
+ PSVT(:,:,:,ISV_LIMA_NC) = ZCONC
END WHERE
WHERE ( PRT(:,:,:,2) <= 1.E-11 )
PRT(:,:,:,2) = 0.0
- PSVT(:,:,:,NSV_LIMA_NC_A(kmi)) = 0.0
+ PSVT(:,:,:,ISV_LIMA_NC) = 0.0
END WHERE
IF (NMOD_CCN .GE. 1) THEN
WHERE ( PRT(:,:,:,2) > 1.E-11 )
- PSVT(:,:,:,NSV_LIMA_CCN_ACTI_A(kmi)) = ZCONC
+ PSVT(:,:,:,ISV_LIMA_CCN_ACTI) = ZCONC
END WHERE
WHERE ( PRT(:,:,:,2) <= 1.E-11 )
- PSVT(:,:,:,NSV_LIMA_CCN_ACTI_A(kmi)) = 0.0
+ PSVT(:,:,:,ISV_LIMA_CCN_ACTI) = 0.0
END WHERE
END IF
-! IF( NVERB >= 5 ) THEN
-! WRITE (UNIT=ILUOUT,FMT=*) "!INI_MODEL$n: The droplet concentration has "
-! WRITE (UNIT=ILUOUT,FMT=*) "been roughly initialised"
-! END IF
END IF
!
-IF (LWARM .AND. LRAIN .AND. NRR.GE.3 .AND. NMOM_R.GE.2) THEN
+IF (NMOM_R.GE.2) THEN
!
! drops
!
ZCONC = (1.E7)**3/(XPI*XRHOLW) ! cf XCONCR_PARAM_INI in ini_rain_c2r2.f90
IF (HGETCLOUD == 'INI1') THEN ! init from REVE scheme
- PSVT(:,:,:,NSV_LIMA_NR_A(kmi)) = 0.0
+ PSVT(:,:,:,ISV_LIMA_NR) = 0.0
ELSE ! init from KESS, ICE3...
WHERE ( PRT(:,:,:,3) > 1.E-11 )
- PSVT(:,:,:,NSV_LIMA_NR_A(kmi)) = MAX( SQRT(SQRT(PRHODREF(:,:,:)*PRT(:,:,:,3) &
+ PSVT(:,:,:,ISV_LIMA_NR) = MAX( SQRT(SQRT(PRHODREF(:,:,:)*PRT(:,:,:,3) &
*ZCONC)),1. )
END WHERE
WHERE ( PRT(:,:,:,3) <= 1.E-11 )
PRT(:,:,:,3) = 0.0
- PSVT(:,:,:,NSV_LIMA_NR_A(kmi)) = 0.0
+ PSVT(:,:,:,ISV_LIMA_NR) = 0.0
END WHERE
-! IF( NVERB >= 5 ) THEN
-! WRITE (UNIT=ILUOUT,FMT=*) "!INI_MODEL$n: The raindrop concentration has "
-! WRITE (UNIT=ILUOUT,FMT=*) "been roughly initialised"
-! END IF
END IF
END IF
!
-IF (LCOLD .AND. NRR.GE.4 .AND. NMOM_I.GE.2) THEN
+IF (NMOM_I.GE.2) THEN
!
! ice crystals
!
@@ -174,65 +173,60 @@ IF (LCOLD .AND. NRR.GE.4 .AND. NMOM_I.GE.2) THEN
! ( XRHOLI * XAI*(10.E-06)**XBI * PRT(:,:,:,4) ), &
! ZCONC )
! Correction
- PSVT(:,:,:,NSV_LIMA_NI_A(kmi)) = MIN(PRT(:,:,:,4)/(0.82*(10.E-06)**2.5),ZCONC )
+ PSVT(:,:,:,ISV_LIMA_NI) = MIN(PRT(:,:,:,4)/(0.82*(10.E-06)**2.5),ZCONC )
END WHERE
WHERE ( PRT(:,:,:,4) <= 1.E-11 )
PRT(:,:,:,4) = 0.0
- PSVT(:,:,:,NSV_LIMA_NI_A(kmi)) = 0.0
+ PSVT(:,:,:,ISV_LIMA_NI) = 0.0
END WHERE
IF (NMOD_IFN .GE. 1) THEN
WHERE ( PRT(:,:,:,4) > 1.E-11 )
- PSVT(:,:,:,NSV_LIMA_IFN_NUCL_A(kmi)) = PSVT(:,:,:,NSV_LIMA_NI_A(kmi))
+ PSVT(:,:,:,ISV_LIMA_IFN_NUCL) = PSVT(:,:,:,ISV_LIMA_NI)
END WHERE
WHERE ( PRT(:,:,:,4) <= 1.E-11 )
- PSVT(:,:,:,NSV_LIMA_IFN_NUCL_A(kmi)) = 0.0
+ PSVT(:,:,:,ISV_LIMA_IFN_NUCL) = 0.0
END WHERE
END IF
-! IF( NVERB >= 5 ) THEN
-! WRITE (UNIT=ILUOUT,FMT=*) "!INI_MODEL$n: The cloud ice concentration has "
-! WRITE (UNIT=ILUOUT,FMT=*) "been roughly initialised"
-! END IF
-!
END IF
!
-IF (NSV_LIMA_NS_A(KMI).GE.1) THEN
+IF (ISV_LIMA_NS.GE.1) THEN
!
! snow
!
ZCONC = 1./ (XAS*0.001**XBS) ! 1mm particle size
WHERE ( PRT(:,:,:,5) > 1.E-11 )
- PSVT(:,:,:,NSV_LIMA_NS_A(KMI)) = PRT(:,:,:,5) * ZCONC
+ PSVT(:,:,:,ISV_LIMA_NS) = PRT(:,:,:,5) * ZCONC
ELSEWHERE
PRT(:,:,:,5) = 0.0
- PSVT(:,:,:,NSV_LIMA_NS_A(KMI)) = 0.0
+ PSVT(:,:,:,ISV_LIMA_NS) = 0.0
END WHERE
END IF
!
-IF (NSV_LIMA_NG_A(KMI).GE.1) THEN
+IF (ISV_LIMA_NG.GE.1) THEN
!
! graupel
!
ZCONC = 1./ (XAG*0.001**XBG) ! 1mm particle size
WHERE ( PRT(:,:,:,6) > 1.E-11 )
- PSVT(:,:,:,NSV_LIMA_NG_A(KMI)) = PRT(:,:,:,6) * ZCONC
+ PSVT(:,:,:,ISV_LIMA_NG) = PRT(:,:,:,6) * ZCONC
ELSEWHERE
PRT(:,:,:,6) = 0.0
- PSVT(:,:,:,NSV_LIMA_NG_A(KMI)) = 0.0
+ PSVT(:,:,:,ISV_LIMA_NG) = 0.0
END WHERE
END IF
!
-IF (NSV_LIMA_NH_A(KMI).GE.1) THEN
+IF (ISV_LIMA_NH.GE.1) THEN
!
! hail
!
ZCONC = 1./ (XAH*0.001**XBH) ! 1mm particle size
WHERE ( PRT(:,:,:,7) > 1.E-11 )
- PSVT(:,:,:,NSV_LIMA_NH_A(KMI)) = PRT(:,:,:,7) * ZCONC
+ PSVT(:,:,:,ISV_LIMA_NH) = PRT(:,:,:,7) * ZCONC
ELSEWHERE
PRT(:,:,:,7) = 0.0
- PSVT(:,:,:,NSV_LIMA_NH_A(KMI)) = 0.0
+ PSVT(:,:,:,ISV_LIMA_NH) = 0.0
END WHERE
END IF
!
diff --git a/src/PHYEX/micro/modi_lima.f90 b/src/PHYEX/micro/modi_lima.f90
new file mode 100644
index 0000000000000000000000000000000000000000..6cd5fa338a4bde2175fa985d0e14d370718c9ec7
--- /dev/null
+++ b/src/PHYEX/micro/modi_lima.f90
@@ -0,0 +1,65 @@
+MODULE MODI_LIMA
+!
+INTERFACE
+!
+ SUBROUTINE LIMA ( D, CST, BUCONF, TBUDGETS, KBUDGETS, &
+ PTSTEP, &
+ PRHODREF, PEXNREF, PDZZ, &
+ PRHODJ, PPABST, &
+ NCCN, NIFN, NIMM, &
+ PDTHRAD, PTHT, PRT, PSVT, PW_NU, &
+ PTHS, PRS, PSVS, &
+ PINPRC, PINDEP, PINPRR, PINPRI, PINPRS, PINPRG, PINPRH, &
+ PEVAP3D, PCLDFR, PICEFR, PPRCFR, PFPR )
+!
+USE MODD_IO, ONLY: TFILEDATA
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+USE MODD_BUDGET, ONLY: TBUDGETDATA, TBUDGETCONF_t
+USE MODD_CST, ONLY: CST_t
+!
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+TYPE(CST_t), INTENT(IN) :: CST
+TYPE(TBUDGETCONF_t), INTENT(IN) :: BUCONF
+TYPE(TBUDGETDATA), DIMENSION(KBUDGETS), INTENT(INOUT) :: TBUDGETS
+INTEGER, INTENT(IN) :: KBUDGETS
+!
+REAL, INTENT(IN) :: PTSTEP ! Time step
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Reference density
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! Layer thikness (m)
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! absolute pressure at t
+!
+INTEGER, INTENT(IN) :: NCCN ! for array size declarations
+INTEGER, INTENT(IN) :: NIFN ! for array size declarations
+INTEGER, INTENT(IN) :: NIMM ! for array size declarations
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDTHRAD ! dT/dt due to radiation
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta at time t
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT ! Mixing ratios at time t
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVT ! Concentrations at time t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PW_NU ! w for CCN activation
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRS ! Mixing ratios sources
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVS ! Concentration sources
+!
+REAL, DIMENSION(:,:), INTENT(OUT) :: PINPRC ! Cloud instant precip
+REAL, DIMENSION(:,:), INTENT(OUT) :: PINDEP ! Cloud droplets deposition
+REAL, DIMENSION(:,:), INTENT(OUT) :: PINPRR ! Rain instant precip
+REAL, DIMENSION(:,:), INTENT(OUT) :: PINPRI ! Rain instant precip
+REAL, DIMENSION(:,:), INTENT(OUT) :: PINPRS ! Snow instant precip
+REAL, DIMENSION(:,:), INTENT(OUT) :: PINPRG ! Graupel instant precip
+REAL, DIMENSION(:,:), INTENT(OUT) :: PINPRH ! Rain instant precip
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PEVAP3D ! Rain evap profile
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCLDFR ! Cloud fraction
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PICEFR ! Cloud fraction
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PPRCFR ! Cloud fraction
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PFPR ! Precipitation fluxes in altitude
+!
+END SUBROUTINE LIMA
+END INTERFACE
+END MODULE MODI_LIMA
diff --git a/src/PHYEX/micro/modi_lima_adjust_split.f90 b/src/PHYEX/micro/modi_lima_adjust_split.f90
new file mode 100644
index 0000000000000000000000000000000000000000..aeb84748a1a24cd73f99e9c042969df03f645deb
--- /dev/null
+++ b/src/PHYEX/micro/modi_lima_adjust_split.f90
@@ -0,0 +1,71 @@
+! #############################
+ MODULE MODI_LIMA_ADJUST_SPLIT
+! #############################
+!
+INTERFACE
+!
+ SUBROUTINE LIMA_ADJUST_SPLIT(D, CST, BUCONF, TBUDGETS, KBUDGETS, &
+ KRR, KMI, HCONDENS, HLAMBDA3, &
+ OSUBG_COND, OSIGMAS, PTSTEP, PSIGQSAT, &
+ PRHODREF, PRHODJ, PEXNREF, PSIGS, PMFCONV, &
+ PPABST, PPABSTT, PZZ, PDTHRAD, PW_NU, &
+ PRT, PRS, PSVT, PSVS, &
+ PTHS, PSRCS, PCLDFR, PICEFR, PRC_MF, PRI_MF, PCF_MF)
+!
+!USE MODD_IO, ONLY: TFILEDATA
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+USE MODD_BUDGET, ONLY: TBUDGETDATA, TBUDGETCONF_t
+USE MODD_CST, ONLY: CST_t
+!
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+TYPE(CST_t), INTENT(IN) :: CST
+TYPE(TBUDGETCONF_t), INTENT(IN) :: BUCONF
+TYPE(TBUDGETDATA), DIMENSION(KBUDGETS), INTENT(INOUT) :: TBUDGETS
+INTEGER, INTENT(IN) :: KBUDGETS
+!
+INTEGER, INTENT(IN) :: KRR ! Number of moist variables
+INTEGER, INTENT(IN) :: KMI ! Model index
+CHARACTER(len=80), INTENT(IN) :: HCONDENS
+CHARACTER(len=4), INTENT(IN) :: HLAMBDA3 ! formulation for lambda3 coeff
+LOGICAL, INTENT(IN) :: OSUBG_COND ! Switch for Subgrid
+ ! Condensation
+LOGICAL, INTENT(IN) :: OSIGMAS ! Switch for Sigma_s:
+ ! use values computed in CONDENSATION
+ ! or that from turbulence scheme
+REAL, INTENT(IN) :: PTSTEP ! Time step
+REAL, INTENT(IN) :: PSIGQSAT ! coeff applied to qsat variance contribution
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Dry density of the
+ ! reference state
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSIGS ! Sigma_s at time t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PMFCONV !
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! Absolute Pressure at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABSTT ! Absolute Pressure at t+dt
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ !
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDTHRAD ! Radiative temperature tendency
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PW_NU ! updraft velocity used for
+!
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT ! m.r. at t
+!
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRS ! m.r. source
+!
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVT ! Concentrations at time t
+!
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVS ! Concentration sources
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source
+!
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSRCS ! Second-order flux
+ ! s'rc'/2Sigma_s2 at time t+1
+ ! multiplied by Lambda_3
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCLDFR ! Cloud fraction
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PICEFR ! Cloud fraction
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRC_MF! Convective Mass Flux liquid mixing ratio
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRI_MF! Convective Mass Flux ice mixing ratio
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCF_MF! Convective Mass Flux Cloud fraction
+!
+END SUBROUTINE LIMA_ADJUST_SPLIT
+END INTERFACE
+END MODULE MODI_LIMA_ADJUST_SPLIT
diff --git a/src/PHYEX/micro/modi_lima_precip_scavenging.f90 b/src/PHYEX/micro/modi_lima_precip_scavenging.f90
new file mode 100644
index 0000000000000000000000000000000000000000..918e2982eba4d565648da504c0051aa88922fb34
--- /dev/null
+++ b/src/PHYEX/micro/modi_lima_precip_scavenging.f90
@@ -0,0 +1,40 @@
+!#################################
+MODULE MODI_LIMA_PRECIP_SCAVENGING
+!#################################
+!
+ INTERFACE
+!
+ SUBROUTINE LIMA_PRECIP_SCAVENGING (D, CST, BUCONF, TBUDGETS, KBUDGETS, &
+ HCLOUD, KLUOUT, KTCOUNT, PTSTEP, &
+ PRRT, PRHODREF, PRHODJ, PZZ, &
+ PPABST, PTHT, PSVT, PRSVS, PINPAP )
+ USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+ use modd_budget, only: TBUDGETDATA,TBUDGETCONF_t
+ USE MODD_CST, ONLY: CST_t
+!
+ TYPE(DIMPHYEX_t), INTENT(IN) :: D
+ TYPE(CST_t), INTENT(IN) :: CST
+ TYPE(TBUDGETCONF_t), INTENT(IN) :: BUCONF
+ TYPE(TBUDGETDATA), DIMENSION(KBUDGETS), INTENT(INOUT) :: TBUDGETS
+ INTEGER, INTENT(IN) :: KBUDGETS
+!
+ CHARACTER(LEN=4), INTENT(IN) :: HCLOUD ! cloud paramerization
+ INTEGER, INTENT(IN) :: KLUOUT ! unit for output listing
+ INTEGER, INTENT(IN) :: KTCOUNT ! iteration count
+ REAL, INTENT(IN) :: PTSTEP ! Double timestep except
+ ! for the first time step
+!
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Rain mixing ratio at t
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Air Density [kg/m**3]
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry Density [kg]
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Altitude
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! Absolute pressure at t
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta at time t
+!
+ REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVT ! Particle Concentration [/m**3]
+ REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRSVS ! Total Number Scavenging Rate
+!
+ REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPAP
+ END SUBROUTINE LIMA_PRECIP_SCAVENGING
+ END INTERFACE
+END MODULE MODI_LIMA_PRECIP_SCAVENGING
diff --git a/src/PHYEX/micro/modn_param_lima.f90 b/src/PHYEX/micro/modn_param_lima.f90
index 44d46714532cecea5636b296e32983968ea57ab6..390ba1dc8853237ddf00550f04dbeb9465636c3d 100644
--- a/src/PHYEX/micro/modn_param_lima.f90
+++ b/src/PHYEX/micro/modn_param_lima.f90
@@ -17,7 +17,7 @@ USE MODD_PARAM_LIMA
IMPLICIT NONE
!
!
-NAMELIST/NAM_PARAM_LIMA/LCOLD, LNUCL, LSEDI, LSNOW, LHAIL, LHHONI, LMEYERS,&
+NAMELIST/NAM_PARAM_LIMA/LNUCL, LSEDI, LHHONI, LMEYERS, &
NMOM_I, NMOM_S, NMOM_G, NMOM_H, &
NMOD_IFN, XIFN_CONC, LIFN_HOM, &
CIFN_SPECIES, CINT_MIXING, NMOD_IMM, NIND_SPECIE, &
@@ -25,7 +25,7 @@ NAMELIST/NAM_PARAM_LIMA/LCOLD, LNUCL, LSEDI, LSNOW, LHAIL, LHHONI, LMEYERS,&
XALPHAI, XNUI, XALPHAS, XNUS, XALPHAG, XNUG, &
XFACTNUC_DEP, XFACTNUC_CON, NPHILLIPS, &
LCIBU, XNDEBRIS_CIBU, LRDSF, LMURAKAMI, &
- LWARM, LACTI, LRAIN, LSEDC, LACTIT, LBOUND, LSPRO, &
+ LACTI, LSEDC, LACTIT, LBOUND, LSPRO, &
LADJ, LKHKO, LKESSLERAC, NMOM_C, NMOM_R, &
NMOD_CCN, XCCN_CONC, &
LCCN_HOM, CCCN_MODES, HINI_CCN, HTYPE_CCN, &
diff --git a/src/PHYEX/micro/rain_ice.f90 b/src/PHYEX/micro/rain_ice.f90
index 2008e76f6b6552c424e91d78e78e8a310eed4a79..c17b5c3cd39bd3e426f2e41208e16ee11ec1550c 100644
--- a/src/PHYEX/micro/rain_ice.f90
+++ b/src/PHYEX/micro/rain_ice.f90
@@ -197,7 +197,7 @@ USE MODD_FIELDS_ADDRESS, ONLY : & ! common fields adress
& IRG, & ! Graupel
& IRH ! Hail
-USE MODE_BUDGET, ONLY: BUDGET_STORE_ADD_PHY, BUDGET_STORE_INIT_PHY, BUDGET_STORE_END_PHY
+USE MODE_BUDGET_PHY, ONLY: BUDGET_STORE_ADD_PHY, BUDGET_STORE_INIT_PHY, BUDGET_STORE_END_PHY
USE MODE_MSG, ONLY: PRINT_MSG, NVERB_FATAL
USE MODE_ICE4_RAINFR_VERT, ONLY: ICE4_RAINFR_VERT
diff --git a/src/PHYEX/turb/mode_prandtl.f90 b/src/PHYEX/turb/mode_prandtl.f90
index 9a0d77c6dd45218aecc31b142635e444bbb1d2c4..f911cba340f766ae9cb41483fdb0fbed6072bb3b 100644
--- a/src/PHYEX/turb/mode_prandtl.f90
+++ b/src/PHYEX/turb/mode_prandtl.f90
@@ -17,7 +17,7 @@ USE MODD_CTURB, ONLY : CSTURB_t
USE MODD_DIMPHYEX, ONLY : DIMPHYEX_t
USE MODD_PARAMETERS, ONLY : JPVEXT_TURB
!
-USE SHUMAN_PHY, ONLY: MZM_PHY,MZF_PHY
+USE MODE_SHUMAN_PHY, ONLY: MZM_PHY,MZF_PHY
USE MODE_GRADIENT_M_PHY
IMPLICIT NONE
!----------------------------------------------------------------------------
@@ -154,7 +154,7 @@ USE MODD_PARAMETERS, ONLY: JPVEXT_TURB
USE MODE_EMOIST, ONLY: EMOIST
USE MODE_ETHETA, ONLY: ETHETA
USE MODE_GRADIENT_M_PHY, ONLY: GX_M_M_PHY, GY_M_M_PHY
-USE MODE_IO_FIELD_WRITE, ONLY: IO_FIELD_WRITE_PHY
+USE MODE_IO_FIELD_WRITE_PHY, ONLY: IO_FIELD_WRITE_PHY
!
IMPLICIT NONE
!
diff --git a/src/PHYEX/turb/mode_rmc01.f90 b/src/PHYEX/turb/mode_rmc01.f90
index 5a980a92be0abf8fd509eba3bf3a572b9df28d89..59f254a0d4af720a86f3692144d7fcad68e4d806 100644
--- a/src/PHYEX/turb/mode_rmc01.f90
+++ b/src/PHYEX/turb/mode_rmc01.f90
@@ -53,7 +53,7 @@ USE MODD_CTURB, ONLY: CSTURB_t
USE MODE_UPDATE_IIJU_PHY, ONLY: UPDATE_IIJU_PHY
USE MODE_SBL_PHY, ONLY: BUSINGER_PHIM, BUSINGER_PHIE
!
-USE SHUMAN_PHY, ONLY: MZF_PHY, MYF_PHY, MXF_PHY
+USE MODE_SHUMAN_PHY, ONLY: MZF_PHY, MYF_PHY, MXF_PHY
!
IMPLICIT NONE
!
diff --git a/src/PHYEX/turb/mode_tke_eps_sources.f90 b/src/PHYEX/turb/mode_tke_eps_sources.f90
index f7f6a5082ae0c68b332cc8b4fed22347fbd2bfd1..1ca962693ed6b5b15547b841bf664cc0328871a9 100644
--- a/src/PHYEX/turb/mode_tke_eps_sources.f90
+++ b/src/PHYEX/turb/mode_tke_eps_sources.f90
@@ -128,7 +128,7 @@ CONTAINS
! ------------
!
USE PARKIND1, ONLY: JPRB
-USE SHUMAN_PHY, ONLY: MZM_PHY, MZF_PHY, DZF_PHY, DZM_PHY
+USE MODE_SHUMAN_PHY, ONLY: MZM_PHY, MZF_PHY, DZF_PHY, DZM_PHY
USE YOMHOOK, ONLY: LHOOK, DR_HOOK
!
USE MODD_ARGSLIST_ll, ONLY: LIST_ll
@@ -142,8 +142,8 @@ USE MODD_LES, ONLY: TLES_t
USE MODD_PARAMETERS, ONLY: JPVEXT_TURB
USE MODD_TURB_n, ONLY: TURB_t
!
-USE MODE_BUDGET, ONLY: BUDGET_STORE_ADD_PHY, BUDGET_STORE_END_PHY, BUDGET_STORE_INIT_PHY
-USE MODE_IO_FIELD_WRITE, ONLY: IO_FIELD_WRITE_PHY
+USE MODE_BUDGET_PHY, ONLY: BUDGET_STORE_ADD_PHY, BUDGET_STORE_END_PHY, BUDGET_STORE_INIT_PHY
+USE MODE_IO_FIELD_WRITE_PHY, ONLY: IO_FIELD_WRITE_PHY
USE MODE_ll
!
USE MODI_GET_HALO
@@ -296,7 +296,7 @@ ZSOURCE(IIJB:IIJE,1:IKT) = ( PRTKES(IIJB:IIJE,1:IKT) + PRTKEMS(IIJB:IIJE,1:IKT)
IF (OOCEAN) THEN
!for ocean:wave breaking simple/very rough param wE = 100 Ustar**3 where ustar is the Tau_atmi/rhocea
!$mnh_expand_array(JIJ=IIJB:IIJE)
- ZSOURCE (IIJB:IIJE,IKE)=ZSOURCE(IIJB:IIJE,IKE)-1.E2*((PSFUM(IIJB:IIJE)**2 + PSFVM(IIJB:IIJE)**2)**1.5) /PDZZ(IIJB:IIJE,IKE)
+ ZSOURCE(IIJB:IIJE,IKE)=ZSOURCE(IIJB:IIJE,IKE)-1.E2*((PSFUM(IIJB:IIJE)**2 + PSFVM(IIJB:IIJE)**2)**1.5) /PDZZ(IIJB:IIJE,IKE)
!$mnh_end_expand_array(JIJ=IIJB:IIJE)
END IF
! Compute the vector giving the elements just under the diagonal for the
diff --git a/src/PHYEX/turb/mode_tridiag_thermo.f90 b/src/PHYEX/turb/mode_tridiag_thermo.f90
index fcef93a9789f5513e9b7a213a0c24796dcc516a8..23d959b9bdb5714bdc06ecfe4592456c2a0a5751 100644
--- a/src/PHYEX/turb/mode_tridiag_thermo.f90
+++ b/src/PHYEX/turb/mode_tridiag_thermo.f90
@@ -122,7 +122,7 @@ USE MODD_DIMPHYEX, ONLY : DIMPHYEX_t
USE MODD_PARAMETERS, ONLY : JPVEXT_TURB
!
USE MODI_SHUMAN, ONLY : MZM
-USE SHUMAN_PHY, ONLY: MZM_PHY
+USE MODE_SHUMAN_PHY, ONLY: MZM_PHY
!
IMPLICIT NONE
!
diff --git a/src/PHYEX/turb/mode_turb_ver.f90 b/src/PHYEX/turb/mode_turb_ver.f90
index b014aa191d35db68f45b60b86ade811c2159ec3e..6847c703e900270816207ad37a90eec4e25386e7 100644
--- a/src/PHYEX/turb/mode_turb_ver.f90
+++ b/src/PHYEX/turb/mode_turb_ver.f90
@@ -225,7 +225,7 @@ USE MODD_TURB_n, ONLY: TURB_t
USE MODE_EMOIST, ONLY: EMOIST
USE MODE_ETHETA, ONLY: ETHETA
USE MODE_GRADIENT_M_PHY, ONLY: GZ_M_W_PHY
-USE MODE_IO_FIELD_WRITE, ONLY: IO_FIELD_WRITE_PHY
+USE MODE_IO_FIELD_WRITE_PHY, ONLY: IO_FIELD_WRITE_PHY
USE MODE_PRANDTL, ONLY: PSI_SV, PSI3, PHI3, PRANDTL
USE MODE_SBL_DEPTH, ONLY: SBL_DEPTH
USE MODE_TURB_VER_DYN_FLUX, ONLY: TURB_VER_DYN_FLUX
diff --git a/src/PHYEX/turb/mode_turb_ver_dyn_flux.f90 b/src/PHYEX/turb/mode_turb_ver_dyn_flux.f90
index 17f8d55009e8e4a0c251bc3f79d9b715a4ebcf6c..acda739bf432db377a546504ce3cb145282f4738 100644
--- a/src/PHYEX/turb/mode_turb_ver_dyn_flux.f90
+++ b/src/PHYEX/turb/mode_turb_ver_dyn_flux.f90
@@ -205,7 +205,7 @@ SUBROUTINE TURB_VER_DYN_FLUX(D,CST,CSTURB,TURBN,TLES,KSV,O2D,OFLAT, &
! ------------
!
USE PARKIND1, ONLY: JPRB
-USE SHUMAN_PHY
+USE MODE_SHUMAN_PHY
USE YOMHOOK, ONLY: LHOOK, DR_HOOK
!
USE MODD_CST, ONLY: CST_t
@@ -221,7 +221,7 @@ USE MODE_GRADIENT_U_PHY, ONLY : GZ_U_UW_PHY, GX_U_M_PHY
USE MODE_GRADIENT_V_PHY, ONLY : GZ_V_VW_PHY, GY_V_M_PHY
USE MODE_GRADIENT_W_PHY, ONLY : GX_W_UW_PHY, GY_W_VW_PHY, GZ_W_M_PHY
USE MODE_GRADIENT_M_PHY, ONLY : GX_M_U_PHY, GY_M_V_PHY
-USE MODE_IO_FIELD_WRITE, only: IO_FIELD_WRITE_PHY
+USE MODE_IO_FIELD_WRITE_PHY, only: IO_FIELD_WRITE_PHY
USE MODE_ll
USE MODE_TRIDIAG_WIND, ONLY: TRIDIAG_WIND
!
diff --git a/src/PHYEX/turb/mode_turb_ver_sv_corr.f90 b/src/PHYEX/turb/mode_turb_ver_sv_corr.f90
index 2a1915b221dabe682ce5f2e6cf85e163a2941ff9..64acbc7f83418a05b71b816b7d6cf9cb86b452fa 100644
--- a/src/PHYEX/turb/mode_turb_ver_sv_corr.f90
+++ b/src/PHYEX/turb/mode_turb_ver_sv_corr.f90
@@ -62,7 +62,7 @@ USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
USE MODD_PARAMETERS, ONLY: JPVEXT_TURB
USE MODD_LES, ONLY: TLES_t
!
-USE SHUMAN_PHY, ONLY: MZF_PHY
+USE MODE_SHUMAN_PHY, ONLY: MZF_PHY
USE MODE_GRADIENT_M_PHY, ONLY : GZ_M_W_PHY
USE MODE_EMOIST, ONLY: EMOIST
USE MODE_ETHETA, ONLY: ETHETA
diff --git a/src/PHYEX/turb/mode_turb_ver_sv_flux.f90 b/src/PHYEX/turb/mode_turb_ver_sv_flux.f90
index 09d51b09c9b107d184a2c192d057c3043afd55fe..40a52e4ce77ea68335688a57bdc43324495a7207 100644
--- a/src/PHYEX/turb/mode_turb_ver_sv_flux.f90
+++ b/src/PHYEX/turb/mode_turb_ver_sv_flux.f90
@@ -210,7 +210,7 @@ SUBROUTINE TURB_VER_SV_FLUX(D,CST,CSTURB,TURBN,TLES,ONOMIXLG, &
! ------------
!
USE PARKIND1, ONLY: JPRB
-USE SHUMAN_PHY, ONLY: DZM_PHY, MZM_PHY, MZF_PHY
+USE MODE_SHUMAN_PHY, ONLY: DZM_PHY, MZM_PHY, MZF_PHY
USE YOMHOOK, ONLY: LHOOK, DR_HOOK
!
USE MODD_CST, ONLY: CST_t
@@ -226,7 +226,7 @@ USE MODE_EMOIST, ONLY: EMOIST
USE MODE_ETHETA, ONLY: ETHETA
USE MODE_GRADIENT_W_PHY, ONLY: GZ_W_M_PHY
USE MODE_GRADIENT_M_PHY, ONLY: GZ_M_W_PHY
-USE MODE_IO_FIELD_WRITE, ONLY: IO_FIELD_WRITE_PHY
+USE MODE_IO_FIELD_WRITE_PHY, ONLY: IO_FIELD_WRITE_PHY
USE MODE_TRIDIAG, ONLY: TRIDIAG
!
USE MODI_LES_MEAN_SUBGRID_PHY
@@ -290,7 +290,8 @@ REAL, DIMENSION(D%NIJT,D%NKT) :: &
ZSOURCE, & ! source of evolution for the treated variable
ZKEFF, & ! effectif diffusion coeff = LT * SQRT( TKE )
ZWORK1,ZWORK2,&
- ZWORK3,ZWORK4! working var. for shuman operators (array syntax)
+ ZWORK3,ZWORK4,&! working var. for shuman operators (array syntax)
+ ZMZMRHODJ
INTEGER :: IKT ! array size in k direction
INTEGER :: IIJB,IIJE,IKB,IKE,IKA ! index value for the mass points of the domain
INTEGER :: IKTB,IKTE ! start, end of k loops in physical domain
@@ -345,7 +346,7 @@ ENDIF
!* 8. SOURCES OF PASSIVE SCALAR VARIABLES
! -----------------------------------
!
-CALL MZM_PHY(D,PRHODJ,ZWORK1)
+CALL MZM_PHY(D,PRHODJ,ZMZMRHODJ)
DO JSV=1,KSV
!
IF (ONOMIXLG .AND. JSV >= KSV_LGBEG .AND. JSV<= KSV_LGEND) CYCLE
@@ -353,13 +354,13 @@ DO JSV=1,KSV
! Preparation of the arguments for TRIDIAG
IF (TURBN%LHARAT) THEN
!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
- ZA(IIJB:IIJE,1:IKT) = -PTSTEP * ZKEFF(IIJB:IIJE,1:IKT) * ZWORK1(IIJB:IIJE,1:IKT) &
+ ZA(IIJB:IIJE,1:IKT) = -PTSTEP * ZKEFF(IIJB:IIJE,1:IKT) * ZMZMRHODJ(IIJB:IIJE,1:IKT) &
/ PDZZ(IIJB:IIJE,1:IKT)**2
!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
ELSE
!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
ZA(IIJB:IIJE,1:IKT) = -PTSTEP*ZCSV*PPSI_SV(IIJB:IIJE,1:IKT,JSV) * &
- ZKEFF(IIJB:IIJE,1:IKT) * ZWORK1(IIJB:IIJE,1:IKT) / PDZZ(IIJB:IIJE,1:IKT)**2
+ ZKEFF(IIJB:IIJE,1:IKT) * ZMZMRHODJ(IIJB:IIJE,1:IKT) / PDZZ(IIJB:IIJE,1:IKT)**2
!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
ENDIF
ZSOURCE(IIJB:IIJE,1:IKT) = 0.
diff --git a/src/PHYEX/turb/mode_turb_ver_thermo_corr.f90 b/src/PHYEX/turb/mode_turb_ver_thermo_corr.f90
index 56c4e01d7c54ac8f2e02d8f7a272f356846a767a..8a53e4917a552ea1eda3b790e8ee7dcc90a5887a 100644
--- a/src/PHYEX/turb/mode_turb_ver_thermo_corr.f90
+++ b/src/PHYEX/turb/mode_turb_ver_thermo_corr.f90
@@ -205,7 +205,7 @@ SUBROUTINE TURB_VER_THERMO_CORR(D,CST,CSTURB,TURBN,TLES, &
! ------------
!
USE PARKIND1, ONLY: JPRB
-USE SHUMAN_PHY, ONLY: MZM_PHY, MZF_PHY, DZM_PHY
+USE MODE_SHUMAN_PHY, ONLY: MZM_PHY, MZF_PHY, DZM_PHY
USE YOMHOOK, ONLY: LHOOK, DR_HOOK
!
USE MODD_CST, ONLY: CST_t
@@ -217,7 +217,7 @@ USE MODD_LES, ONLY: TLES_t
USE MODD_PARAMETERS, ONLY: JPVEXT_TURB
USE MODD_TURB_n, ONLY: TURB_t
!
-USE MODE_IO_FIELD_WRITE, ONLY: IO_FIELD_WRITE_PHY
+USE MODE_IO_FIELD_WRITE_PHY, ONLY: IO_FIELD_WRITE_PHY
USE MODE_PRANDTL
!
USE MODI_LES_MEAN_SUBGRID_PHY
diff --git a/src/PHYEX/turb/mode_turb_ver_thermo_flux.f90 b/src/PHYEX/turb/mode_turb_ver_thermo_flux.f90
index 618fb377a19214004ad7dcd906efc3e6fbad40b5..b537219ac83a63aa4ce0eb5a3cc0f8d7e95bade1 100644
--- a/src/PHYEX/turb/mode_turb_ver_thermo_flux.f90
+++ b/src/PHYEX/turb/mode_turb_ver_thermo_flux.f90
@@ -230,7 +230,7 @@ SUBROUTINE TURB_VER_THERMO_FLUX(D,CST,CSTURB,TURBN,TLES, &
! ------------
!
USE PARKIND1, ONLY: JPRB
-USE SHUMAN_PHY, ONLY: DZF_PHY, DZM_PHY, MXF_PHY, MYF_PHY, MZF_PHY, MZM_PHY
+USE MODE_SHUMAN_PHY, ONLY: DZF_PHY, DZM_PHY, MXF_PHY, MYF_PHY, MZF_PHY, MZM_PHY
USE YOMHOOK, ONLY: LHOOK, DR_HOOK
!
USE MODD_CST, ONLY: CST_t
@@ -243,7 +243,7 @@ USE MODD_PARAMETERS, ONLY: JPVEXT_TURB, JPHEXT, XUNDEF
USE MODD_TURB_n, ONLY: TURB_t
!
USE MODE_GRADIENT_W_PHY, ONLY: GZ_W_M_PHY
-USE MODE_IO_FIELD_WRITE, ONLY: IO_FIELD_WRITE_PHY
+USE MODE_IO_FIELD_WRITE_PHY, ONLY: IO_FIELD_WRITE_PHY
USE MODE_PRANDTL
USE MODE_TM06_H, ONLY: TM06_H
USE MODE_TRIDIAG_THERMO, ONLY: TRIDIAG_THERMO
@@ -490,7 +490,7 @@ IF (TURBN%LLEONARD) THEN
CALL MYF_PHY(D,PHGRAD(:,:,2),ZWORK3) ! GY_W_VW(PWM)
CALL MZM_PHY(D,PHGRAD(:,:,4),ZWORK4) ! GY_M_M(PTHLM)
!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
- ZF_LEONARD (IIJB:IIJE,1:IKT)= TURBN%XCOEFHGRADTHL*PDXX(IIJB:IIJE,1:IKT)*PDYY(IIJB:IIJE,1:IKT)/12.0*( &
+ ZF_LEONARD(IIJB:IIJE,1:IKT)= TURBN%XCOEFHGRADTHL*PDXX(IIJB:IIJE,1:IKT)*PDYY(IIJB:IIJE,1:IKT)/12.0*( &
ZWORK1(IIJB:IIJE,1:IKT)*ZWORK2(IIJB:IIJE,1:IKT) &
+ ZWORK3(IIJB:IIJE,1:IKT)*ZWORK4(IIJB:IIJE,1:IKT))
!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
@@ -888,7 +888,7 @@ IF (KRR /= 0) THEN
CALL MYF_PHY(D,PHGRAD(:,:,2),ZWORK3) ! GY_W_VW(PWM)
CALL MZM_PHY(D,PHGRAD(:,:,6),ZWORK4) ! GY_M_M(PRM)
!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
- ZF_LEONARD (IIJB:IIJE,1:IKT)= TURBN%XCOEFHGRADTHL*PDXX(IIJB:IIJE,1:IKT)*PDYY(IIJB:IIJE,1:IKT)/12.0*( &
+ ZF_LEONARD(IIJB:IIJE,1:IKT)= TURBN%XCOEFHGRADTHL*PDXX(IIJB:IIJE,1:IKT)*PDYY(IIJB:IIJE,1:IKT)/12.0*( &
ZWORK1(IIJB:IIJE,1:IKT)*ZWORK2(IIJB:IIJE,1:IKT) &
+ ZWORK3(IIJB:IIJE,1:IKT)*ZWORK4(IIJB:IIJE,1:IKT))
!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
diff --git a/src/PHYEX/turb/shallow_mf.f90 b/src/PHYEX/turb/shallow_mf.f90
index 898883076890bc04c938b2339d1c956b653fff5c..0eaa8b4056af502c876fde0cc385a7c7f277c8ec 100644
--- a/src/PHYEX/turb/shallow_mf.f90
+++ b/src/PHYEX/turb/shallow_mf.f90
@@ -73,7 +73,7 @@
! ------------
!
USE PARKIND1, ONLY: JPRB
-USE SHUMAN_PHY, ONLY: MXM_PHY, MYM_PHY
+USE MODE_SHUMAN_PHY, ONLY: MXM_PHY, MYM_PHY
USE YOMHOOK, ONLY: LHOOK, DR_HOOK
!
USE MODD_BUDGET, ONLY: TBUDGETCONF_t, TBUDGETDATA, NBUDGET_U, NBUDGET_V, &
@@ -86,7 +86,7 @@ USE MODD_TURB_n, ONLY: TURB_t
USE MODD_CTURB, ONLY: CSTURB_t
USE MODD_PARAMETERS, ONLY: JPSVMAX
!
-USE MODE_BUDGET, ONLY: BUDGET_STORE_ADD_PHY
+USE MODE_BUDGET_PHY, ONLY: BUDGET_STORE_ADD_PHY
USE MODE_COMPUTE_MF_CLOUD, ONLY: COMPUTE_MF_CLOUD
USE MODE_COMPUTE_UPDRAFT, ONLY: COMPUTE_UPDRAFT
USE MODE_COMPUTE_UPDRAFT_RAHA, ONLY: COMPUTE_UPDRAFT_RAHA
diff --git a/src/PHYEX/turb/turb.f90 b/src/PHYEX/turb/turb.f90
index 58e0ba1847373e468597bdfa8ed1590f97281dc0..3cf7afa999a48d7087cbd67d7c483183f9ed3804 100644
--- a/src/PHYEX/turb/turb.f90
+++ b/src/PHYEX/turb/turb.f90
@@ -240,7 +240,7 @@
! ------------
!
USE PARKIND1, ONLY: JPRB
-USE SHUMAN_PHY, ONLY: MZF_PHY,MXF_PHY,MYF_PHY
+USE MODE_SHUMAN_PHY, ONLY: MZF_PHY,MXF_PHY,MYF_PHY
USE YOMHOOK , ONLY: LHOOK, DR_HOOK
!
USE MODD_BUDGET, ONLY: NBUDGET_U, NBUDGET_V, NBUDGET_W, NBUDGET_TH, NBUDGET_RV, NBUDGET_RC, &
@@ -256,7 +256,7 @@ USE MODD_PARAMETERS, ONLY: JPVEXT_TURB, XUNDEF
USE MODD_TURB_n, ONLY: TURB_t
!
USE MODE_BL89, ONLY: BL89
-USE MODE_BUDGET, ONLY: BUDGET_STORE_INIT_PHY, BUDGET_STORE_END_PHY
+USE MODE_BUDGET_PHY, ONLY: BUDGET_STORE_INIT_PHY, BUDGET_STORE_END_PHY
USE MODE_EMOIST, ONLY: EMOIST
USE MODE_ETHETA, ONLY: ETHETA
USE MODE_GRADIENT_U_PHY, ONLY: GZ_U_UW_PHY
@@ -264,7 +264,7 @@ USE MODE_GRADIENT_V_PHY, ONLY: GZ_V_VW_PHY
USE MODE_GRADIENT_W_PHY, ONLY: GZ_W_M_PHY
USE MODE_GRADIENT_M_PHY, ONLY: GZ_M_W_PHY
USE MODE_IBM_MIXINGLENGTH, ONLY: IBM_MIXINGLENGTH
-USE MODE_IO_FIELD_WRITE, ONLY: IO_FIELD_WRITE_PHY
+USE MODE_IO_FIELD_WRITE_PHY, ONLY: IO_FIELD_WRITE_PHY
USE MODE_RMC01, ONLY: RMC01
USE MODE_ROTATE_WIND, ONLY: ROTATE_WIND, UPDATE_ROTATE_WIND
USE MODE_SBL_PHY, ONLY: LMO
@@ -1025,12 +1025,12 @@ CALL TURB_VER(D,CST,CSTURB,TURBN,TLES, &
PSSTFL, PSSTFL_C, PSSRFL_C,PSSUFL_C,PSSVFL_C, &
PSSUFL,PSSVFL )
-IF (HCLOUD == 'LIMA') THEN
- IF (KSV_LIMA_NR.GT.0) PRSVS(:,:,KSV_LIMA_NR) = ZRSVS(:,:,KSV_LIMA_NR)
- IF (KSV_LIMA_NS.GT.0) PRSVS(:,:,KSV_LIMA_NS) = ZRSVS(:,:,KSV_LIMA_NS)
- IF (KSV_LIMA_NG.GT.0) PRSVS(:,:,KSV_LIMA_NG) = ZRSVS(:,:,KSV_LIMA_NG)
- IF (KSV_LIMA_NH.GT.0) PRSVS(:,:,KSV_LIMA_NH) = ZRSVS(:,:,KSV_LIMA_NH)
-END IF
+!IF (HCLOUD == 'LIMA') THEN
+! IF (KSV_LIMA_NR.GT.0) PRSVS(:,:,KSV_LIMA_NR) = ZRSVS(:,:,KSV_LIMA_NR)
+! IF (KSV_LIMA_NS.GT.0) PRSVS(:,:,KSV_LIMA_NS) = ZRSVS(:,:,KSV_LIMA_NS)
+! IF (KSV_LIMA_NG.GT.0) PRSVS(:,:,KSV_LIMA_NG) = ZRSVS(:,:,KSV_LIMA_NG)
+! IF (KSV_LIMA_NH.GT.0) PRSVS(:,:,KSV_LIMA_NH) = ZRSVS(:,:,KSV_LIMA_NH)
+!END IF
IF( BUCONF%LBUDGET_U ) CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_U), 'VTURB', PRUS(:,:) )
IF( BUCONF%LBUDGET_V ) CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_V), 'VTURB', PRVS(:,:) )
@@ -1127,12 +1127,12 @@ IF( TURBN%CTURBDIM == '3DIM' ) THEN
PRUS,PRVS,PRWS,PRTHLS,PRRS,PRSVS )
#endif
!
- IF (HCLOUD == 'LIMA') THEN
- IF (KSV_LIMA_NR.GT.0) PRSVS(:,:,KSV_LIMA_NR) = ZRSVS(:,:,KSV_LIMA_NR)
- IF (KSV_LIMA_NS.GT.0) PRSVS(:,:,KSV_LIMA_NS) = ZRSVS(:,:,KSV_LIMA_NS)
- IF (KSV_LIMA_NG.GT.0) PRSVS(:,:,KSV_LIMA_NG) = ZRSVS(:,:,KSV_LIMA_NG)
- IF (KSV_LIMA_NH.GT.0) PRSVS(:,:,KSV_LIMA_NH) = ZRSVS(:,:,KSV_LIMA_NH)
- END IF
+! IF (HCLOUD == 'LIMA') THEN
+! IF (KSV_LIMA_NR.GT.0) PRSVS(:,:,KSV_LIMA_NR) = ZRSVS(:,:,KSV_LIMA_NR)
+! IF (KSV_LIMA_NS.GT.0) PRSVS(:,:,KSV_LIMA_NS) = ZRSVS(:,:,KSV_LIMA_NS)
+! IF (KSV_LIMA_NG.GT.0) PRSVS(:,:,KSV_LIMA_NG) = ZRSVS(:,:,KSV_LIMA_NG)
+! IF (KSV_LIMA_NH.GT.0) PRSVS(:,:,KSV_LIMA_NH) = ZRSVS(:,:,KSV_LIMA_NH)
+! END IF
!
IF( BUCONF%LBUDGET_U ) CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_U), 'HTURB', PRUS(:,:) )
IF( BUCONF%LBUDGET_V ) CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_V), 'HTURB', PRVS(:,:) )