From b1131c87a5428004cee873d12a5d3140539132c5 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?S=C3=A9bastien=20Riette?= <sebastien.riette@meteo.fr>
Date: Thu, 27 Jan 2022 17:33:51 +0100
Subject: [PATCH] =?UTF-8?q?S=C3=A9bastien=20Riette=2027/01/2022=20modifica?=
=?UTF-8?q?tions=20in=20adjustement?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
Structures for modd_cst, modd_budget, modd_neb and modd_rain_ice_param
New structure for array dimensions
---
docs/TODO | 7 +-
src/arome/aux/modd_budget.F90 | 49 ++--
src/arome/aux/mode_fill_dimphyexn.F90 | 79 ++++++
src/arome/ext/apl_arome.F90 | 4 +-
src/arome/ext/aro_adjust.F90 | 68 ++---
src/arome/ext/aro_adjust.h | 7 +-
src/arome/gmkpack_ignored_files | 1 +
src/arome/micro/ini_rain_ice.F90 | 50 ++--
src/arome/micro/modd_cst.F90 | 100 -------
src/arome/turb/shallow_mf.F90 | 8 +-
src/arome/turb/th_r_from_thl_rt_1d.F90 | 9 +-
src/common/aux/modd_cst.F90 | 174 +++++++++++++
src/common/aux/modd_dimphyexn.F90 | 72 ++++++
src/common/micro/compute_frac_ice.func.h | 54 ++++
src/common/micro/condensation.F90 | 262 ++++++++++---------
src/common/micro/ice_adjust.F90 | 243 +++++++++--------
src/common/micro/modd_neb.F90 | 10 +-
src/common/micro/modd_rain_ice_param.F90 | 286 +++++++++++++++++++--
src/common/micro/mode_compute_frac_ice.F90 | 93 -------
src/common/micro/modi_condensation.F90 | 77 +++---
src/common/micro/modi_ice_adjust.F90 | 103 ++++----
src/mesonh/aux/mode_fill_dimphyexn.F90 | 74 ++++++
src/mesonh/micro/ini_rain_ice.f90 | 27 +-
src/mesonh/micro/modd_cst.f90 | 116 ---------
src/mesonh/turb/shallow_mf.f90 | 7 +-
25 files changed, 1215 insertions(+), 765 deletions(-)
create mode 100644 src/arome/aux/mode_fill_dimphyexn.F90
delete mode 100644 src/arome/micro/modd_cst.F90
create mode 100644 src/common/aux/modd_cst.F90
create mode 100644 src/common/aux/modd_dimphyexn.F90
create mode 100644 src/common/micro/compute_frac_ice.func.h
delete mode 100644 src/common/micro/mode_compute_frac_ice.F90
create mode 100644 src/mesonh/aux/mode_fill_dimphyexn.F90
delete mode 100644 src/mesonh/micro/modd_cst.f90
diff --git a/docs/TODO b/docs/TODO
index 55b6e2dc3..600b726c8 100644
--- a/docs/TODO
+++ b/docs/TODO
@@ -47,12 +47,13 @@ Ce répertoire devra être vidé à la fin du phasage, les modifications nécess
Budgets/DDH
- Le code dans budget_DDH devra être transféré dans mode_budget
-- les routines arome specifiques aux budgets sont dans mpa/micro, il faudrait les mettre ailleurs
+- les routines arome specifiques aux budgets sont dans mpa/micro, il faudrait les mettre dans aux
+- nettoyage necessaire des routines budgets:
+ - etape 1: adaptation GPU en passant la structure => permettra d'identifier avec certitude les variables utiles
+ - etape 2: suppr des codes qui ne sont pas appelés, ménage modd_budget, ini_budget... Je pense que seul aro_ini_budget est utile
SPP
- modd_spp_type est pour l'instant dans mpa/micro/externals mais n'est pas de la microphysique
Gradients/shuman:
- essayer de mettre des abort dans les routines arome (shuman doit suffire)
-
-compute_frac_ice: prendre la solution retenue à la fin de la discussion entre LAERO et GMAP
diff --git a/src/arome/aux/modd_budget.F90 b/src/arome/aux/modd_budget.F90
index 1f0336012..8f7f8a448 100644
--- a/src/arome/aux/modd_budget.F90
+++ b/src/arome/aux/modd_budget.F90
@@ -66,10 +66,29 @@ TYPE TBUDGETDATA
TYPE(TYP_DDH), POINTER :: YDDDH=>NULL()
TYPE(TLDDH), POINTER :: YDLDDH=>NULL()
TYPE(TMDDH), POINTER :: YDMDDH=>NULL()
-ENDTYPE
+ENDTYPE TBUDGETDATA
+!
+TYPE TBUDGETCONF_t
+ LOGICAL :: LBU_ENABLE=.FALSE.
+ LOGICAL :: LBUDGET_U=.FALSE. ! flag to compute budget of RhoJu and/or LES budgets with u
+ LOGICAL :: LBUDGET_V=.FALSE. ! flag to compute budget of RhoJv and/or LES budgets with u
+ LOGICAL :: LBUDGET_W=.FALSE. ! flag to compute budget of RhoJw and/or LES budgets with u
+ LOGICAL :: LBUDGET_TH=.FALSE. ! flag to compute budget of RhoJTh and/or LES budgets with th
+ LOGICAL :: LBUDGET_TKE=.FALSE.! flag to compute budget of RhoJTke and/or LES budgets with Tke
+ LOGICAL :: LBUDGET_RV=.FALSE. ! flag to compute budget of RhoJrv and/or LES budgets with rv
+ LOGICAL :: LBUDGET_RC=.FALSE. ! flag to compute budget of RhoJrc and/or LES budgets with rc
+ LOGICAL :: LBUDGET_RR=.FALSE. ! flag to compute budget of RhoJrr and/or LES budgets with rr
+ LOGICAL :: LBUDGET_RI=.FALSE. ! flag to compute budget of RhoJri and/or LES budgets with ri
+ LOGICAL :: LBUDGET_RS=.FALSE. ! flag to compute budget of RhoJrs and/or LES budgets with rs
+ LOGICAL :: LBUDGET_RG=.FALSE. ! flag to compute budget of RhoJrg and/or LES budgets with rg
+ LOGICAL :: LBUDGET_RH=.FALSE. ! flag to compute budget of RhoJrh and/or LES budgets with rh
+ LOGICAL :: LBUDGET_SV=.FALSE. ! flag to compute budget of RhoJsv and/or LES budgets with sv
+END TYPE TBUDGETCONF_t
+!
+TYPE(TBUDGETCONF_t), TARGET :: TBUCONF
!
! General variables
-LOGICAL :: LBU_ENABLE=.FALSE.
+LOGICAL, POINTER :: LBU_ENABLE=>TBUCONF%LBU_ENABLE
!
INTEGER, DIMENSION(JPBUMAX,JPBUPROMAX) & ! number of processes to be
:: NBUINC=0 ! avoided for every budget
@@ -658,18 +677,18 @@ INTEGER :: NNEUTQG=0
REAL :: XTIME_BU=0. ! budget time in this time-step
REAL :: XTIME_BU_PROCESS=0. ! budget time per process for this time-step
!
-LOGICAL :: LBUDGET_U=.FALSE. ! flag to compute budget of RhoJu and/or LES budgets with u
-LOGICAL :: LBUDGET_V=.FALSE. ! flag to compute budget of RhoJv and/or LES budgets with u
-LOGICAL :: LBUDGET_W=.FALSE. ! flag to compute budget of RhoJw and/or LES budgets with u
-LOGICAL :: LBUDGET_TH=.FALSE. ! flag to compute budget of RhoJTh and/or LES budgets with th
-LOGICAL :: LBUDGET_TKE=.FALSE.! flag to compute budget of RhoJTke and/or LES budgets with Tke
-LOGICAL :: LBUDGET_RV=.FALSE. ! flag to compute budget of RhoJrv and/or LES budgets with rv
-LOGICAL :: LBUDGET_RC=.FALSE. ! flag to compute budget of RhoJrc and/or LES budgets with rc
-LOGICAL :: LBUDGET_RR=.FALSE. ! flag to compute budget of RhoJrr and/or LES budgets with rr
-LOGICAL :: LBUDGET_RI=.FALSE. ! flag to compute budget of RhoJri and/or LES budgets with ri
-LOGICAL :: LBUDGET_RS=.FALSE. ! flag to compute budget of RhoJrs and/or LES budgets with rs
-LOGICAL :: LBUDGET_RG=.FALSE. ! flag to compute budget of RhoJrg and/or LES budgets with rg
-LOGICAL :: LBUDGET_RH=.FALSE. ! flag to compute budget of RhoJrh and/or LES budgets with rh
-LOGICAL :: LBUDGET_SV=.FALSE. ! flag to compute budget of RhoJsv and/or LES budgets with sv
+LOGICAL, POINTER :: LBUDGET_U=>TBUCONF%LBUDGET_U ! flag to compute budget of RhoJu and/or LES budgets with u
+LOGICAL, POINTER :: LBUDGET_V=>TBUCONF%LBUDGET_V ! flag to compute budget of RhoJv and/or LES budgets with u
+LOGICAL, POINTER :: LBUDGET_W=>TBUCONF%LBUDGET_W ! flag to compute budget of RhoJw and/or LES budgets with u
+LOGICAL, POINTER :: LBUDGET_TH=>TBUCONF%LBUDGET_TH ! flag to compute budget of RhoJTh and/or LES budgets with th
+LOGICAL, POINTER :: LBUDGET_TKE=>TBUCONF%LBUDGET_TKE ! flag to compute budget of RhoJTke and/or LES budgets with Tke
+LOGICAL, POINTER :: LBUDGET_RV=>TBUCONF%LBUDGET_RV ! flag to compute budget of RhoJrv and/or LES budgets with rv
+LOGICAL, POINTER :: LBUDGET_RC=>TBUCONF%LBUDGET_RC ! flag to compute budget of RhoJrc and/or LES budgets with rc
+LOGICAL, POINTER :: LBUDGET_RR=>TBUCONF%LBUDGET_RR ! flag to compute budget of RhoJrr and/or LES budgets with rr
+LOGICAL, POINTER :: LBUDGET_RI=>TBUCONF%LBUDGET_RI ! flag to compute budget of RhoJri and/or LES budgets with ri
+LOGICAL, POINTER :: LBUDGET_RS=>TBUCONF%LBUDGET_RS ! flag to compute budget of RhoJrs and/or LES budgets with rs
+LOGICAL, POINTER :: LBUDGET_RG=>TBUCONF%LBUDGET_RG ! flag to compute budget of RhoJrg and/or LES budgets with rg
+LOGICAL, POINTER :: LBUDGET_RH=>TBUCONF%LBUDGET_RH ! flag to compute budget of RhoJrh and/or LES budgets with rh
+LOGICAL, POINTER :: LBUDGET_SV=>TBUCONF%LBUDGET_SV ! flag to compute budget of RhoJsv and/or LES budgets with sv
!
END MODULE MODD_BUDGET
diff --git a/src/arome/aux/mode_fill_dimphyexn.F90 b/src/arome/aux/mode_fill_dimphyexn.F90
new file mode 100644
index 000000000..5df75ef5e
--- /dev/null
+++ b/src/arome/aux/mode_fill_dimphyexn.F90
@@ -0,0 +1,79 @@
+!MNH_LIC Copyright 1995-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_FILL_DIMPHYEX
+IMPLICIT NONE
+CONTAINS
+SUBROUTINE FILL_DIMPHYEX(YDDIMPHYEX, KIT, KJT, KKT, KVEXT, KIE)
+! #########################
+!
+!!
+!! PURPOSE
+!! -------
+! This subroutine computes the dimensions according to the running model.
+!
+!!
+!!** IMPLICIT ARGUMENTS
+!! ------------------
+!! None
+!!
+!! REFERENCE
+!! ---------
+!!
+!! AUTHOR
+!! ------
+!! S. Riette, Météo-France
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original January 2022
+!
+!-----------------------------------------------------------------
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+USE PARKIND1, ONLY : JPRB
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+TYPE(DIMPHYEX_t), INTENT(OUT) :: YDDIMPHYEX ! Structure to fill in
+INTEGER, INTENT(IN) :: KIT, KJT, KKT ! Array dimensions
+INTEGER, INTENT(IN) :: KVEXT ! Number of unphysical points at each end of the vertical axis
+INTEGER, INTENT(IN) :: KIE ! Index of the last horizontal point to consider
+
+!
+!* 0.2 declaration of local variables
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!-------------------------------------------------------------------------------
+!
+IF (LHOOK) CALL DR_HOOK('FILL_DIMPHYEX', 0, ZHOOK_HANDLE)
+!
+YDDIMPHYEX%NIT=KIT
+YDDIMPHYEX%NIB=1
+YDDIMPHYEX%NIE=KIE !used to be KIT before considering KPROMA blocs
+!
+!In AROME, KJT is always 1
+YDDIMPHYEX%NJT=KJT
+YDDIMPHYEX%NJB=1
+YDDIMPHYEX%NJE=KJT
+!
+YDDIMPHYEX%NKL=-1
+YDDIMPHYEX%NKT=KKT
+YDDIMPHYEX%NKA=KKT
+YDDIMPHYEX%NKU=1
+YDDIMPHYEX%NKB=KKT-KVEXT
+YDDIMPHYEX%NKE=1+KVEXT
+YDDIMPHYEX%NKTB=1+KVEXT
+YDDIMPHYEX%NKTE=KKT-KVEXT
+!
+IF (LHOOK) CALL DR_HOOK('FILL_DIMPHYEX', 1, ZHOOK_HANDLE)
+!
+END SUBROUTINE FILL_DIMPHYEX
+END MODULE MODE_FILL_DIMPHYEX
diff --git a/src/arome/ext/apl_arome.F90 b/src/arome/ext/apl_arome.F90
index 298f6c90d..1f62ea886 100644
--- a/src/arome/ext/apl_arome.F90
+++ b/src/arome/ext/apl_arome.F90
@@ -1642,8 +1642,8 @@ IF (LMICRO) THEN
& ZSRCS__(:,1:KLEV),ZNEBMNH_,&
& YDDDH, YDMODEL%YRML_DIAG%YRLDDH, YDMODEL%YRML_DIAG%YRMDDH)
ELSE
-
- CALL ARO_ADJUST (KLEV,IKU,IKL,KFDIA,KLEV,NRR,&
+! CALL ARO_ADJUST (KLON,KIDIA,KFDIA,KLEV,NRR,& !this is the target version
+ CALL ARO_ADJUST (KFDIA,KIDIA,KFDIA,KLEV,NRR,&
& NGFL_EZDIAG, &
& CFRAC_ICE_ADJUST, CCONDENS, CLAMBDA3, LOSUBG_COND, &
& LOSIGMAS, CMICRO, LOCND2, CSUBG_MF_PDF, &
diff --git a/src/arome/ext/aro_adjust.F90 b/src/arome/ext/aro_adjust.F90
index 213a974dd..0713b1c6d 100644
--- a/src/arome/ext/aro_adjust.F90
+++ b/src/arome/ext/aro_adjust.F90
@@ -1,5 +1,5 @@
! ######spl
- SUBROUTINE ARO_ADJUST(KKA,KKU,KKL,KLON,KLEV, KRR, &
+ SUBROUTINE ARO_ADJUST(KLON,KIDIA,KFDIA,KLEV, KRR, &
NGFL_EZDIAG, &
HFRAC_ICE, HCONDENS, HLAMBDA3, OSUBG_COND, &
OSIGMAS, CMICRO, OCND2, HSUBG_MF_PDF, &
@@ -85,13 +85,18 @@
! ------------
!
USE MODD_CONF
-USE MODD_CST
+USE MODD_CST, ONLY: CST
+USE MODD_RAIN_ICE_PARAM, ONLY: RAIN_ICE_PARAM
+USE MODD_NEB, ONLY: NEB
USE MODD_PARAMETERS
USE MODD_RAIN_ICE_DESCR
-USE MODD_BUDGET, ONLY: TBUDGETDATA, NBUDGET_RI
+USE MODD_BUDGET, ONLY: TBUDGETDATA, NBUDGET_RI, TBUCONF
USE MODD_SPP_TYPE
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
!
USE MODI_ICE_ADJUST
+USE MODE_FILL_DIMPHYEX, ONLY: FILL_DIMPHYEX
+!
USE SPP_MOD, ONLY : YSPP_CONFIG,YSPP
!
USE DDH_MIX , ONLY : TYP_DDH
@@ -105,10 +110,9 @@ IMPLICIT NONE
!
!
-INTEGER, INTENT(IN) :: KKA !near ground array index
-INTEGER, INTENT(IN) :: KKU !uppest atmosphere array index
-INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=ARO
-INTEGER, INTENT(IN) :: KLON !NPROMA under CPG
+INTEGER, INTENT(IN) :: KLON ! array length (NPROMA)
+INTEGER, INTENT(IN) :: KIDIA !start index (=1)
+INTEGER, INTENT(IN) :: KFDIA !end index (=KLON only if block is full)
INTEGER, INTENT(IN) :: KLEV !Number of vertical levels
INTEGER, INTENT(IN) :: KRR ! Number of moist variables
INTEGER, INTENT(IN) :: NGFL_EZDIAG ! Diagnostic array dimension
@@ -185,6 +189,7 @@ REAL :: ZMU, ZVAL
REAL, DIMENSION(KLON,1) :: ZSIGQSAT, ZICE_CLD_WGT
INTEGER :: JI
TYPE(TBUDGETDATA), DIMENSION(NBUDGET_RI) :: YLBUDGET !NBUDGET_RI is the one with the highest number
+TYPE(DIMPHYEX_t) :: YLDIMPHYEX
!
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
@@ -195,6 +200,9 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('ARO_ADJUST',0,ZHOOK_HANDLE)
+!Dimensions
+CALL FILL_DIMPHYEX(YLDIMPHYEX, KLON, 1, KLEV, 0, KFDIA)
+
! Copy SPP settings
IF ( YSPP_CONFIG%LSPP ) THEN
@@ -230,13 +238,13 @@ IF (YSPP_PSIGQSAT%LPERT) THEN
ELSE
ZMU = 0.
ENDIF
- DO JI=1,KLON
+ DO JI=KIDIA,KFDIA
ZVAL = &
PSIGQSAT*EXP(ZMU+YSPP_PSIGQSAT%CMPERT*YSPP_PSIGQSAT%PGP2DSPP(JI))
ZSIGQSAT(JI,1) = MAX(YSPP_PSIGQSAT%CLIP(1),MIN(ZVAL,YSPP_PSIGQSAT%CLIP(2)))
ENDDO
ELSE
- ZSIGQSAT(:,1) = PSIGQSAT
+ ZSIGQSAT(KIDIA:KFDIA,1) = PSIGQSAT
ENDIF
! Perturb ICE_CLD_WGT
@@ -246,7 +254,7 @@ IF (YSPP_ICE_CLD_WGT%LPERT) THEN
ELSE
ZMU = 0.
ENDIF
- DO JI=1,KLON
+ DO JI=KIDIA,KFDIA
! Awaiting HARMONIE-AROME physics changes
! ZVAL = &
! XFRMIN(21)* EXP(ZMU+YSPP_ICE_CLD_WGT%CMPERT*YSPP_ICE_CLD_WGT%PGP2DSPP(JI))
@@ -257,7 +265,7 @@ IF (YSPP_ICE_CLD_WGT%LPERT) THEN
ENDDO
ELSE
! ZICE_CLD_WGT(:) = XFRMIN(21)
- ZICE_CLD_WGT(:,1) = 1.5
+ ZICE_CLD_WGT(KIDIA:KFDIA,1) = 1.5
ENDIF
HBUNAME='DEPI'
@@ -287,7 +295,7 @@ IF (CMICRO == 'KESS' .OR. CMICRO == 'ICE3' .OR. CMICRO == 'ICE2' &
SELECT CASE (JRR)
CASE(3,5,6,7) ! rain, snow, graupel and hail
- IF ( MINVAL( PRS(:,:,:,JRR)) < 0.0 ) THEN
+ IF ( MINVAL( PRS(KIDIA:KFDIA,:,:,JRR)) < 0.0 ) THEN
! For AROME, we cannot use MAX_ll so that according to JPP's advises
! we only correct negative values but not the total mass
! compute the total water mass computation
@@ -296,7 +304,7 @@ IF (CMICRO == 'KESS' .OR. CMICRO == 'ICE3' .OR. CMICRO == 'ICE2' &
!
! remove the negative values
!
- PRS(:,:,:,JRR) = MAX( 0., PRS(:,:,:,JRR) )
+ PRS(KIDIA:KFDIA,:,:,JRR) = MAX( 0., PRS(KIDIA:KFDIA,:,:,JRR) )
!
! compute the new total mass
!
@@ -324,14 +332,14 @@ SELECT CASE ( CMICRO )
DO JLEV=1,KLEV
- DO JLON=1,KLON
+ DO JLON=KIDIA,KFDIA
ZT = PTHT(JLON,1,JLEV)*PEXNREF(JLON,1,JLEV)
- ZLV(JLON)=XLVTT +(XCPV-XCL) *(ZT-XTT)
- ZLS(JLON)=XLSTT +(XCPV-XCI) *(ZT-XTT)
- ZCPH(JLON)=XCPD +XCPV*2.*PTSTEP*PRS(JLON,1,JLEV,1)
+ ZLV(JLON)=CST%XLVTT +(CST%XCPV-CST%XCL) *(ZT-CST%XTT)
+ ZLS(JLON)=CST%XLSTT +(CST%XCPV-CST%XCI) *(ZT-CST%XTT)
+ ZCPH(JLON)=CST%XCPD +CST%XCPV*2.*PTSTEP*PRS(JLON,1,JLEV,1)
ENDDO
- DO JLON=1,KLON
+ DO JLON=KIDIA,KFDIA
IF (PRS(JLON,1,JLEV,4) < 0.) THEN
PRS(JLON,1,JLEV,1) = PRS(JLON,1,JLEV,1) + PRS(JLON,1,JLEV,4)
PTHS(JLON,1,JLEV) = PTHS(JLON,1,JLEV) - PRS(JLON,1,JLEV,4) * ZLS(JLON) / ZCPH(JLON) / PEXNREF(JLON,1,JLEV)
@@ -340,7 +348,7 @@ SELECT CASE ( CMICRO )
ENDDO
!
! cloud
- DO JLON=1,KLON
+ DO JLON=KIDIA,KFDIA
IF (PRS(JLON,1,JLEV,2) < 0.) THEN
PRS(JLON,1,JLEV,1) = PRS(JLON,1,JLEV,1) + PRS(JLON,1,JLEV,2)
PTHS(JLON,1,JLEV) = PTHS(JLON,1,JLEV) - PRS(JLON,1,JLEV,2) * ZLV(JLON) / ZCPH(JLON) / PEXNREF(JLON,1,JLEV)
@@ -350,7 +358,7 @@ SELECT CASE ( CMICRO )
!
! if rc or ri are positive, we can correct negative rv
! cloud
- DO JLON=1,KLON
+ DO JLON=KIDIA,KFDIA
LL(JLON) = (PRS(JLON,1,JLEV,1) <0.) .AND. (PRS(JLON,1,JLEV,2)> 0.)
IF (LL(JLON)) THEN
#ifdef REPRO48
@@ -360,7 +368,7 @@ SELECT CASE ( CMICRO )
#endif
ENDIF
ENDDO
- DO JLON=1,KLON
+ DO JLON=KIDIA,KFDIA
IF (LL(JLON)) THEN
PRS(JLON,1,JLEV,1) = PRS(JLON,1,JLEV,1) + ZCOR(JLON)
PTHS(JLON,1,JLEV) = PTHS(JLON,1,JLEV) - ZCOR(JLON) * ZLV(JLON) / ZCPH(JLON) / PEXNREF(JLON,1,JLEV)
@@ -370,13 +378,13 @@ SELECT CASE ( CMICRO )
! ice
IF (KRR > 3) THEN
- DO JLON=1,KLON
+ DO JLON=KIDIA,KFDIA
LL(JLON) = (PRS(JLON,1,JLEV,1) < 0.).AND.(PRS(JLON,1,JLEV,4) > 0.)
IF (LL(JLON)) THEN
ZCOR(JLON)=MIN(-PRS(JLON,1,JLEV,1),PRS(JLON,1,JLEV,4))
ENDIF
ENDDO
- DO JLON=1,KLON
+ DO JLON=KIDIA,KFDIA
IF (LL(JLON)) THEN
PRS(JLON,1,JLEV,1) = PRS(JLON,1,JLEV,1) + ZCOR(JLON)
PTHS(JLON,1,JLEV) = PTHS(JLON,1,JLEV) - ZCOR(JLON) * ZLS(JLON) / ZCPH(JLON) / PEXNREF(JLON,1,JLEV)
@@ -418,23 +426,23 @@ ENDDO
!
DO JRR = 0,KRR
IF (JRR==0) THEN
- ZRS(:,:,:,0)=PTHS(:,:,:)*2.*PTSTEP
+ ZRS(KIDIA:KFDIA,:,:,0)=PTHS(KIDIA:KFDIA,:,:)*2.*PTSTEP
ELSE
- ZRS(:,:,:,JRR)=PRS(:,:,:,JRR)*2.*PTSTEP
+ ZRS(KIDIA:KFDIA,:,:,JRR)=PRS(KIDIA:KFDIA,:,:,JRR)*2.*PTSTEP
ENDIF
ENDDO
-ZZZ(:,:,:) = PZZF(:,:,:)
+ZZZ(KIDIA:KFDIA,:,:) = PZZF(KIDIA:KFDIA,:,:)
!
!* 9.2 Perform the saturation adjustment over cloud ice and cloud water
!
IF (KRR==6) THEN
- CALL ICE_ADJUST ( KKA=KKA,KKU=KKU,KKL=KKL,KRR=KRR,&
+ CALL ICE_ADJUST ( YLDIMPHYEX, CST=CST, ICEP=RAIN_ICE_PARAM, NEB=NEB, BUCONF=TBUCONF, KRR=KRR,&
& HFRAC_ICE=HFRAC_ICE, HCONDENS=HCONDENS, HLAMBDA3=HLAMBDA3, HBUNAME=HBUNAME, &
& OSUBG_COND=OSUBG_COND, OSIGMAS=OSIGMAS, &
& OCND2=OCND2, HSUBG_MF_PDF=HSUBG_MF_PDF, &
& PTSTEP=ZTWOTSTEP,PSIGQSAT=ZSIGQSAT, &
& PRHODJ=PRHODJ ,PEXNREF=PEXNREF, PRHODREF=PRHODREF, &
- & PSIGS=PSIGS, PMFCONV=PMFCONV, PPABST=PPABSM, PZZ=ZZZ, &
+ & PSIGS=PSIGS, LMFCONV=.TRUE., PMFCONV=PMFCONV, PPABST=PPABSM, PZZ=ZZZ, &
& PEXN=PEXNREF, PCF_MF=PCF_MF,PRC_MF=PRC_MF,PRI_MF=PRI_MF, &
& PRV=ZRS(:,:,:,1), PRC=ZRS(:,:,:,2), &
& PRVS=PRS(:,:,:,1), PRCS=PRS(:,:,:,2), &
@@ -448,13 +456,13 @@ IF (KRR==6) THEN
& PICE_CLD_WGT=ZICE_CLD_WGT(:,:), &
& TBUDGETS=YLBUDGET, KBUDGETS=SIZE(YLBUDGET))
ELSE
- CALL ICE_ADJUST ( KKA=KKA,KKU=KKU,KKL=KKL,KRR=KRR,&
+ CALL ICE_ADJUST ( YLDIMPHYEX, CST=CST, ICEP=RAIN_ICE_PARAM, NEB=NEB, BUCONF=TBUCONF, KRR=KRR,&
& HFRAC_ICE=HFRAC_ICE, HCONDENS=HCONDENS, HLAMBDA3=HLAMBDA3, HBUNAME=HBUNAME, &
& OSUBG_COND=OSUBG_COND, OSIGMAS=OSIGMAS, &
& OCND2=OCND2, HSUBG_MF_PDF=HSUBG_MF_PDF, &
& PTSTEP=ZTWOTSTEP,PSIGQSAT=ZSIGQSAT, &
& PRHODJ=PRHODJ ,PEXNREF=PEXNREF, PRHODREF=PRHODREF, &
- & PSIGS=PSIGS, PMFCONV=PMFCONV, PPABST=PPABSM, PZZ=ZZZ, &
+ & PSIGS=PSIGS, LMFCONV=.TRUE., PMFCONV=PMFCONV, PPABST=PPABSM, PZZ=ZZZ, &
& PEXN=PEXNREF, PCF_MF=PCF_MF,PRC_MF=PRC_MF,PRI_MF=PRI_MF, &
& PRV=ZRS(:,:,:,1), PRC=ZRS(:,:,:,2), &
& PRVS=PRS(:,:,:,1), PRCS=PRS(:,:,:,2), &
diff --git a/src/arome/ext/aro_adjust.h b/src/arome/ext/aro_adjust.h
index 6f2856602..d79c91146 100644
--- a/src/arome/ext/aro_adjust.h
+++ b/src/arome/ext/aro_adjust.h
@@ -1,5 +1,5 @@
INTERFACE
- SUBROUTINE ARO_ADJUST(KKA,KKU,KKL,KLON,KLEV, KRR,&
+ SUBROUTINE ARO_ADJUST(KLON,KIDIA,KFDIA,KLEV, KRR,&
& NGFL_EZDIAG, &
& HFRAC_ICE, HCONDENS, HLAMBDA3, OSUBG_COND, &
& OSIGMAS, CMICRO, OCND2, HSUBG_MF_PDF,&
@@ -15,10 +15,9 @@ USE SPP_MOD, ONLY : YSPP
USE DDH_MIX, ONLY : TYP_DDH
USE YOMLDDH, ONLY : TLDDH
USE YOMMDDH, ONLY : TMDDH
-INTEGER(KIND=JPIM), INTENT(IN) :: KKA
-INTEGER(KIND=JPIM), INTENT(IN) :: KKU
-INTEGER(KIND=JPIM), INTENT(IN) :: KKL
INTEGER(KIND=JPIM), INTENT(IN) :: KLON
+INTEGER(KIND=JPIM), INTENT(IN) :: KIDIA
+INTEGER(KIND=JPIM), INTENT(IN) :: KFDIA
INTEGER(KIND=JPIM), INTENT(IN) :: KLEV
INTEGER(KIND=JPIM), INTENT(IN) :: KRR
INTEGER(KIND=JPIM), INTENT(IN) :: NGFL_EZDIAG
diff --git a/src/arome/gmkpack_ignored_files b/src/arome/gmkpack_ignored_files
index f4e9b065d..7af12651e 100644
--- a/src/arome/gmkpack_ignored_files
+++ b/src/arome/gmkpack_ignored_files
@@ -101,3 +101,4 @@ phyex/micro/modi_icecloud.F90
phyex/micro/tiwmx_tab.F90
phyex/micro/modi_tiwmx.F90
phyex/micro/modd_spp_type.F90
+phyex/micro/modd_cst.F90
diff --git a/src/arome/micro/ini_rain_ice.F90 b/src/arome/micro/ini_rain_ice.F90
index 023e0e268..021d23402 100644
--- a/src/arome/micro/ini_rain_ice.F90
+++ b/src/arome/micro/ini_rain_ice.F90
@@ -164,7 +164,10 @@ REAL :: PDRYLBDAG_MAX,PDRYLBDAS_MAX,PDRYLBDAG_MIN,PDRYLBDAS_MIN
REAL :: PDRYLBDAR_MAX,PDRYLBDAR_MIN
REAL :: PWETLBDAS_MAX,PWETLBDAG_MAX,PWETLBDAS_MIN,PWETLBDAG_MIN
REAL :: PWETLBDAR_MAX,PWETLBDAH_MAX,PWETLBDAR_MIN,PWETLBDAH_MIN
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------------
+IF (LHOOK) CALL DR_HOOK('INI_RAIN_ICE',0,ZHOOK_HANDLE)
!
!
!* 0. FUNCTION STATEMENTS
@@ -180,8 +183,6 @@ REAL :: PWETLBDAR_MAX,PWETLBDAH_MAX,PWETLBDAR_MIN,PWETLBDAH_MIN
!
!* 1.1 Set the hailstones maximum fall velocity
!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-IF (LHOOK) CALL DR_HOOK('INI_RAIN_ICE',0,ZHOOK_HANDLE)
IF (CSEDIM == 'SPLI') THEN
IF (HCLOUD == 'OLD4') THEN
ZVTRMAX = 40.
@@ -195,7 +196,7 @@ END IF
KSPLITR = 1
IF (CSEDIM == 'SPLI' .AND. HCLOUD(1:3)=='OLD') THEN
SPLIT : DO
- ZT = PTSTEP / FLOAT(KSPLITR)
+ ZT = PTSTEP / REAL(KSPLITR)
IF ( ZT * ZVTRMAX / PDZMIN .LT. 1.) EXIT SPLIT
KSPLITR = KSPLITR + 1
END DO SPLIT
@@ -430,6 +431,7 @@ ZRHO00 = 101325.*(1.+ZRV)/(XRD+ZRV*XRV)/293.15
!
!* 4.2 Constants for sedimentation
!
+IF(.NOT.ASSOCIATED(XFSEDC)) CALL RAIN_ICE_INIT()
XFSEDC(1) = GAMMA(XNUC+(XDC+3.)/XALPHAC)/GAMMA(XNUC+3./XALPHAC)* &
(ZRHO00)**XCEXVT
XFSEDC(2) = GAMMA(XNUC2+(XDC+3.)/XALPHAC2)/GAMMA(XNUC2+3./XALPHAC2)* &
@@ -649,11 +651,11 @@ END IF
NGAMINC = 80
XGAMINC_BOUND_MIN = 1.0E-1 ! Minimal value of (Lbda * D_cs^lim)**alpha
XGAMINC_BOUND_MAX = 1.0E7 ! Maximal value of (Lbda * D_cs^lim)**alpha
-ZRATE = EXP(LOG(XGAMINC_BOUND_MAX/XGAMINC_BOUND_MIN)/FLOAT(NGAMINC-1))
+ZRATE = EXP(LOG(XGAMINC_BOUND_MAX/XGAMINC_BOUND_MIN)/REAL(NGAMINC-1))
!
-IF( .NOT.ALLOCATED(XGAMINC_RIM1) ) ALLOCATE( XGAMINC_RIM1(NGAMINC) )
-IF( .NOT.ALLOCATED(XGAMINC_RIM2) ) ALLOCATE( XGAMINC_RIM2(NGAMINC) )
-IF( .NOT.ALLOCATED(XGAMINC_RIM4) ) ALLOCATE( XGAMINC_RIM4(NGAMINC) )
+IF( .NOT.ASSOCIATED(XGAMINC_RIM1) ) CALL RAIN_ICE_ALLOCATE('XGAMINC_RIM1', NGAMINC)
+IF( .NOT.ASSOCIATED(XGAMINC_RIM2) ) CALL RAIN_ICE_ALLOCATE('XGAMINC_RIM2', NGAMINC)
+IF( .NOT.ASSOCIATED(XGAMINC_RIM4) ) CALL RAIN_ICE_ALLOCATE('XGAMINC_RIM4', NGAMINC)
!
DO J1=1,NGAMINC
ZBOUND = XGAMINC_BOUND_MIN*ZRATE**(J1-1)
@@ -687,13 +689,13 @@ XLBSACCR3 = MOMG(XALPHAS,XNUS,XBS+2.)
NACCLBDAS = 40
XACCLBDAS_MIN = 5.0E1 ! Minimal value of Lbda_s to tabulate XKER_RACCS
XACCLBDAS_MAX = 5.0E5 ! Maximal value of Lbda_s to tabulate XKER_RACCS
-ZRATE = LOG(XACCLBDAS_MAX/XACCLBDAS_MIN)/FLOAT(NACCLBDAS-1)
+ZRATE = LOG(XACCLBDAS_MAX/XACCLBDAS_MIN)/REAL(NACCLBDAS-1)
XACCINTP1S = 1.0 / ZRATE
XACCINTP2S = 1.0 - LOG( XACCLBDAS_MIN ) / ZRATE
NACCLBDAR = 40
XACCLBDAR_MIN = 1.0E3 ! Minimal value of Lbda_r to tabulate XKER_RACCS
XACCLBDAR_MAX = 1.0E7 ! Maximal value of Lbda_r to tabulate XKER_RACCS
-ZRATE = LOG(XACCLBDAR_MAX/XACCLBDAR_MIN)/FLOAT(NACCLBDAR-1)
+ZRATE = LOG(XACCLBDAR_MAX/XACCLBDAR_MIN)/REAL(NACCLBDAR-1)
XACCINTP1R = 1.0 / ZRATE
XACCINTP2R = 1.0 - LOG( XACCLBDAR_MIN ) / ZRATE
!
@@ -703,9 +705,9 @@ IND = 50 ! Interval number, collection efficiency and infinite diameter
ZESR = 1.0 ! factor used to integrate the dimensional distributions when
ZFDINFTY = 20.0 ! computing the kernels XKER_RACCSS, XKER_RACCS and XKER_SACCRG
!
-IF( .NOT.ALLOCATED(XKER_RACCSS) ) ALLOCATE( XKER_RACCSS(NACCLBDAS,NACCLBDAR) )
-IF( .NOT.ALLOCATED(XKER_RACCS ) ) ALLOCATE( XKER_RACCS (NACCLBDAS,NACCLBDAR) )
-IF( .NOT.ALLOCATED(XKER_SACCRG) ) ALLOCATE( XKER_SACCRG(NACCLBDAR,NACCLBDAS) )
+IF( .NOT.ASSOCIATED(XKER_RACCSS) ) CALL RAIN_ICE_ALLOCATE('XKER_RACCSS', NACCLBDAS,NACCLBDAR)
+IF( .NOT.ASSOCIATED(XKER_RACCS ) ) CALL RAIN_ICE_ALLOCATE('XKER_RACCS', NACCLBDAS,NACCLBDAR)
+IF( .NOT.ASSOCIATED(XKER_SACCRG) ) CALL RAIN_ICE_ALLOCATE('XKER_SACCRG', NACCLBDAR,NACCLBDAS)
!
CALL READ_XKER_RACCS (KACCLBDAS,KACCLBDAR,KND, &
PALPHAS,PNUS,PALPHAR,PNUR,PESR,PBS,PBR,PCS,PDS,PCR,PDR, &
@@ -891,19 +893,19 @@ XLBRDRYG3 = MOMG(XALPHAR,XNUR,5.)
NDRYLBDAR = 40
XDRYLBDAR_MIN = 1.0E3 ! Minimal value of Lbda_r to tabulate XKER_RDRYG
XDRYLBDAR_MAX = 1.0E7 ! Maximal value of Lbda_r to tabulate XKER_RDRYG
-ZRATE = LOG(XDRYLBDAR_MAX/XDRYLBDAR_MIN)/FLOAT(NDRYLBDAR-1)
+ZRATE = LOG(XDRYLBDAR_MAX/XDRYLBDAR_MIN)/REAL(NDRYLBDAR-1)
XDRYINTP1R = 1.0 / ZRATE
XDRYINTP2R = 1.0 - LOG( XDRYLBDAR_MIN ) / ZRATE
NDRYLBDAS = 80
XDRYLBDAS_MIN = 2.5E1 ! Minimal value of Lbda_s to tabulate XKER_SDRYG
XDRYLBDAS_MAX = 2.5E9 ! Maximal value of Lbda_s to tabulate XKER_SDRYG
-ZRATE = LOG(XDRYLBDAS_MAX/XDRYLBDAS_MIN)/FLOAT(NDRYLBDAS-1)
+ZRATE = LOG(XDRYLBDAS_MAX/XDRYLBDAS_MIN)/REAL(NDRYLBDAS-1)
XDRYINTP1S = 1.0 / ZRATE
XDRYINTP2S = 1.0 - LOG( XDRYLBDAS_MIN ) / ZRATE
NDRYLBDAG = 40
XDRYLBDAG_MIN = 1.0E3 ! Min value of Lbda_g to tabulate XKER_SDRYG,XKER_RDRYG
XDRYLBDAG_MAX = 1.0E7 ! Max value of Lbda_g to tabulate XKER_SDRYG,XKER_RDRYG
-ZRATE = LOG(XDRYLBDAG_MAX/XDRYLBDAG_MIN)/FLOAT(NDRYLBDAG-1)
+ZRATE = LOG(XDRYLBDAG_MAX/XDRYLBDAG_MIN)/REAL(NDRYLBDAG-1)
XDRYINTP1G = 1.0 / ZRATE
XDRYINTP2G = 1.0 - LOG( XDRYLBDAG_MIN ) / ZRATE
!
@@ -913,7 +915,7 @@ IND = 50 ! Interval number, collection efficiency and infinite diameter
ZEGS = 1.0 ! factor used to integrate the dimensional distributions when
ZFDINFTY = 20.0 ! computing the kernels XKER_SDRYG
!
-IF( .NOT.ALLOCATED(XKER_SDRYG) ) ALLOCATE( XKER_SDRYG(NDRYLBDAG,NDRYLBDAS) )
+IF( .NOT.ASSOCIATED(XKER_SDRYG) ) CALL RAIN_ICE_ALLOCATE('XKER_SDRYG', NDRYLBDAG,NDRYLBDAS)
!
CALL READ_XKER_SDRYG (KDRYLBDAG,KDRYLBDAS,KND, &
PALPHAG,PNUG,PALPHAS,PNUS,PEGS,PBS,PCG,PDG,PCS,PDS, &
@@ -979,7 +981,7 @@ IND = 50 ! Number of interval used to integrate the dimensional
ZEGR = 1.0 ! distributions when computing the kernel XKER_RDRYG
ZFDINFTY = 20.0
!
-IF( .NOT.ALLOCATED(XKER_RDRYG) ) ALLOCATE( XKER_RDRYG(NDRYLBDAG,NDRYLBDAR) )
+IF( .NOT.ASSOCIATED(XKER_RDRYG) ) CALL RAIN_ICE_ALLOCATE('XKER_RDRYG', NDRYLBDAG,NDRYLBDAR)
!
CALL READ_XKER_RDRYG (KDRYLBDAG,KDRYLBDAR,KND, &
PALPHAG,PNUG,PALPHAR,PNUR,PEGR,PBR,PCG,PDG,PCR,PDR, &
@@ -1089,25 +1091,25 @@ XLBRWETH3 = MOMG(XALPHAR,XNUR,XBR+2.)
NWETLBDAS = 80
XWETLBDAS_MIN = 2.5E1 ! Minimal value of Lbda_s to tabulate XKER_SWETH
XWETLBDAS_MAX = 2.5E9 ! Maximal value of Lbda_s to tabulate XKER_SWETH
-ZRATE = LOG(XWETLBDAS_MAX/XWETLBDAS_MIN)/FLOAT(NWETLBDAS-1)
+ZRATE = LOG(XWETLBDAS_MAX/XWETLBDAS_MIN)/REAL(NWETLBDAS-1)
XWETINTP1S = 1.0 / ZRATE
XWETINTP2S = 1.0 - LOG( XWETLBDAS_MIN ) / ZRATE
NWETLBDAG = 40
XWETLBDAG_MIN = 1.0E3 ! Min value of Lbda_g to tabulate XKER_GWETH
XWETLBDAG_MAX = 1.0E7 ! Max value of Lbda_g to tabulate XKER_GWETH
-ZRATE = LOG(XWETLBDAG_MAX/XWETLBDAG_MIN)/FLOAT(NWETLBDAG-1)
+ZRATE = LOG(XWETLBDAG_MAX/XWETLBDAG_MIN)/REAL(NWETLBDAG-1)
XWETINTP1G = 1.0 / ZRATE
XWETINTP2G = 1.0 - LOG( XWETLBDAG_MIN ) / ZRATE
NWETLBDAR = 40
XWETLBDAR_MIN = 1.0E3 ! Minimal value of Lbda_r to tabulate XKER_RWETH
XWETLBDAR_MAX = 1.0E7 ! Maximal value of Lbda_r to tabulate XKER_RWETH
-ZRATE = LOG(XWETLBDAR_MAX/XWETLBDAR_MIN)/FLOAT(NWETLBDAR-1)
+ZRATE = LOG(XWETLBDAR_MAX/XWETLBDAR_MIN)/REAL(NWETLBDAR-1)
XWETINTP1R = 1.0 / ZRATE
XWETINTP2R = 1.0 - LOG( XWETLBDAR_MIN ) / ZRATE
NWETLBDAH = 40
XWETLBDAH_MIN = 1.0E3 ! Min value of Lbda_h to tabulate XKER_SWETH,XKER_GWETH,XKER_RWETH
XWETLBDAH_MAX = 1.0E7 ! Max value of Lbda_h to tabulate XKER_SWETH,XKER_GWETH,XKER_RWETH
-ZRATE = LOG(XWETLBDAH_MAX/XWETLBDAH_MIN)/FLOAT(NWETLBDAH-1)
+ZRATE = LOG(XWETLBDAH_MAX/XWETLBDAH_MIN)/REAL(NWETLBDAH-1)
XWETINTP1H = 1.0 / ZRATE
XWETINTP2H = 1.0 - LOG( XWETLBDAH_MIN ) / ZRATE
!
@@ -1117,7 +1119,7 @@ IND = 50 ! Interval number, collection efficiency and infinite diameter
ZEHS = 1.0 ! factor used to integrate the dimensional distributions when
ZFDINFTY = 20.0 ! computing the kernels XKER_SWETH
!
-IF( .NOT.ALLOCATED(XKER_SWETH) ) ALLOCATE( XKER_SWETH(NWETLBDAH,NWETLBDAS) )
+IF( .NOT.ASSOCIATED(XKER_SWETH) ) CALL RAIN_ICE_ALLOCATE('XKER_SWETH', NWETLBDAH,NWETLBDAS)
!
CALL READ_XKER_SWETH (KWETLBDAH,KWETLBDAS,KND, &
PALPHAH,PNUH,PALPHAS,PNUS,PEHS,PBS,PCH,PDH,PCS,PDS, &
@@ -1183,7 +1185,7 @@ IND = 50 ! Number of interval used to integrate the dimensional
ZEHG = 1.0 ! distributions when computing the kernel XKER_GWETH
ZFDINFTY = 20.0
!
-IF( .NOT.ALLOCATED(XKER_GWETH) ) ALLOCATE( XKER_GWETH(NWETLBDAH,NWETLBDAG) )
+IF( .NOT.ASSOCIATED(XKER_GWETH) ) CALL RAIN_ICE_ALLOCATE('XKER_GWETH', NWETLBDAH,NWETLBDAG)
!
CALL READ_XKER_GWETH (KWETLBDAH,KWETLBDAG,KND, &
PALPHAH,PNUH,PALPHAG,PNUG,PEHG,PBG,PCH,PDH,PCG,PDG, &
@@ -1249,7 +1251,7 @@ IND = 50 ! Number of interval used to integrate the dimensional
ZEHR = 1.0 ! distributions when computing the kernel XKER_RWETH
ZFDINFTY = 20.0
!
-IF( .NOT.ALLOCATED(XKER_RWETH) ) ALLOCATE( XKER_RWETH(NWETLBDAH,NWETLBDAR) )
+IF( .NOT.ASSOCIATED(XKER_RWETH) ) CALL RAIN_ICE_ALLOCATE('XKER_RWETH', NWETLBDAH,NWETLBDAR)
!
CALL READ_XKER_RWETH (KWETLBDAH,KWETLBDAR,KND, &
PALPHAH,PNUH,PALPHAR,PNUR,PEHR,PBR,PCH,PDH,PCR,PDR, &
diff --git a/src/arome/micro/modd_cst.F90 b/src/arome/micro/modd_cst.F90
deleted file mode 100644
index 1f5d39b52..000000000
--- a/src/arome/micro/modd_cst.F90
+++ /dev/null
@@ -1,100 +0,0 @@
-! ######spl
- MODULE MODD_CST
-! ###############
-!
-!!**** *MODD_CST* - declaration of Physic constants
-!!
-!! PURPOSE
-!! -------
-! The purpose of this declarative module is to declare the
-! Physics constants.
-!
-!!
-!!** IMPLICIT ARGUMENTS
-!! ------------------
-!! None
-!!
-!! REFERENCE
-!! ---------
-!! Book2 of documentation of Meso-NH (MODD_CST)
-!!
-!! AUTHOR
-!! ------
-!! V. Ducrocq *Meteo France*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 16/05/94
-!! J. Stein 02/01/95 add xrholw
-!! J.-P. Pinty 13/12/95 add XALPI,XBETAI,XGAMI
-!! J. Stein 25/07/97 add XTH00
-!! V. Masson 05/10/98 add XRHOLI
-!! C. Mari 31/10/00 add NDAYSEC
-!! V. Masson 01/03/03 add conductivity of ice
-!! R. El Khatib 04/08/14 add pre-computed quantities
-!! J.L. Redelsperger 03/2021 add constants for ocean penetrating solar
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-IMPLICIT NONE
-REAL,SAVE :: XPI ! Pi
-!
-REAL,SAVE :: XDAY,XSIYEA,XSIDAY ! day duration, sideral year duration,
- ! sideral day duration
-!
-REAL,SAVE :: XKARMAN ! von karman constant
-REAL,SAVE :: XLIGHTSPEED ! light speed
-REAL,SAVE :: XPLANCK ! Planck constant
-REAL,SAVE :: XBOLTZ ! Boltzman constant
-REAL,SAVE :: XAVOGADRO ! Avogadro number
-!
-REAL,SAVE :: XRADIUS,XOMEGA ! Earth radius, earth rotation
-REAL,SAVE :: XG ! Gravity constant
-!
-REAL,SAVE :: XP00 ! Reference pressure
-REAL,SAVE :: XP00OCEAN ! Reference pressure for ocean model
-REAL,SAVE :: XRH00OCEAN ! Reference density for ocean model
-!
-REAL,SAVE :: XSTEFAN,XI0 ! Stefan-Boltzman constant, solar constant
-!
-REAL,SAVE :: XMD,XMV ! Molar mass of dry air and molar mass of vapor
-REAL,SAVE :: XRD,XRV ! Gaz constant for dry air, gaz constant for vapor
-REAL,SAVE :: XEPSILO ! XMV/XMD
-REAL,SAVE :: XCPD,XCPV ! Cpd (dry air), Cpv (vapor)
-REAL,SAVE :: XRHOLW ! Volumic mass of liquid water
-REAL,SAVE :: XCL,XCI ! Cl (liquid), Ci (ice)
-REAL,SAVE :: XTT ! Triple point temperature
-REAL,SAVE :: XLVTT ! Vaporization heat constant
-REAL,SAVE :: XLSTT ! Sublimation heat constant
-REAL,SAVE :: XLMTT ! Melting heat constant
-REAL,SAVE :: XESTT ! Saturation vapor pressure at triple point
- ! temperature
-REAL,SAVE :: XALPW,XBETAW,XGAMW ! Constants for saturation vapor
- ! pressure function
-REAL,SAVE :: XALPI,XBETAI,XGAMI ! Constants for saturation vapor
- ! pressure function over solid ice
-REAL,SAVE :: XCONDI ! thermal conductivity of ice (W m-1 K-1)
-REAL,SAVE :: XALPHAOC ! thermal expansion coefficient for ocean (K-1)
-REAL,SAVE :: XBETAOC ! Haline contraction coeff for ocean (S-1)
-REAL,SAVE :: XTH00 ! reference value for the potential temperature
-REAL,SAVE :: XTH00OCEAN ! Ref value for pot temp in ocean model
-REAL,SAVE :: XSA00OCEAN ! Ref value for SAlinity in ocean model
-REAL,SAVE :: XROC=0.69! 3 coeffs for SW penetration in Ocean (Hoecker et al)
-REAL,SAVE :: XD1=1.1
-REAL,SAVE :: XD2=23.
-! Values used in SURFEX CMO
-!REAL,SAVE :: XROC=0.58
-!REAL,SAVE :: XD1=0.35
-!REAL,SAVE :: XD2=23.
-
-REAL,SAVE :: XRHOLI ! Volumic mass of liquid water
-!
-INTEGER, SAVE :: NDAYSEC ! Number of seconds in a day
-!
-REAL,SAVE :: RDSRV ! XRD/XRV
-REAL,SAVE :: RDSCPD ! XRD/XCPD
-REAL,SAVE :: RINVXP00 ! 1./XP00
-
-END MODULE MODD_CST
diff --git a/src/arome/turb/shallow_mf.F90 b/src/arome/turb/shallow_mf.F90
index d73839a6b..4da7b7daa 100644
--- a/src/arome/turb/shallow_mf.F90
+++ b/src/arome/turb/shallow_mf.F90
@@ -62,6 +62,7 @@
USE MODD_CST
USE MODD_PARAMETERS, ONLY: JPVEXT
USE MODD_CMFSHALL
+USE MODD_NEB, ONLY: NEB
USE MODI_THL_RT_FROM_TH_R_MF
USE MODI_COMPUTE_UPDRAFT
@@ -70,7 +71,6 @@ USE MODI_COMPUTE_UPDRAFT_RAHA
USE MODI_MF_TURB
USE MODI_MF_TURB_EXPL
USE MODI_COMPUTE_MF_CLOUD
-USE MODE_COMPUTE_FRAC_ICE, ONLY : COMPUTE_FRAC_ICE
!
IMPLICIT NONE
@@ -187,7 +187,7 @@ ZFRAC_ICE(:,:) = 0.
WHERE(PRM(:,:,2)+PRM(:,:,4) > 1.E-20)
ZFRAC_ICE(:,:) = PRM(:,:,4) / (PRM(:,:,2)+PRM(:,:,4))
ENDWHERE
-CALL COMPUTE_FRAC_ICE(HFRAC_ICE,ZFRAC_ICE(:,:),PTHM(:,:)*PEXNM(:,:), IERR(:,:))
+CALL COMPUTE_FRAC_ICE(HFRAC_ICE,NEB,ZFRAC_ICE(:,:),PTHM(:,:)*PEXNM(:,:), IERR(:,:))
! Conservative variables at t-dt
CALL THL_RT_FROM_TH_R_MF(KRR,KRRL,KRRI, &
@@ -295,4 +295,8 @@ IF( HMF_UPDRAFT == 'DUAL') THEN
ENDIF
!
IF (LHOOK) CALL DR_HOOK('SHALLOW_MF',1,ZHOOK_HANDLE)
+!
+CONTAINS
+INCLUDE "compute_frac_ice.func.h"
+!
END SUBROUTINE SHALLOW_MF
diff --git a/src/arome/turb/th_r_from_thl_rt_1d.F90 b/src/arome/turb/th_r_from_thl_rt_1d.F90
index f553f4585..fe0cc27db 100644
--- a/src/arome/turb/th_r_from_thl_rt_1d.F90
+++ b/src/arome/turb/th_r_from_thl_rt_1d.F90
@@ -43,8 +43,8 @@
!
USE PARKIND1, ONLY : JPRB
USE YOMHOOK , ONLY : LHOOK, DR_HOOK
-USE MODE_COMPUTE_FRAC_ICE, ONLY : COMPUTE_FRAC_ICE
USE MODD_CST!, ONLY: XP00, XRD, XCPD, XCPV, XCL, XCI, XLVTT, XTT, XLSTT
+USE MODD_NEB, ONLY: NEB
USE MODE_THERMO
!
IMPLICIT NONE
@@ -128,7 +128,7 @@ DO II=1,JITER
PFRAC_ICE(J) = PRI(J) / (PRL(J)+PRI(J))
ENDIF
ENDDO
- CALL COMPUTE_FRAC_ICE(HFRAC_ICE,PFRAC_ICE(:),ZT(:), IERR(:))
+ CALL COMPUTE_FRAC_ICE(HFRAC_ICE,NEB,PFRAC_ICE(:),ZT(:), IERR(:))
!Computation of Rvsat and dRsat/dT
!In this version QSAT, QSATI, DQSAT and DQASATI functions are not used
@@ -190,5 +190,8 @@ DO II=1,JITER
ENDDO
IF (LHOOK) CALL DR_HOOK('TH_R_FROM_THL_RT_1D',1,ZHOOK_HANDLE)
-
+!
+CONTAINS
+INCLUDE "compute_frac_ice.func.h"
+!
END SUBROUTINE TH_R_FROM_THL_RT_1D
diff --git a/src/common/aux/modd_cst.F90 b/src/common/aux/modd_cst.F90
new file mode 100644
index 000000000..731699740
--- /dev/null
+++ b/src/common/aux/modd_cst.F90
@@ -0,0 +1,174 @@
+!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 MODD_CST
+! ###############
+!
+!!**** *MODD_CST* - declaration of Physic constants
+!!
+!! PURPOSE
+!! -------
+! The purpose of this declarative module is to declare the
+! Physics constants.
+!
+!!
+!!** IMPLICIT ARGUMENTS
+!! ------------------
+!! None
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation of Meso-NH (MODD_CST)
+!!
+!! AUTHOR
+!! ------
+!! V. Ducrocq *Meteo France*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 16/05/94
+!! J. Stein 02/01/95 add xrholw
+!! J.-P. Pinty 13/12/95 add XALPI,XBETAI,XGAMI
+!! J. Stein 25/07/97 add XTH00
+!! V. Masson 05/10/98 add XRHOLI
+!! C. Mari 31/10/00 add NDAYSEC
+!! V. Masson 01/03/03 add conductivity of ice
+!! R. El Khatib 04/08/14 add pre-computed quantities
+!! J.Escobar : 10/2017 : for real*4 , add XMNH_HUGE_12_LOG
+!! J.L. Redelsperger 03/2021 add constants for ocean penetrating solar
+!! S. Riette: Jan 2022: introduction of a strucuture
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+IMPLICIT NONE
+TYPE CST_t
+REAL :: XPI ! Pi
+!
+REAL :: XDAY,XSIYEA,XSIDAY ! day duration, sideral year duration,
+ ! sideral day duration
+!
+REAL :: XKARMAN ! von karman constant
+REAL :: XLIGHTSPEED ! light speed
+REAL :: XPLANCK ! Planck constant
+REAL :: XBOLTZ ! Boltzman constant
+REAL :: XAVOGADRO ! Avogadro number
+!
+REAL :: XRADIUS,XOMEGA ! Earth radius, earth rotation
+REAL :: XG ! Gravity constant
+!
+REAL :: XP00 ! Reference pressure
+REAL :: XP00OCEAN ! Reference pressure for ocean model
+REAL :: XRH00OCEAN ! Reference density for ocean model
+!
+REAL :: XSTEFAN,XI0 ! Stefan-Boltzman constant, solar constant
+!
+REAL :: XMD,XMV ! Molar mass of dry air and molar mass of vapor
+REAL :: XRD,XRV ! Gaz constant for dry air, gaz constant for vapor
+REAL :: XEPSILO ! XMV/XMD
+REAL :: XCPD,XCPV ! Cpd (dry air), Cpv (vapor)
+REAL :: XRHOLW ! Volumic mass of liquid water
+REAL :: XCL,XCI ! Cl (liquid), Ci (ice)
+REAL :: XTT ! Triple point temperature
+REAL :: XLVTT ! Vaporization heat constant
+REAL :: XLSTT ! Sublimation heat constant
+REAL :: XLMTT ! Melting heat constant
+REAL :: XESTT ! Saturation vapor pressure at triple point
+ ! temperature
+REAL :: XALPW,XBETAW,XGAMW ! Constants for saturation vapor
+ ! pressure function
+REAL :: XALPI,XBETAI,XGAMI ! Constants for saturation vapor
+ ! pressure function over solid ice
+REAL :: XCONDI ! thermal conductivity of ice (W m-1 K-1)
+REAL :: XALPHAOC ! thermal expansion coefficient for ocean (K-1)
+REAL :: XBETAOC ! Haline contraction coeff for ocean (S-1)
+REAL :: XTH00 ! reference value for the potential temperature
+REAL :: XTH00OCEAN ! Ref value for pot temp in ocean model
+REAL :: XSA00OCEAN ! Ref value for SAlinity in ocean model
+REAL :: XROC=0.69! 3 coeffs for SW penetration in Ocean (Hoecker et al)
+REAL :: XD1=1.1
+REAL :: XD2=23.
+! Values used in SURFEX CMO
+!REAL :: XROC=0.58
+!REAL :: XD1=0.35
+!REAL :: XD2=23.
+
+REAL :: XRHOLI ! Volumic mass of liquid water
+!
+INTEGER :: NDAYSEC ! Number of seconds in a day
+!
+REAL :: RDSRV ! XRD/XRV
+REAL :: RDSCPD ! XRD/XCPD
+REAL :: RINVXP00 ! 1./XP00
+!
+! Some machine precision value depending of real4/8 use
+!
+REAL :: XMNH_TINY ! minimum real on this machine
+REAL :: XMNH_TINY_12 ! sqrt(minimum real on this machine)
+REAL :: XMNH_EPSILON ! minimum space with 1.0
+REAL :: XMNH_HUGE ! maximum real on this machine
+REAL :: XMNH_HUGE_12_LOG ! maximum log(sqrt(real)) on this machine
+
+REAL :: XEPS_DT ! default value for DT test
+REAL :: XRES_FLAT_CART ! default flat&cart residual tolerance
+REAL :: XRES_OTHER ! default not flat&cart residual tolerance
+REAL :: XRES_PREP ! default prep residual tolerance
+END TYPE CST_t
+
+TYPE(CST_t), TARGET, SAVE :: CST
+
+REAL, POINTER :: XPI=>CST%XPI
+REAL, POINTER :: XDAY=>CST%XDAY, XSIYEA=>CST%XSIYEA, XSIDAY=>CST%XSIDAY
+REAL, POINTER :: XKARMAN=>CST%XKARMAN
+REAL, POINTER :: XLIGHTSPEED=>CST%XLIGHTSPEED
+REAL, POINTER :: XPLANCK=>CST%XPLANCK
+REAL, POINTER :: XBOLTZ=>CST%XBOLTZ
+REAL, POINTER :: XAVOGADRO=>CST%XAVOGADRO
+REAL, POINTER :: XRADIUS=>CST%XRADIUS, XOMEGA=>CST%XOMEGA
+REAL, POINTER :: XG=>CST%XG
+REAL, POINTER :: XP00=>CST%XP00
+REAL, POINTER :: XP00OCEAN=>CST%XP00OCEAN
+REAL, POINTER :: XRH00OCEAN=>CST%XRH00OCEAN
+REAL, POINTER :: XSTEFAN=>CST%XSTEFAN, XI0=>CST%XI0
+REAL, POINTER :: XMD=>CST%XMD, XMV=>CST%XMV
+REAL, POINTER :: XRD=>CST%XRD, XRV=>CST%XRV
+REAL, POINTER :: XEPSILO=>CST%XEPSILO
+REAL, POINTER :: XCPD=>CST%XCPD, XCPV=>CST%XCPV
+REAL, POINTER :: XRHOLW=>CST%XRHOLW
+REAL, POINTER :: XCL=>CST%XCL, XCI=>CST%XCI
+REAL, POINTER :: XTT=>CST%XTT
+REAL, POINTER :: XLVTT=>CST%XLVTT
+REAL, POINTER :: XLSTT=>CST%XLSTT
+REAL, POINTER :: XLMTT=>CST%XLMTT
+REAL, POINTER :: XESTT=>CST%XESTT
+REAL, POINTER :: XALPW=>CST%XALPW, XBETAW=>CST%XBETAW, XGAMW=>CST%XGAMW
+REAL, POINTER :: XALPI=>CST%XALPI, XBETAI=>CST%XBETAI, XGAMI=>CST%XGAMI
+REAL, POINTER :: XCONDI=>CST%XCONDI
+REAL, POINTER :: XALPHAOC=>CST%XALPHAOC
+REAL, POINTER :: XBETAOC=>CST%XBETAOC
+REAL, POINTER :: XTH00=>CST%XTH00
+REAL, POINTER :: XTH00OCEAN=>CST%XTH00OCEAN
+REAL, POINTER :: XSA00OCEAN=>CST%XSA00OCEAN
+REAL, POINTER :: XROC=>CST%XROC
+REAL, POINTER :: XD1=>CST%XD1
+REAL, POINTER :: XD2=>CST%XD2
+REAL, POINTER :: XRHOLI=>CST%XRHOLI
+INTEGER, POINTER :: NDAYSEC=>CST%NDAYSEC
+REAL, POINTER :: RDSRV=>CST%RDSRV
+REAL, POINTER :: RDSCPD=>CST%RDSCPD
+REAL, POINTER :: RINVXP00=>CST%RINVXP00
+REAL, POINTER :: XMNH_TINY=>CST%XMNH_TINY
+REAL, POINTER :: XMNH_TINY_12=>CST%XMNH_TINY_12
+REAL, POINTER :: XMNH_EPSILON=>CST%XMNH_EPSILON
+REAL, POINTER :: XMNH_HUGE=>CST%XMNH_HUGE
+REAL, POINTER :: XMNH_HUGE_12_LOG=>CST%XMNH_HUGE_12_LOG
+REAL, POINTER :: XEPS_DT=>CST%XEPS_DT
+REAL, POINTER :: XRES_FLAT_CART=>CST%XRES_FLAT_CART
+REAL, POINTER :: XRES_OTHER=>CST%XRES_OTHER
+REAL, POINTER :: XRES_PREP=>CST%XRES_PREP
+!
+END MODULE MODD_CST
diff --git a/src/common/aux/modd_dimphyexn.F90 b/src/common/aux/modd_dimphyexn.F90
new file mode 100644
index 000000000..d644ea4d5
--- /dev/null
+++ b/src/common/aux/modd_dimphyexn.F90
@@ -0,0 +1,72 @@
+!MNH_LIC Copyright 1995-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_DIMPHYEX
+! ####################
+!
+!!**** *MODD_DIMPHYEX* - declaration of dimensions for the physics
+!!
+!! PURPOSE
+!! -------
+! Declaration of array dimensions used by the physics
+!
+!!
+!!** IMPLICIT ARGUMENTS
+!! ------------------
+!! None
+!!
+!! REFERENCE
+!! ---------
+!!
+!! AUTHOR
+!! ------
+!! S. Riette, Météo-France
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original January 2022
+!
+!-----------------------------------------------------------------
+!* 0. DECLARATIONS
+! ------------
+!
+IMPLICIT NONE
+!
+TYPE DIMPHYEX_t
+ !
+ !On x direction
+ INTEGER :: NIT ! Array total dimension
+ INTEGER :: NIB ! First inner mass point index
+ INTEGER :: NIE ! Last inner mass point index
+ !
+ !On y direction
+ INTEGER :: NJT ! Array total dimension
+ INTEGER :: NJB ! First inner mass point index
+ INTEGER :: NJE ! Last inner mass point index
+ !
+ !On z direction
+ !Ordering can be different depending on the host model
+ INTEGER :: NKL ! Order of the vertical levels
+ ! 1: as for Méso-NH, levels are numbered from ground to space
+ ! -1: as for AROME, levels are numbered from space to ground
+ INTEGER :: NKT ! Array total dimension
+ INTEGER :: NKA ! Near ground array index (is an unphysical level if JPVEXT!=0)
+ INTEGER :: NKU ! Uppest atmosphere array index (is an unphysical level if JPVEXT!=0)
+ INTEGER :: NKB ! Near ground physical array index (e.g. equal to 1+JPVEXT if NKL==1)
+ INTEGER :: NKE ! Uppest physical atmosphere array index (e.g. equal to 1+JPVEXT if NKL==-1)
+ INTEGER :: NKTB ! Smaller index of the physical domain (equals to MIN(NKB, NKE)=1+JPVEXT)
+ INTEGER :: NKTE ! Greater index of the physical domain (equals to MAX(NKB, NKE)=NKT-JPVEXT)
+ !Explanations about the different values. To loop on:
+ !* all (including non physical) levels from ground to top of atm: DO JK=NKA, NKU, KKL
+ !* all (including non physical) levels from top of atm to ground: DO JK=NKU, NKA, -KKL
+ !* physical levels only from ground to top of atm: DO JK=NKB, NKE, KKL
+ !* physical levels only from top of atm to ground: DO JK=NKE, NKB, -KKL
+ !* all (including non physical) following the array ordering: DO JK=1, NKT
+ !* physical levels only following the array ordering: DO JK=NKTB, NKTE
+END TYPE DIMPHYEX_t
+!
+END MODULE MODD_DIMPHYEX
+
diff --git a/src/common/micro/compute_frac_ice.func.h b/src/common/micro/compute_frac_ice.func.h
new file mode 100644
index 000000000..f63cfe554
--- /dev/null
+++ b/src/common/micro/compute_frac_ice.func.h
@@ -0,0 +1,54 @@
+!MNH_LIC Copyright 2006-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+ ELEMENTAL SUBROUTINE COMPUTE_FRAC_ICE(HFRAC_ICE,NEB,PFRAC_ICE,PT,KERR)
+
+! ******* TO BE INCLUDED IN THE *CONTAINS* OF A SUBROUTINE, IN ORDER TO EASE AUTOMATIC INLINING ******
+! => Don't use drHook !!!
+!
+!!**** *COMPUTE_FRAC_ICE* - computes ice fraction
+!
+!! AUTHOR
+!! ------
+!! Julien PERGAUD * Meteo-France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 13/03/06
+!! S. Riette April 2011 optimisation
+!! S. Riette 08/2016 add option O
+!! R. El Khatib 12-Aug-2021 written as a include file
+!
+!! --------------------------------------------------------------------------
+USE MODD_NEB, ONLY : NEB_t
+USE MODD_CST, ONLY : XTT
+!
+IMPLICIT NONE
+!
+CHARACTER(LEN=1), INTENT(IN) :: HFRAC_ICE ! scheme to use
+TYPE(NEB_t), INTENT(IN) :: NEB
+REAL, INTENT(IN) :: PT ! temperature
+REAL, INTENT(INOUT) :: PFRAC_ICE ! Ice fraction (1 for ice only, 0 for liquid only)
+INTEGER, INTENT(OUT) :: KERR ! Error code in return
+!
+!------------------------------------------------------------------------
+
+! 1. Compute FRAC_ICE
+!
+KERR=0
+SELECT CASE(HFRAC_ICE)
+ CASE ('T') !using Temperature
+ PFRAC_ICE = MAX( 0., MIN(1., (( NEB%XTMAXMIX - PT ) / ( NEB%XTMAXMIX - NEB%XTMINMIX )) ) ) ! freezing interval
+ CASE ('O') !using Temperature with old formulae
+ PFRAC_ICE = MAX( 0., MIN(1., (( XTT - PT ) / 40.) ) ) ! freezing interval
+ CASE ('N') !No ice
+ PFRAC_ICE = 0.
+ CASE ('S') !Same as previous
+ ! (almost) nothing to do
+ PFRAC_ICE = MAX( 0., MIN(1., PFRAC_ICE ) )
+ CASE DEFAULT
+ KERR=1
+END SELECT
+
+END SUBROUTINE COMPUTE_FRAC_ICE
diff --git a/src/common/micro/condensation.F90 b/src/common/micro/condensation.F90
index 2e8112fc2..e07e87f18 100644
--- a/src/common/micro/condensation.F90
+++ b/src/common/micro/condensation.F90
@@ -4,10 +4,10 @@
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! ######spl
- SUBROUTINE CONDENSATION( KIU, KJU, KKU, KIB, KIE, KJB, KJE, KKB, KKE, KKL, &
+ SUBROUTINE CONDENSATION(D, CST, ICEP, NEB, &
HFRAC_ICE, HCONDENS, HLAMBDA3, &
PPABS, PZZ, PRHODREF, PT, PRV_IN, PRV_OUT, PRC_IN, PRC_OUT, PRI_IN, PRI_OUT, &
- PRS, PRG, PSIGS, PMFCONV, PCLDFR, PSIGRC, OUSERI, &
+ PRS, PRG, PSIGS, LMFCONV, PMFCONV, PCLDFR, PSIGRC, OUSERI, &
OSIGMAS, OCND2, PSIGQSAT, &
PLV, PLS, PCPH, &
PHLC_HRC, PHLC_HCF, PHLI_HRI, PHLI_HCF, &
@@ -84,41 +84,35 @@
!
USE PARKIND1, ONLY : JPRB
USE YOMHOOK , ONLY : LHOOK, DR_HOOK
-USE MODD_CST
-USE MODD_PARAMETERS
-USE MODD_RAIN_ICE_PARAM, ONLY : XCRIAUTC, XCRIAUTI, XACRIAUTI, XBCRIAUTI
-USE MODE_COMPUTE_FRAC_ICE, ONLY : COMPUTE_FRAC_ICE
-USE MODE_TIWMX, ONLY : ESATW, ESATI
-USE MODE_ICECLOUD, ONLY : ICECLOUD
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+USE MODD_CST, ONLY: CST_t
+USE MODD_RAIN_ICE_PARAM, ONLY: RAIN_ICE_PARAM_t
+USE MODD_NEB, ONLY: NEB_t
+USE MODE_TIWMX, ONLY : ESATW, ESATI
+USE MODE_ICECLOUD, ONLY : ICECLOUD
!
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
!
!
-INTEGER, INTENT(IN) :: KIU ! horizontal dimension in x
-INTEGER, INTENT(IN) :: KJU ! horizontal dimension in y
-INTEGER, INTENT(IN) :: KKU ! vertical dimension
-INTEGER, INTENT(IN) :: KIB ! value of the first point in x
-INTEGER, INTENT(IN) :: KIE ! value of the last point in x
-INTEGER, INTENT(IN) :: KJB ! value of the first point in y
-INTEGER, INTENT(IN) :: KJE ! value of the last point in y
-INTEGER, INTENT(IN) :: KKB ! value of the first point in z
-INTEGER, INTENT(IN) :: KKE ! value of the last point in z
-INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+TYPE(CST_t), INTENT(IN) :: CST
+TYPE(RAIN_ICE_PARAM_t), INTENT(IN) :: ICEP
+TYPE(NEB_t), INTENT(IN) :: NEB
CHARACTER(LEN=1), INTENT(IN) :: HFRAC_ICE
CHARACTER(LEN=4), INTENT(IN) :: HCONDENS
CHARACTER(LEN=*), INTENT(IN) :: HLAMBDA3 ! formulation for lambda3 coeff
-REAL, DIMENSION(KIU,KJU,KKU), INTENT(IN) :: PPABS ! pressure (Pa)
-REAL, DIMENSION(KIU,KJU,KKU), INTENT(IN) :: PZZ ! height of model levels (m)
-REAL, DIMENSION(KIU,KJU,KKU), INTENT(IN) :: PRHODREF
-REAL, DIMENSION(KIU,KJU,KKU), INTENT(INOUT) :: PT ! grid scale T (K)
-REAL, DIMENSION(KIU,KJU,KKU), INTENT(IN) :: PRV_IN ! grid scale water vapor mixing ratio (kg/kg) in input
-REAL, DIMENSION(KIU,KJU,KKU), INTENT(OUT) :: PRV_OUT! grid scale water vapor mixing ratio (kg/kg) in output
-REAL, DIMENSION(KIU,KJU,KKU), INTENT(IN) :: PRC_IN ! grid scale r_c mixing ratio (kg/kg) in input
-REAL, DIMENSION(KIU,KJU,KKU), INTENT(OUT) :: PRC_OUT! grid scale r_c mixing ratio (kg/kg) in output
-REAL, DIMENSION(KIU,KJU,KKU), INTENT(IN) :: PRI_IN ! grid scale r_i (kg/kg) in input
-REAL, DIMENSION(KIU,KJU,KKU), INTENT(OUT) :: PRI_OUT! grid scale r_i (kg/kg) in output
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PPABS ! pressure (Pa)
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PZZ ! height of model levels (m)
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PRHODREF
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(INOUT) :: PT ! grid scale T (K)
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PRV_IN ! grid scale water vapor mixing ratio (kg/kg) in input
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(OUT) :: PRV_OUT! grid scale water vapor mixing ratio (kg/kg) in output
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PRC_IN ! grid scale r_c mixing ratio (kg/kg) in input
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(OUT) :: PRC_OUT! grid scale r_c mixing ratio (kg/kg) in output
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PRI_IN ! grid scale r_i (kg/kg) in input
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(OUT) :: PRI_OUT! grid scale r_i (kg/kg) in output
LOGICAL, INTENT(IN) :: OUSERI ! logical switch to compute both
! liquid and solid condensate (OUSERI=.TRUE.)
! or only solid condensate (OUSERI=.FALSE.)
@@ -126,54 +120,59 @@ LOGICAL, INTENT(IN) :: OSIGMAS! use present global Sigma
! or that from turbulence scheme
LOGICAL, INTENT(IN) :: OCND2 ! logical switch to sparate liquid and ice
! more rigid (DEFALT value : .FALSE.)
-REAL, DIMENSION(KIU,KJU), INTENT(IN) :: PSIGQSAT ! use an extra "qsat" variance contribution (OSIGMAS case)
+REAL, DIMENSION(D%NIT,D%NJT), INTENT(IN) :: PSIGQSAT ! use an extra "qsat" variance contribution (OSIGMAS case)
! multiplied by PSIGQSAT
-REAL, DIMENSION(KIU,KJU,KKU), INTENT(IN) :: PRS ! grid scale mixing ration of snow (kg/kg)
-REAL, DIMENSION(KIU,KJU,KKU), INTENT(IN) :: PRG ! grid scale mixing ration of graupel (kg/kg)
-REAL, DIMENSION(KIU,KJU,KKU), INTENT(IN) :: PSIGS ! Sigma_s from turbulence scheme
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PMFCONV! convective mass flux (kg /s m^2)
-REAL, DIMENSION(KIU,KJU,KKU), INTENT(OUT) :: PCLDFR ! cloud fraction
-REAL, DIMENSION(KIU,KJU,KKU), INTENT(OUT) :: PSIGRC ! s r_c / sig_s^2
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PRS ! grid scale mixing ration of snow (kg/kg)
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PRG ! grid scale mixing ration of graupel (kg/kg)
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PSIGS ! Sigma_s from turbulence scheme
+LOGICAL, INTENT(IN) :: LMFCONV ! =SIZE(PMFCONV)!=0
+REAL, DIMENSION(MERGE(D%NIT,0,LMFCONV),&
+ MERGE(D%NJT,0,LMFCONV),&
+ MERGE(D%NKT,0,LMFCONV)), INTENT(IN) :: PMFCONV! convective mass flux (kg /s m^2)
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(OUT) :: PCLDFR ! cloud fraction
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(OUT) :: PSIGRC ! s r_c / sig_s^2
-REAL, DIMENSION(KIU,KJU,KKU), OPTIONAL, INTENT(IN) :: PLV ! Latent heat L_v
-REAL, DIMENSION(KIU,KJU,KKU), OPTIONAL, INTENT(IN) :: PLS ! Latent heat L_s
-REAL, DIMENSION(KIU,KJU,KKU), OPTIONAL, INTENT(IN) :: PCPH ! Specific heat C_ph
-REAL, DIMENSION(KIU,KJU,KKU), OPTIONAL, INTENT(OUT) :: PHLC_HRC
-REAL, DIMENSION(KIU,KJU,KKU), OPTIONAL, INTENT(OUT) :: PHLC_HCF ! cloud fraction
-REAL, DIMENSION(KIU,KJU,KKU), OPTIONAL, INTENT(OUT) :: PHLI_HRI
-REAL, DIMENSION(KIU,KJU,KKU), OPTIONAL, INTENT(OUT) :: PHLI_HCF
-REAL, DIMENSION(KIU,KJU), OPTIONAL, INTENT(IN) :: PICE_CLD_WGT
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), OPTIONAL, INTENT(IN) :: PLV ! Latent heat L_v
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), OPTIONAL, INTENT(IN) :: PLS ! Latent heat L_s
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), OPTIONAL, INTENT(IN) :: PCPH ! Specific heat C_ph
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), OPTIONAL, INTENT(OUT) :: PHLC_HRC
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), OPTIONAL, INTENT(OUT) :: PHLC_HCF ! cloud fraction
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), OPTIONAL, INTENT(OUT) :: PHLI_HRI
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), OPTIONAL, INTENT(OUT) :: PHLI_HCF
+REAL, DIMENSION(D%NIT,D%NJT), OPTIONAL, INTENT(IN) :: PICE_CLD_WGT
!
!
!* 0.2 Declarations of local variables :
!
-INTEGER :: JI, JJ, JK, JKP, JKM, IKTB, IKTE ! loop index
-REAL, DIMENSION(KIU,KJU,KKU) :: ZTLK, ZRT ! work arrays for T_l and total water mixing ratio
-REAL, DIMENSION(KIU,KJU,KKU) :: ZL ! length scale
-INTEGER, DIMENSION(KIU,KJU) :: ITPL ! top levels of troposphere
-REAL, DIMENSION(KIU,KJU) :: ZTMIN ! minimum Temp. related to ITPL
+INTEGER :: JI, JJ, JK, JKP, JKM ! loop index
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT) :: ZTLK, ZRT ! work arrays for T_l and total water mixing ratio
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT) :: ZL ! length scale
+INTEGER, DIMENSION(D%NIT,D%NJT) :: ITPL ! top levels of troposphere
+REAL, DIMENSION(D%NIT,D%NJT) :: ZTMIN ! minimum Temp. related to ITPL
!
-REAL, DIMENSION(KIU,KJU,KKU) :: ZLV, ZLS, ZCPD
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT) :: ZLV, ZLS, ZCPD
REAL :: ZGCOND, ZAUTC, ZAUTI, ZGAUV, ZGAUC, ZGAUI, ZGAUTC, ZGAUTI, ZCRIAUTI ! Used for Gaussian PDF integration
REAL :: ZLVS ! thermodynamics
-REAL, DIMENSION(KIB:KIE) :: ZPV, ZPIV, ZQSL, ZQSI ! thermodynamics
+REAL, DIMENSION(D%NIB:D%NIE) :: ZPV, ZPIV, ZQSL, ZQSI ! thermodynamics
REAL :: ZLL, DZZ, ZZZ ! used for length scales
REAL :: ZAH, ZDRW, ZDTL, ZSIG_CONV ! related to computation of Sig_s
-REAL, DIMENSION(KIB:KIE) :: ZA, ZB, ZSBAR, ZSIGMA, ZQ1 ! related to computation of Sig_s
-REAL, DIMENSION(KIB:KIE) :: ZCOND
-REAL, DIMENSION(KIB:KIE) :: ZFRAC ! Ice fraction
+REAL, DIMENSION(D%NIB:D%NIE) :: ZA, ZB, ZSBAR, ZSIGMA, ZQ1 ! related to computation of Sig_s
+REAL, DIMENSION(D%NIB:D%NIE) :: ZCOND
+REAL, DIMENSION(D%NIB:D%NIE) :: ZFRAC ! Ice fraction
INTEGER :: INQ1
REAL :: ZINC
! related to OCND2 noise check :
REAL :: ZRSP, ZRSW, ZRFRAC, ZRSDIF, ZRCOLD
! related to OCND2 ice cloud calulation :
-REAL, DIMENSION(KIB:KIE) :: ESATW_T
+REAL, DIMENSION(D%NIB:D%NIE) :: ESATW_T
REAL :: ZDUM1,ZDUM2,ZDUM3,ZDUM4,ZPRIFACT
-REAL, DIMENSION(KIU,KJU,KKU) :: TCLD
-REAL :: ZDZ(KIB:KIE), ZARDUM(KIE-KIB+1),ZCLDUM(KIE-KIB+1)
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT) :: TCLD
+REAL :: ZDZ(D%NIB:D%NIE), &
+ ZARDUM(D%NIE-D%NIB+1), ZCLDUM(D%NIE-D%NIB+1)
! end OCND2
REAL(KIND=JPRB) :: ZHOOK_HANDLE
-INTEGER, DIMENSION(KIU) :: IERR
+INTEGER, DIMENSION(D%NIT) :: IERR
+!
!
!* 0.3 Definition of constants :
!
@@ -199,10 +198,7 @@ REAL, DIMENSION(-22:11),PARAMETER :: ZSRC_1D =(/ &
!
!
IF (LHOOK) CALL DR_HOOK('CONDENSATION',0,ZHOOK_HANDLE)
-
-IKTB=1+JPVEXT
-IKTE=KKU-JPVEXT
-
+!
PCLDFR(:,:,:) = 0. ! Initialize values
PSIGRC(:,:,:) = 0. ! Initialize values
ZPRIFACT = 1. ! Initialize value
@@ -212,9 +208,9 @@ IF(OCND2)ZPRIFACT = 0.
!
!-------------------------------------------------------------------------------
! store total water mixing ratio
-DO JK=IKTB,IKTE
- DO JJ=KJB,KJE
- DO JI=KIB,KIE
+DO JK=D%NKTB,D%NKTE
+ DO JJ=D%NJB,D%NJE
+ DO JI=D%NIB,D%NIE
ZRT(JI,JJ,JK) = PRV_IN(JI,JJ,JK) + PRC_IN(JI,JJ,JK) + PRI_IN(JI,JJ,JK)*ZPRIFACT
END DO
END DO
@@ -226,12 +222,12 @@ IF(PRESENT(PLV) .AND. PRESENT(PLS)) THEN
ZLV(:,:,:)=PLV(:,:,:)
ZLS(:,:,:)=PLS(:,:,:)
ELSE
- DO JK=IKTB,IKTE
- DO JJ=KJB,KJE
- DO JI=KIB,KIE
+ DO JK=D%NKTB,D%NKTE
+ DO JJ=D%NJB,D%NJE
+ DO JI=D%NIB,D%NIE
! latent heat of vaporisation/sublimation
- ZLV(JI,JJ,JK) = XLVTT + ( XCPV - XCL ) * ( PT(JI,JJ,JK) - XTT )
- ZLS(JI,JJ,JK) = XLSTT + ( XCPV - XCI ) * ( PT(JI,JJ,JK) - XTT )
+ ZLV(JI,JJ,JK) = CST%XLVTT + ( CST%XCPV - CST%XCL ) * ( PT(JI,JJ,JK) - CST%XTT )
+ ZLS(JI,JJ,JK) = CST%XLSTT + ( CST%XCPV - CST%XCI ) * ( PT(JI,JJ,JK) - CST%XTT )
ENDDO
ENDDO
ENDDO
@@ -239,20 +235,20 @@ ENDIF
IF(PRESENT(PCPH)) THEN
ZCPD(:,:,:)=PCPH(:,:,:)
ELSE
- DO JK=IKTB,IKTE
- DO JJ=KJB,KJE
- DO JI=KIB,KIE
- ZCPD(JI,JJ,JK) = XCPD + XCPV*PRV_IN(JI,JJ,JK) + XCL*PRC_IN(JI,JJ,JK) + XCI*PRI_IN(JI,JJ,JK) + &
- XCI*(PRS(JI,JJ,JK) + PRG(JI,JJ,JK) )
+ DO JK=D%NKTB,D%NKTE
+ DO JJ=D%NJB,D%NJE
+ DO JI=D%NIB,D%NIE
+ ZCPD(JI,JJ,JK) = CST%XCPD + CST%XCPV*PRV_IN(JI,JJ,JK) + CST%XCL*PRC_IN(JI,JJ,JK) + CST%XCI*PRI_IN(JI,JJ,JK) + &
+ CST%XCI*(PRS(JI,JJ,JK) + PRG(JI,JJ,JK) )
ENDDO
ENDDO
ENDDO
ENDIF
! Preliminary calculations needed for computing the "turbulent part" of Sigma_s
IF ( .NOT. OSIGMAS ) THEN
- DO JK=IKTB,IKTE
- DO JJ=KJB,KJE
- DO JI=KIB,KIE
+ DO JK=D%NKTB,D%NKTE
+ DO JJ=D%NJB,D%NJE
+ DO JI=D%NIB,D%NIE
! store temperature at saturation
ZTLK(JI,JJ,JK) = PT(JI,JJ,JK) - ZLV(JI,JJ,JK)*PRC_IN(JI,JJ,JK)/ZCPD(JI,JJ,JK) &
- ZLS(JI,JJ,JK)*PRI_IN(JI,JJ,JK)/ZCPD(JI,JJ,JK)*ZPRIFACT
@@ -260,11 +256,18 @@ IF ( .NOT. OSIGMAS ) THEN
END DO
END DO
! Determine tropopause/inversion height from minimum temperature
- ITPL(:,:) = KIB+1
+#ifdef REPRO48
+ ITPL(:,:) = D%NIB+1
+ !I (Sébastien Riette) don't understand why tropopause level is set
+ !with the index of the second physical point on the horizontal (i.e. 2+JPHEXT)!!!
+ !I assume it is a bug...
+#else
+ ITPL(:,:) = D%NKB+D%NKL
+#endif
ZTMIN(:,:) = 400.
- DO JK = IKTB+1,IKTE-1
- DO JJ=KJB,KJE
- DO JI=KIB,KIE
+ DO JK = D%NKTB+1,D%NKTE-1
+ DO JJ=D%NJB,D%NJE
+ DO JI=D%NIB,D%NIE
IF ( PT(JI,JJ,JK) < ZTMIN(JI,JJ) ) THEN
ZTMIN(JI,JJ) = PT(JI,JJ,JK)
ITPL(JI,JJ) = JK
@@ -273,38 +276,39 @@ IF ( .NOT. OSIGMAS ) THEN
END DO
END DO
! Set the mixing length scale
- ZL(:,:,KKB) = 20.
- DO JK = KKB+KKL,KKE,KKL
- DO JJ=KJB,KJE
- DO JI=KIB,KIE
+ ZL(:,:,D%NKB) = 20.
+ DO JK = D%NKB+D%NKL,D%NKE,D%NKL
+ DO JJ=D%NJB,D%NJE
+ DO JI=D%NIB,D%NIE
! free troposphere
ZL(JI,JJ,JK) = ZL0
- ZZZ = PZZ(JI,JJ,JK) - PZZ(JI,JJ,KKB)
+ ZZZ = PZZ(JI,JJ,JK) - PZZ(JI,JJ,D%NKB)
JKP = ITPL(JI,JJ)
! approximate length for boundary-layer
IF ( ZL0 > ZZZ ) ZL(JI,JJ,JK) = ZZZ
! gradual decrease of length-scale near and above tropopause
- IF ( ZZZ > 0.9*(PZZ(JI,JJ,JKP)-PZZ(JI,JJ,KKB)) ) &
- ZL(JI,JJ,JK) = .6 * ZL(JI,JJ,JK-KKL)
+ IF ( ZZZ > 0.9*(PZZ(JI,JJ,JKP)-PZZ(JI,JJ,D%NKB)) ) &
+ ZL(JI,JJ,JK) = .6 * ZL(JI,JJ,JK-D%NKL)
END DO
END DO
END DO
END IF
!-------------------------------------------------------------------------------
!
-DO JK=IKTB,IKTE
- JKP=MAX(MIN(JK+KKL,IKTE),IKTB)
- JKM=MAX(MIN(JK-KKL,IKTE),IKTB)
- DO JJ=KJB,KJE
+DO JK=D%NKTB,D%NKTE
+ JKP=MAX(MIN(JK+D%NKL,D%NKTE),D%NKTB)
+ JKM=MAX(MIN(JK-D%NKL,D%NKTE),D%NKTB)
+ DO JJ=D%NJB,D%NJE
IF (OCND2) THEN
- ZDZ(KIB:KIE) = PZZ(KIB:KIE,JJ,JKP) - PZZ(KIB:KIE,JJ,JKP+1)
- CALL ICECLOUD(KIE-KIB+1,PPABS(KIB,JJ,JK),PZZ(KIB,JJ,JK),ZDZ(KIB), &
- & PT(KIB,JJ,JK),PRV_IN(KIB,JJ,JK),1.,-1., &
- & ZCLDUM,1.,TCLD(KIB,JJ,JK), &
+ ZDZ(D%NIB:D%NIE) = PZZ(D%NIB:D%NIE,JJ,JKP) - &
+ PZZ(D%NIB:D%NIE,JJ,JKP-D%NKL)
+ CALL ICECLOUD(D%NIE-D%NIB+1,PPABS(D%NIB,JJ,JK),PZZ(D%NIB,JJ,JK),ZDZ(D%NIB), &
+ & PT(D%NIB,JJ,JK),PRV_IN(D%NIB,JJ,JK),1.,-1., &
+ & ZCLDUM,1.,TCLD(D%NIB,JJ,JK), &
& ZARDUM,ZARDUM,ZARDUM,ZARDUM)
! latent heats
! saturated water vapor mixing ratio over liquid water and ice
- DO JI=KIB,KIE
+ DO JI=D%NIB,D%NIE
ESATW_T(JI)=ESATW(PT(JI,JJ,JK))
ZPV(JI) = MIN(ESATW_T(JI), .99*PPABS(JI,JJ,JK))
ZPIV(JI) = MIN(ESATI(PT(JI,JJ,JK)), .99*PPABS(JI,JJ,JK))
@@ -312,24 +316,24 @@ DO JK=IKTB,IKTE
ELSE
! latent heats
! saturated water vapor mixing ratio over liquid water and ice
- DO JI=KIB,KIE
- ZPV(JI) = MIN(EXP( XALPW - XBETAW / PT(JI,JJ,JK) - XGAMW * LOG( PT(JI,JJ,JK) ) ), .99*PPABS(JI,JJ,JK))
- ZPIV(JI) = MIN(EXP( XALPI - XBETAI / PT(JI,JJ,JK) - XGAMI * LOG( PT(JI,JJ,JK) ) ), .99*PPABS(JI,JJ,JK))
+ DO JI=D%NIB,D%NIE
+ ZPV(JI) = MIN(EXP( CST%XALPW - CST%XBETAW / PT(JI,JJ,JK) - CST%XGAMW * LOG( PT(JI,JJ,JK) ) ), .99*PPABS(JI,JJ,JK))
+ ZPIV(JI) = MIN(EXP( CST%XALPI - CST%XBETAI / PT(JI,JJ,JK) - CST%XGAMI * LOG( PT(JI,JJ,JK) ) ), .99*PPABS(JI,JJ,JK))
END DO
ENDIF
!Ice fraction
ZFRAC(:) = 0.
IF (OUSERI .AND. .NOT.OCND2) THEN
- DO JI=KIB,KIE
+ DO JI=D%NIB,D%NIE
IF (PRC_IN(JI,JJ,JK)+PRI_IN(JI,JJ,JK) > 1.E-20) THEN
ZFRAC(JI) = PRI_IN(JI,JJ,JK) / (PRC_IN(JI,JJ,JK)+PRI_IN(JI,JJ,JK))
ENDIF
END DO
- CALL COMPUTE_FRAC_ICE(HFRAC_ICE, ZFRAC(:), PT(:,JJ,JK), IERR) !error code IERR cannot be checked here to not break vectorization
+ CALL COMPUTE_FRAC_ICE(HFRAC_ICE, NEB, ZFRAC(:), PT(:,JJ,JK), IERR) !error code IERR cannot be checked here to not break vectorization
ENDIF
- DO JI=KIB,KIE
- ZQSL(JI) = XRD / XRV * ZPV(JI) / ( PPABS(JI,JJ,JK) - ZPV(JI) )
- ZQSI(JI) = XRD / XRV * ZPIV(JI) / ( PPABS(JI,JJ,JK) - ZPIV(JI) )
+ DO JI=D%NIB,D%NIE
+ ZQSL(JI) = CST%XRD / CST%XRV * ZPV(JI) / ( PPABS(JI,JJ,JK) - ZPV(JI) )
+ ZQSI(JI) = CST%XRD / CST%XRV * ZPIV(JI) / ( PPABS(JI,JJ,JK) - ZPIV(JI) )
! interpolate between liquid and solid as function of temperature
ZQSL(JI) = (1. - ZFRAC(JI)) * ZQSL(JI) + ZFRAC(JI) * ZQSI(JI)
@@ -337,7 +341,7 @@ DO JK=IKTB,IKTE
& ZFRAC(JI) * ZLS(JI,JJ,JK)
! coefficients a and b
- ZAH = ZLVS * ZQSL(JI) / ( XRV * PT(JI,JJ,JK)**2 ) * (XRV * ZQSL(JI) / XRD + 1.)
+ ZAH = ZLVS * ZQSL(JI) / ( CST%XRV * PT(JI,JJ,JK)**2 ) * (CST%XRV * ZQSL(JI) / CST%XRD + 1.)
ZA(JI) = 1. / ( 1. + ZLVS/ZCPD(JI,JJ,JK) * ZAH )
ZB(JI) = ZAH * ZA(JI)
ZSBAR(JI) = ZA(JI) * ( ZRT(JI,JJ,JK) - ZQSL(JI) + &
@@ -346,7 +350,7 @@ DO JK=IKTB,IKTE
! switch to take either present computed value of SIGMAS
! or that of Meso-NH turbulence scheme
IF ( OSIGMAS ) THEN
- DO JI=KIB,KIE
+ DO JI=D%NIB,D%NIE
IF (PSIGQSAT(JI,JJ)/=0.) THEN
ZSIGMA(JI) = SQRT((2*PSIGS(JI,JJ,JK))**2 + (PSIGQSAT(JI,JJ)*ZQSL(JI)*ZA(JI))**2)
ELSE
@@ -354,11 +358,11 @@ DO JK=IKTB,IKTE
END IF
END DO
ELSE
- DO JI=KIB,KIE
+ DO JI=D%NIB,D%NIE
! parameterize Sigma_s with first_order closure
DZZ = PZZ(JI,JJ,JKP) - PZZ(JI,JJ,JKM)
ZDRW = ZRT(JI,JJ,JKP) - ZRT(JI,JJ,JKM)
- ZDTL = ZTLK(JI,JJ,JKP) - ZTLK(JI,JJ,JKM) + XG/ZCPD(JI,JJ,JK) * DZZ
+ ZDTL = ZTLK(JI,JJ,JKP) - ZTLK(JI,JJ,JKM) + CST%XG/ZCPD(JI,JJ,JK) * DZZ
ZLL = ZL(JI,JJ,JK)
! standard deviation due to convection
ZSIG_CONV =0.
@@ -369,41 +373,41 @@ DO JK=IKTB,IKTE
ZSIG_CONV * ZSIG_CONV ) )
END DO
END IF
- DO JI=KIB,KIE
+ DO JI=D%NIB,D%NIE
ZSIGMA(JI)= MAX( 1.E-10, ZSIGMA(JI) )
! normalized saturation deficit
ZQ1(JI) = ZSBAR(JI)/ZSIGMA(JI)
END DO
IF(HCONDENS == 'GAUS') THEN
- DO JI=KIB,KIE
+ DO JI=D%NIB,D%NIE
! Gaussian Probability Density Function around ZQ1
! Computation of ZG and ZGAM(=erf(ZG))
ZGCOND = -ZQ1(JI)/SQRT(2.)
!Approximation of erf function for Gaussian distribution
- ZGAUV = 1 - SIGN(1., ZGCOND) * SQRT(1-EXP(-4*ZGCOND**2/XPI))
+ ZGAUV = 1 - SIGN(1., ZGCOND) * SQRT(1-EXP(-4*ZGCOND**2/CST%XPI))
!Computation Cloud Fraction
PCLDFR(JI,JJ,JK) = MAX( 0., MIN(1.,0.5*ZGAUV))
!Computation of condensate
- ZCOND(JI) = (EXP(-ZGCOND**2)-ZGCOND*SQRT(XPI)*ZGAUV)*ZSIGMA(JI)/SQRT(2.*XPI)
+ ZCOND(JI) = (EXP(-ZGCOND**2)-ZGCOND*SQRT(CST%XPI)*ZGAUV)*ZSIGMA(JI)/SQRT(2.*CST%XPI)
ZCOND(JI) = MAX(ZCOND(JI), 0.)
PSIGRC(JI,JJ,JK) = PCLDFR(JI,JJ,JK)
END DO
!Computation warm/cold Cloud Fraction and content in high water content part
IF(PRESENT(PHLC_HCF) .AND. PRESENT(PHLC_HRC))THEN
- DO JI=KIB,KIE
+ DO JI=D%NIB,D%NIE
IF(1-ZFRAC(JI) > 1.E-20)THEN
- ZAUTC = (ZSBAR(JI) - XCRIAUTC/(PRHODREF(JI,JJ,JK)*(1-ZFRAC(JI))))/ZSIGMA(JI)
+ ZAUTC = (ZSBAR(JI) - ICEP%XCRIAUTC/(PRHODREF(JI,JJ,JK)*(1-ZFRAC(JI))))/ZSIGMA(JI)
ZGAUTC = -ZAUTC/SQRT(2.)
!Approximation of erf function for Gaussian distribution
- ZGAUC = 1 - SIGN(1., ZGAUTC) * SQRT(1-EXP(-4*ZGAUTC**2/XPI))
+ ZGAUC = 1 - SIGN(1., ZGAUTC) * SQRT(1-EXP(-4*ZGAUTC**2/CST%XPI))
PHLC_HCF(JI,JJ,JK) = MAX( 0., MIN(1.,0.5*ZGAUC))
- PHLC_HRC(JI,JJ,JK) = (1-ZFRAC(JI))*(EXP(-ZGAUTC**2)-ZGAUTC*SQRT(XPI)*ZGAUC)*ZSIGMA(JI)/SQRT(2.*XPI)
- PHLC_HRC(JI,JJ,JK) = PHLC_HRC(JI,JJ,JK) + XCRIAUTC/PRHODREF(JI,JJ,JK) * PHLC_HCF(JI,JJ,JK)
+ PHLC_HRC(JI,JJ,JK) = (1-ZFRAC(JI))*(EXP(-ZGAUTC**2)-ZGAUTC*SQRT(CST%XPI)*ZGAUC)*ZSIGMA(JI)/SQRT(2.*CST%XPI)
+ PHLC_HRC(JI,JJ,JK) = PHLC_HRC(JI,JJ,JK) + ICEP%XCRIAUTC/PRHODREF(JI,JJ,JK) * PHLC_HCF(JI,JJ,JK)
PHLC_HRC(JI,JJ,JK) = MAX(PHLC_HRC(JI,JJ,JK), 0.)
ELSE
PHLC_HCF(JI,JJ,JK)=0.
@@ -413,15 +417,15 @@ DO JK=IKTB,IKTE
ENDIF
IF(PRESENT(PHLI_HCF) .AND. PRESENT(PHLI_HRI))THEN
- DO JI=KIB,KIE
+ DO JI=D%NIB,D%NIE
IF(ZFRAC(JI) > 1.E-20)THEN
- ZCRIAUTI=MIN(XCRIAUTI,10**(XACRIAUTI*(PT(JI,JJ,JK)-XTT)+XBCRIAUTI))
+ ZCRIAUTI=MIN(ICEP%XCRIAUTI,10**(ICEP%XACRIAUTI*(PT(JI,JJ,JK)-CST%XTT)+ICEP%XBCRIAUTI))
ZAUTI = (ZSBAR(JI) - ZCRIAUTI/ZFRAC(JI))/ZSIGMA(JI)
ZGAUTI = -ZAUTI/SQRT(2.)
!Approximation of erf function for Gaussian distribution
- ZGAUI = 1 - SIGN(1., ZGAUTI) * SQRT(1-EXP(-4*ZGAUTI**2/XPI))
+ ZGAUI = 1 - SIGN(1., ZGAUTI) * SQRT(1-EXP(-4*ZGAUTI**2/CST%XPI))
PHLI_HCF(JI,JJ,JK) = MAX( 0., MIN(1.,0.5*ZGAUI))
- PHLI_HRI(JI,JJ,JK) = ZFRAC(JI)*(EXP(-ZGAUTI**2)-ZGAUTI*SQRT(XPI)*ZGAUI)*ZSIGMA(JI)/SQRT(2.*XPI)
+ PHLI_HRI(JI,JJ,JK) = ZFRAC(JI)*(EXP(-ZGAUTI**2)-ZGAUTI*SQRT(CST%XPI)*ZGAUI)*ZSIGMA(JI)/SQRT(2.*CST%XPI)
PHLI_HRI(JI,JJ,JK) = PHLI_HRI(JI,JJ,JK) + ZCRIAUTI*PHLI_HCF(JI,JJ,JK)
PHLI_HRI(JI,JJ,JK) = MAX(PHLI_HRI(JI,JJ,JK), 0.)
ELSE
@@ -432,7 +436,7 @@ DO JK=IKTB,IKTE
ENDIF
ELSEIF(HCONDENS == 'CB02')THEN
- DO JI=KIB,KIE
+ DO JI=D%NIB,D%NIE
!Total condensate
IF (ZQ1(JI) > 0. .AND. ZQ1(JI) <= 2) THEN
ZCOND(JI) = MIN(EXP(-1.)+.66*ZQ1(JI)+.086*ZQ1(JI)**2, 2.) ! We use the MIN function for continuity
@@ -469,7 +473,7 @@ DO JK=IKTB,IKTE
END IF !HCONDENS
IF(.NOT. OCND2) THEN
- DO JI=KIB,KIE
+ DO JI=D%NIB,D%NIE
PRC_OUT(JI,JJ,JK) = (1.-ZFRAC(JI)) * ZCOND(JI) ! liquid condensate
PRI_OUT(JI,JJ,JK) = ZFRAC(JI) * ZCOND(JI) ! solid condensate
PT(JI,JJ,JK) = PT(JI,JJ,JK) + ((PRC_OUT(JI,JJ,JK)-PRC_IN(JI,JJ,JK))*ZLV(JI,JJ,JK) + &
@@ -478,7 +482,7 @@ DO JK=IKTB,IKTE
PRV_OUT(JI,JJ,JK) = ZRT(JI,JJ,JK) - PRC_OUT(JI,JJ,JK) - PRI_OUT(JI,JJ,JK)*ZPRIFACT
END DO
ELSE
- DO JI=KIB,KIE
+ DO JI=D%NIB,D%NIE
PRC_OUT(JI,JJ,JK) = (1.-ZFRAC(JI)) * ZCOND(JI) ! liquid condensate
!
! This check is mainly for noise reduction :
@@ -508,7 +512,7 @@ DO JK=IKTB,IKTE
ZDUM3 = MAX(0.,TCLD(JI,JJ,JK)-PCLDFR(JI,JJ,JK)) ! pure ice cloud part
- IF (JK==IKTB) THEN
+ IF (JK==D%NKTB) THEN
ZDUM4 = PRI_IN(JI,JJ,JK)
ELSE
ZDUM4 = PRI_IN(JI,JJ,JK) + PRS(JI,JJ,JK)*0.5 + PRG(JI,JJ,JK)*0.25
@@ -530,7 +534,7 @@ DO JK=IKTB,IKTE
END DO
END IF ! End OCND2
IF(HLAMBDA3=='CB')THEN
- DO JI=KIB,KIE
+ DO JI=D%NIB,D%NIE
! s r_c/ sig_s^2
! PSIGRC(JI,JJ,JK) = PCLDFR(JI,JJ,JK) ! use simple Gaussian relation
!
@@ -546,4 +550,8 @@ DO JK=IKTB,IKTE
END DO
!
IF (LHOOK) CALL DR_HOOK('CONDENSATION',1,ZHOOK_HANDLE)
+!
+CONTAINS
+INCLUDE "compute_frac_ice.func.h"
+!
END SUBROUTINE CONDENSATION
diff --git a/src/common/micro/ice_adjust.F90 b/src/common/micro/ice_adjust.F90
index 355cb63cc..d2c9d943a 100644
--- a/src/common/micro/ice_adjust.F90
+++ b/src/common/micro/ice_adjust.F90
@@ -4,10 +4,11 @@
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! ##########################################################################
- SUBROUTINE ICE_ADJUST (KKA, KKU, KKL, KRR, HFRAC_ICE, HCONDENS, HLAMBDA3,&
+ SUBROUTINE ICE_ADJUST (D, CST, ICEP, NEB, BUCONF, KRR, &
+ HFRAC_ICE, HCONDENS, HLAMBDA3,&
HBUNAME, OSUBG_COND, OSIGMAS, OCND2, HSUBG_MF_PDF,&
PTSTEP, PSIGQSAT, &
- PRHODJ, PEXNREF, PRHODREF, PSIGS, PMFCONV, &
+ PRHODJ, PEXNREF, PRHODREF, PSIGS, LMFCONV, PMFCONV,&
PPABST, PZZ, &
PEXN, PCF_MF, PRC_MF, PRI_MF, &
PRV, PRC, PRVS, PRCS, PTH, PTHS, PSRCS, PCLDFR, &
@@ -107,15 +108,13 @@
!
USE PARKIND1, ONLY : JPRB
USE YOMHOOK , ONLY : LHOOK, DR_HOOK
-USE MODD_BUDGET, ONLY: TBUDGETDATA, LBU_ENABLE, &
- & LBUDGET_TH, LBUDGET_RV, LBUDGET_RC, LBUDGET_RI, &
- & NBUDGET_TH, NBUDGET_RV, NBUDGET_RC, NBUDGET_RI
-USE MODD_CST, ONLY: XLVTT, XLSTT, XCPV, XCL, XCI, XTT, XCPD, XCPV
-USE MODD_PARAMETERS, ONLY: JPVEXT
-USE MODD_RAIN_ICE_PARAM, ONLY : XCRIAUTC, XCRIAUTI, XACRIAUTI, XBCRIAUTI
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+USE MODD_CST, ONLY: CST_t
+USE MODD_NEB, ONLY: NEB_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, BUDGET_STORE_END
-USE MODE_ll, ONLY: GET_INDICE_ll
!
USE MODI_CONDENSATION
!
@@ -125,9 +124,11 @@ 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(RAIN_ICE_PARAM_t), INTENT(IN) :: ICEP
+TYPE(NEB_t), INTENT(IN) :: NEB
+TYPE(TBUDGETCONF_t), INTENT(IN) :: BUCONF
INTEGER, INTENT(IN) :: KRR ! Number of moist variables
CHARACTER(LEN=1), INTENT(IN) :: HFRAC_ICE
CHARACTER(LEN=80), INTENT(IN) :: HCONDENS
@@ -144,50 +145,55 @@ LOGICAL :: OCND2 ! logical switch to sparate
CHARACTER(LEN=80), INTENT(IN) :: HSUBG_MF_PDF
REAL, INTENT(IN) :: PTSTEP ! Double Time step
! (single if cold start)
-REAL, DIMENSION(:,:), INTENT(IN) :: PSIGQSAT ! coeff applied to qsat variance contribution
-!
-REAL, DIMENSION(:,:,:), CONTIGUOUS, INTENT(IN) :: PRHODJ ! Dry density * Jacobian
-REAL, DIMENSION(:,:,:), CONTIGUOUS, INTENT(IN) :: PEXNREF ! Reference Exner function
-REAL, DIMENSION(:,:,:), CONTIGUOUS, INTENT(IN) :: PRHODREF
-!
-REAL, DIMENSION(:,:,:), CONTIGUOUS, INTENT(IN) :: PSIGS ! Sigma_s at time t
-REAL, DIMENSION(:,:,:), CONTIGUOUS, INTENT(IN) :: PMFCONV ! convective mass flux
-REAL, DIMENSION(:,:,:), CONTIGUOUS, INTENT(IN) :: PPABST ! Absolute Pressure at t
-REAL, DIMENSION(:,:,:), CONTIGUOUS, INTENT(IN) :: PZZ ! height of model layer
-REAL, DIMENSION(:,:,:), CONTIGUOUS, INTENT(IN) :: PEXN ! Exner function
-!
-REAL, DIMENSION(:,:,:), CONTIGUOUS, INTENT(IN) :: PCF_MF! Convective Mass Flux Cloud fraction
-REAL, DIMENSION(:,:,:), CONTIGUOUS, INTENT(IN) :: PRC_MF! Convective Mass Flux liquid mixing ratio
-REAL, DIMENSION(:,:,:), CONTIGUOUS, INTENT(IN) :: PRI_MF! Convective Mass Flux ice mixing ratio
-!
-REAL, DIMENSION(:,:,:), CONTIGUOUS, INTENT(IN) :: PRV ! Water vapor m.r. to adjust
-REAL, DIMENSION(:,:,:), CONTIGUOUS, INTENT(IN) :: PRC ! Cloud water m.r. to adjust
-REAL, DIMENSION(:,:,:), CONTIGUOUS, INTENT(INOUT) :: PRVS ! Water vapor m.r. source
-REAL, DIMENSION(:,:,:), CONTIGUOUS, INTENT(INOUT) :: PRCS ! Cloud water m.r. source
-REAL, DIMENSION(:,:,:), CONTIGUOUS, INTENT(IN) :: PTH ! Theta to adjust
-REAL, DIMENSION(:,:,:), CONTIGUOUS, INTENT(INOUT) :: PTHS ! Theta source
-REAL, DIMENSION(:,:,:), CONTIGUOUS, INTENT(OUT) :: PSRCS ! Second-order flux
- ! s'rc'/2Sigma_s2 at time t+1
- ! multiplied by Lambda_3
-REAL, DIMENSION(:,:,:), CONTIGUOUS, INTENT(OUT) :: PCLDFR ! Cloud fraction
-!
-REAL, DIMENSION(:,:,:), CONTIGUOUS, INTENT(INOUT):: PRIS ! Cloud ice m.r. at t+1
-REAL, DIMENSION(:,:,:), CONTIGUOUS, INTENT(IN) :: PRR ! Rain water m.r. to adjust
-REAL, DIMENSION(:,:,:), CONTIGUOUS, INTENT(IN) :: PRI ! Cloud ice m.r. to adjust
-REAL, DIMENSION(:,:,:), CONTIGUOUS, INTENT(IN) :: PRS ! Aggregate m.r. to adjust
-REAL, DIMENSION(:,:,:), CONTIGUOUS, INTENT(IN) :: PRG ! Graupel m.r. to adjust
-REAL, DIMENSION(:,:,:), CONTIGUOUS, OPTIONAL, INTENT(IN) :: PRH ! Hail m.r. to adjust
-REAL, DIMENSION(:,:,:), CONTIGUOUS, OPTIONAL, INTENT(OUT) :: POUT_RV ! Adjusted value
-REAL, DIMENSION(:,:,:), CONTIGUOUS, OPTIONAL, INTENT(OUT) :: POUT_RC ! Adjusted value
-REAL, DIMENSION(:,:,:), CONTIGUOUS, OPTIONAL, INTENT(OUT) :: POUT_RI ! Adjusted value
-REAL, DIMENSION(:,:,:), CONTIGUOUS, OPTIONAL, INTENT(OUT) :: POUT_TH ! Adjusted value
-REAL, DIMENSION(:,:,:), CONTIGUOUS, OPTIONAL, INTENT(OUT) :: PHLC_HRC
-REAL, DIMENSION(:,:,:), CONTIGUOUS, OPTIONAL, INTENT(OUT) :: PHLC_HCF
-REAL, DIMENSION(:,:,:), CONTIGUOUS, OPTIONAL, INTENT(OUT) :: PHLI_HRI
-REAL, DIMENSION(:,:,:), CONTIGUOUS, OPTIONAL, INTENT(OUT) :: PHLI_HCF
-TYPE(TBUDGETDATA), DIMENSION(KBUDGETS), INTENT(INOUT) :: TBUDGETS
-INTEGER, INTENT(IN) :: KBUDGETS
-REAL, DIMENSION(:,:), CONTIGUOUS, OPTIONAL, INTENT(IN) :: PICE_CLD_WGT
+REAL, DIMENSION(D%NIT,D%NJT), INTENT(IN) :: PSIGQSAT ! coeff applied to qsat variance contribution
+!
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PEXNREF ! Reference Exner function
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PRHODREF
+!
+REAL, DIMENSION(MERGE(D%NIT,0,OSUBG_COND),&
+ MERGE(D%NJT,0,OSUBG_COND),&
+ MERGE(D%NKT,0,OSUBG_COND)), INTENT(IN) :: PSIGS ! Sigma_s at time t
+LOGICAL, INTENT(IN) :: LMFCONV ! =SIZE(PMFCONV)!=0
+REAL, DIMENSION(MERGE(D%NIT,0,LMFCONV),&
+ MERGE(D%NJT,0,LMFCONV),&
+ MERGE(D%NKT,0,LMFCONV)), INTENT(IN) :: PMFCONV ! convective mass flux
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PPABST ! Absolute Pressure at t
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PZZ ! height of model layer
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PEXN ! Exner function
+!
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PCF_MF! Convective Mass Flux Cloud fraction
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PRC_MF! Convective Mass Flux liquid mixing ratio
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PRI_MF! Convective Mass Flux ice mixing ratio
+!
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PRV ! Water vapor m.r. to adjust
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PRC ! Cloud water m.r. to adjust
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(INOUT) :: PRVS ! Water vapor m.r. source
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(INOUT) :: PRCS ! Cloud water m.r. source
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PTH ! Theta to adjust
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(INOUT) :: PTHS ! Theta source
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(OUT) :: PSRCS ! Second-order flux
+ ! s'rc'/2Sigma_s2 at time t+1
+ ! multiplied by Lambda_3
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(OUT) :: PCLDFR ! Cloud fraction
+!
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(INOUT):: PRIS ! Cloud ice m.r. at t+1
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PRR ! Rain water m.r. to adjust
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PRI ! Cloud ice m.r. to adjust
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PRS ! Aggregate m.r. to adjust
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PRG ! Graupel m.r. to adjust
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), OPTIONAL, INTENT(IN) :: PRH ! Hail m.r. to adjust
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), OPTIONAL, INTENT(OUT) :: POUT_RV ! Adjusted value
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), OPTIONAL, INTENT(OUT) :: POUT_RC ! Adjusted value
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), OPTIONAL, INTENT(OUT) :: POUT_RI ! Adjusted value
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), OPTIONAL, INTENT(OUT) :: POUT_TH ! Adjusted value
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), OPTIONAL, INTENT(OUT) :: PHLC_HRC
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), OPTIONAL, INTENT(OUT) :: PHLC_HCF
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), OPTIONAL, INTENT(OUT) :: PHLI_HRI
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), OPTIONAL, INTENT(OUT) :: PHLI_HCF
+TYPE(TBUDGETDATA), DIMENSION(KBUDGETS), INTENT(INOUT) :: TBUDGETS
+INTEGER, INTENT(IN) :: KBUDGETS
+REAL, DIMENSION(D%NIT,D%NJT), OPTIONAL, INTENT(IN) :: PICE_CLD_WGT
!
!* 0.2 Declarations of local variables :
!
@@ -202,16 +208,11 @@ REAL, DIMENSION(SIZE(PEXNREF,1),SIZE(PEXNREF,2),SIZE(PEXNREF,3)) &
REAL :: ZCRIAUT, & ! Autoconversion thresholds
ZHCF, ZHR
!
-INTEGER :: IIU,IJU,IKU! dimensions of dummy arrays
-INTEGER :: IIB,IJB ! Horz index values of the first inner mass points
-INTEGER :: IIE,IJE ! Horz index values of the last inner mass points
-INTEGER :: IKB ! K index value of the first inner mass point
-INTEGER :: IKE ! K index value of the last inner mass point
INTEGER :: JITER,ITERMAX ! iterative loop for first order adjustment
INTEGER :: JI, JJ, JK
!
-REAL, DIMENSION(SIZE(PEXNREF,1),SIZE(PEXNREF,2),SIZE(PEXNREF,3)) :: ZSIGS, ZSRCS
-REAL, DIMENSION(SIZE(PEXNREF,1),SIZE(PEXNREF,2)) :: ZSIGQSAT
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT) :: ZSIGS, ZSRCS
+REAL, DIMENSION(D%NIT,D%NJT) :: ZSIGQSAT
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!-------------------------------------------------------------------------------
@@ -221,19 +222,12 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('ICE_ADJUST',0,ZHOOK_HANDLE)
!
-IIU = SIZE(PEXNREF,1)
-IJU = SIZE(PEXNREF,2)
-IKU = SIZE(PEXNREF,3)
-CALL GET_INDICE_ll(IIB,IJB,IIE,IJE,IIU,IJU)
-IKB=KKA+JPVEXT*KKL
-IKE=KKU-JPVEXT*KKL
-!
ITERMAX=1
!
-IF(LBUDGET_TH) CALL BUDGET_STORE_INIT(TBUDGETS(NBUDGET_TH), TRIM(HBUNAME), PTHS(:, :, :)*PRHODJ(:, :, :))
-IF(LBUDGET_RV) CALL BUDGET_STORE_INIT(TBUDGETS(NBUDGET_RV), TRIM(HBUNAME), PRVS(:, :, :)*PRHODJ(:, :, :))
-IF(LBUDGET_RC) CALL BUDGET_STORE_INIT(TBUDGETS(NBUDGET_RC), TRIM(HBUNAME), PRCS(:, :, :)*PRHODJ(:, :, :))
-IF(LBUDGET_RI) CALL BUDGET_STORE_INIT(TBUDGETS(NBUDGET_RI), TRIM(HBUNAME), PRIS(:, :, :)*PRHODJ(:, :, :))
+IF(BUCONF%LBUDGET_TH) CALL BUDGET_STORE_INIT(TBUDGETS(NBUDGET_TH), TRIM(HBUNAME), PTHS(:, :, :)*PRHODJ(:, :, :))
+IF(BUCONF%LBUDGET_RV) CALL BUDGET_STORE_INIT(TBUDGETS(NBUDGET_RV), TRIM(HBUNAME), PRVS(:, :, :)*PRHODJ(:, :, :))
+IF(BUCONF%LBUDGET_RC) CALL BUDGET_STORE_INIT(TBUDGETS(NBUDGET_RC), TRIM(HBUNAME), PRCS(:, :, :)*PRHODJ(:, :, :))
+IF(BUCONF%LBUDGET_RI) CALL BUDGET_STORE_INIT(TBUDGETS(NBUDGET_RI), TRIM(HBUNAME), PRIS(:, :, :)*PRHODJ(:, :, :))
!-------------------------------------------------------------------------------
!
!* 2. COMPUTE QUANTITIES WITH THE GUESS OF THE FUTURE INSTANT
@@ -247,12 +241,12 @@ DO JITER =1,ITERMAX
!* 2.3 compute the latent heat of vaporization Lv(T*) at t+1
! and the latent heat of sublimation Ls(T*) at t+1
!
- DO JK=1,IKU
- DO JJ=1,IJU
- DO JI=1,IIU
+ DO JK=D%NKTB,D%NKTE
+ DO JJ=D%NJB,D%NJE
+ DO JI=D%NIB,D%NIE
IF (JITER==1) ZT(JI,JJ,JK) = PTH(JI,JJ,JK) * PEXN(JI,JJ,JK)
- ZLV(JI,JJ,JK) = XLVTT + ( XCPV - XCL ) * ( ZT(JI,JJ,JK) -XTT )
- ZLS(JI,JJ,JK) = XLSTT + ( XCPV - XCI ) * ( ZT(JI,JJ,JK) -XTT )
+ ZLV(JI,JJ,JK) = CST%XLVTT + ( CST%XCPV - CST%XCL ) * ( ZT(JI,JJ,JK) -CST%XTT )
+ ZLS(JI,JJ,JK) = CST%XLSTT + ( CST%XCPV - CST%XCI ) * ( ZT(JI,JJ,JK) -CST%XTT )
ENDDO
ENDDO
ENDDO
@@ -272,9 +266,9 @@ ENDDO ! end of the iterative loop
! -------------------------------------------------
!
!
-DO JK=1,IKU
- DO JJ=1,IJU
- DO JI=1,IIU
+DO JK=D%NKTB,D%NKTE
+ DO JJ=D%NJB,D%NJE
+ DO JI=D%NIB,D%NIE
!
!* 5.0 compute the variation of mixing ratio
!
@@ -309,7 +303,7 @@ DO JK=1,IKU
!* 5.2 compute the cloud fraction PCLDFR
!
IF ( .NOT. OSUBG_COND ) THEN
- DO JI=1,IIU
+ DO JI=D%NIB,D%NIE
IF (PRCS(JI,JJ,JK) + PRIS(JI,JJ,JK) > 1.E-12 / PTSTEP) THEN
PCLDFR(JI,JJ,JK) = 1.
ELSE
@@ -320,7 +314,7 @@ DO JK=1,IKU
END IF
ENDDO
ELSE !OSUBG_COND case
- DO JI=1,IIU
+ DO JI=D%NIB,D%NIE
!We limit PRC_MF+PRI_MF to PRVS*PTSTEP to avoid negative humidity
ZW1=PRC_MF(JI,JJ,JK)/PTSTEP
ZW2=PRI_MF(JI,JJ,JK)/PTSTEP
@@ -336,7 +330,7 @@ DO JK=1,IKU
(ZW1 * ZLV(JI,JJ,JK) + ZW2 * ZLS(JI,JJ,JK)) / ZCPH(JI,JJ,JK) / PEXNREF(JI,JJ,JK)
!
IF(PRESENT(PHLC_HRC) .AND. PRESENT(PHLC_HCF)) THEN
- ZCRIAUT=XCRIAUTC/PRHODREF(JI,JJ,JK)
+ ZCRIAUT=ICEP%XCRIAUTC/PRHODREF(JI,JJ,JK)
IF(HSUBG_MF_PDF=='NONE')THEN
IF(ZW1*PTSTEP>PCF_MF(JI,JJ,JK) * ZCRIAUT) THEN
PHLC_HRC(JI,JJ,JK)=PHLC_HRC(JI,JJ,JK)+ZW1*PTSTEP
@@ -364,7 +358,7 @@ DO JK=1,IKU
ENDIF
ENDIF
IF(PRESENT(PHLI_HRI) .AND. PRESENT(PHLI_HCF)) THEN
- ZCRIAUT=MIN(XCRIAUTI,10**(XACRIAUTI*(ZT(JI,JJ,JK)-XTT)+XBCRIAUTI))
+ ZCRIAUT=MIN(ICEP%XCRIAUTI,10**(ICEP%XACRIAUTI*(ZT(JI,JJ,JK)-CST%XTT)+ICEP%XBCRIAUTI))
IF(HSUBG_MF_PDF=='NONE')THEN
IF(ZW2*PTSTEP>PCF_MF(JI,JJ,JK) * ZCRIAUT) THEN
PHLI_HRI(JI,JJ,JK)=PHLI_HRI(JI,JJ,JK)+ZW2*PTSTEP
@@ -392,7 +386,7 @@ DO JK=1,IKU
!
IF(PRESENT(POUT_RV) .OR. PRESENT(POUT_RC) .OR. &
&PRESENT(POUT_RI) .OR. PRESENT(POUT_TH)) THEN
- DO JI=1,IIU
+ DO JI=D%NIB,D%NIE
ZW1=PRC_MF(JI,JJ,JK)
ZW2=PRI_MF(JI,JJ,JK)
IF(ZW1+ZW2>ZRV(JI,JJ,JK)) THEN
@@ -419,10 +413,10 @@ IF(PRESENT(POUT_TH)) POUT_TH=ZT / PEXN(:,:,:)
!* 6. STORE THE BUDGET TERMS
! ----------------------
!
-IF(LBUDGET_TH) CALL BUDGET_STORE_END(TBUDGETS(NBUDGET_TH), TRIM(HBUNAME), PTHS(:, :, :)*PRHODJ(:, :, :))
-IF(LBUDGET_RV) CALL BUDGET_STORE_END(TBUDGETS(NBUDGET_RV), TRIM(HBUNAME), PRVS(:, :, :)*PRHODJ(:, :, :))
-IF(LBUDGET_RC) CALL BUDGET_STORE_END(TBUDGETS(NBUDGET_RC), TRIM(HBUNAME), PRCS(:, :, :)*PRHODJ(:, :, :))
-IF(LBUDGET_RI) CALL BUDGET_STORE_END(TBUDGETS(NBUDGET_RI), TRIM(HBUNAME), PRIS(:, :, :)*PRHODJ(:, :, :))
+IF(BUCONF%LBUDGET_TH) CALL BUDGET_STORE_END(TBUDGETS(NBUDGET_TH), TRIM(HBUNAME), PTHS(:, :, :)*PRHODJ(:, :, :))
+IF(BUCONF%LBUDGET_RV) CALL BUDGET_STORE_END(TBUDGETS(NBUDGET_RV), TRIM(HBUNAME), PRVS(:, :, :)*PRHODJ(:, :, :))
+IF(BUCONF%LBUDGET_RC) CALL BUDGET_STORE_END(TBUDGETS(NBUDGET_RC), TRIM(HBUNAME), PRCS(:, :, :)*PRHODJ(:, :, :))
+IF(BUCONF%LBUDGET_RI) CALL BUDGET_STORE_END(TBUDGETS(NBUDGET_RI), TRIM(HBUNAME), PRIS(:, :, :)*PRHODJ(:, :, :))
!------------------------------------------------------------------------------
!
!
@@ -431,35 +425,40 @@ IF (LHOOK) CALL DR_HOOK('ICE_ADJUST',1,ZHOOK_HANDLE)
CONTAINS
SUBROUTINE ITERATION(PRV_IN,PRC_IN,PRI_IN,PRV_OUT,PRC_OUT,PRI_OUT)
-REAL, DIMENSION(:,:,:), CONTIGUOUS, INTENT(IN) :: PRV_IN ! Water vapor m.r. to adjust in input
-REAL, DIMENSION(:,:,:), CONTIGUOUS, INTENT(IN) :: PRC_IN ! Cloud water m.r. to adjust in input
-REAL, DIMENSION(:,:,:), CONTIGUOUS, INTENT(IN) :: PRI_IN ! Cloud ice m.r. to adjust in input
-REAL, DIMENSION(:,:,:), CONTIGUOUS, INTENT(OUT) :: PRV_OUT ! Water vapor m.r. to adjust in output
-REAL, DIMENSION(:,:,:), CONTIGUOUS, INTENT(OUT) :: PRC_OUT ! Cloud water m.r. to adjust in output
-REAL, DIMENSION(:,:,:), CONTIGUOUS, INTENT(OUT) :: PRI_OUT ! Cloud ice m.r. to adjust in output
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PRV_IN ! Water vapor m.r. to adjust in input
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PRC_IN ! Cloud water m.r. to adjust in input
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PRI_IN ! Cloud ice m.r. to adjust in input
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(OUT) :: PRV_OUT ! Water vapor m.r. to adjust in output
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(OUT) :: PRC_OUT ! Cloud water m.r. to adjust in output
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(OUT) :: PRI_OUT ! Cloud ice m.r. to adjust in output
!
!* 2.4 compute the specific heat for moist air (Cph) at t+1
-
-SELECT CASE(KRR)
- CASE(7)
- ZCPH(:,:,:) = XCPD + XCPV * PRV_IN(:,:,:) &
- + XCL * (PRC_IN(:,:,:) + PRR(:,:,:)) &
- + XCI * (PRI_IN(:,:,:) + PRS(:,:,:) + PRG(:,:,:) + PRH(:,:,:))
- CASE(6)
- ZCPH(:,:,:) = XCPD + XCPV * PRV_IN(:,:,:) &
- + XCL * (PRC_IN(:,:,:) + PRR(:,:,:)) &
- + XCI * (PRI_IN(:,:,:) + PRS(:,:,:) + PRG(:,:,:))
- CASE(5)
- ZCPH(:,:,:) = XCPD + XCPV * PRV_IN(:,:,:) &
- + XCL * (PRC_IN(:,:,:) + PRR(:,:,:)) &
- + XCI * (PRI_IN(:,:,:) + PRS(:,:,:))
- CASE(3)
- ZCPH(:,:,:) = XCPD + XCPV * PRV_IN(:,:,:) &
- + XCL * (PRC_IN(:,:,:) + PRR(:,:,:))
- CASE(2)
- ZCPH(:,:,:) = XCPD + XCPV * PRV_IN(:,:,:) &
- + XCL * PRC_IN(:,:,:)
-END SELECT
+DO JK=D%NKTB,D%NKTE
+ DO JJ=D%NJB,D%NJE
+ DO JI=D%NIB,D%NIE
+ SELECT CASE(KRR)
+ CASE(7)
+ ZCPH(JI,JJ,JK) = CST%XCPD + CST%XCPV * PRV_IN(JI,JJ,JK) &
+ + CST%XCL * (PRC_IN(JI,JJ,JK) + PRR(JI,JJ,JK)) &
+ + CST%XCI * (PRI_IN(JI,JJ,JK) + PRS(JI,JJ,JK) + PRG(JI,JJ,JK) + PRH(JI,JJ,JK))
+ CASE(6)
+ ZCPH(JI,JJ,JK) = CST%XCPD + CST%XCPV * PRV_IN(JI,JJ,JK) &
+ + CST%XCL * (PRC_IN(JI,JJ,JK) + PRR(JI,JJ,JK)) &
+ + CST%XCI * (PRI_IN(JI,JJ,JK) + PRS(JI,JJ,JK) + PRG(JI,JJ,JK))
+ CASE(5)
+ ZCPH(JI,JJ,JK) = CST%XCPD + CST%XCPV * PRV_IN(JI,JJ,JK) &
+ + CST%XCL * (PRC_IN(JI,JJ,JK) + PRR(JI,JJ,JK)) &
+ + CST%XCI * (PRI_IN(JI,JJ,JK) + PRS(JI,JJ,JK))
+ CASE(3)
+ ZCPH(JI,JJ,JK) = CST%XCPD + CST%XCPV * PRV_IN(JI,JJ,JK) &
+ + CST%XCL * (PRC_IN(JI,JJ,JK) + PRR(JI,JJ,JK))
+ CASE(2)
+ ZCPH(JI,JJ,JK) = CST%XCPD + CST%XCPV * PRV_IN(JI,JJ,JK) &
+ + CST%XCL * PRC_IN(JI,JJ,JK)
+ END SELECT
+ ENDDO
+ ENDDO
+ENDDO
!
IF ( OSUBG_COND ) THEN
!
@@ -468,10 +467,10 @@ IF ( OSUBG_COND ) THEN
!
! PSRC= s'rci'/Sigma_s^2
! ZT is INOUT
- CALL CONDENSATION(IIU, IJU, IKU, IIB, IIE, IJB, IJE, IKB, IKE, KKL, &
+ CALL CONDENSATION(D, CST, ICEP, NEB, &
HFRAC_ICE, HCONDENS, HLAMBDA3, &
PPABST, PZZ, PRHODREF, ZT, PRV_IN, PRV_OUT, PRC_IN, PRC_OUT, PRI_IN, PRI_OUT, &
- PRS, PRG, PSIGS, PMFCONV, PCLDFR, &
+ PRS, PRG, PSIGS, LMFCONV, PMFCONV, PCLDFR, &
PSRCS, .TRUE., OSIGMAS, &
OCND2, PSIGQSAT, &
PLV=ZLV, PLS=ZLS, PCPH=ZCPH, &
@@ -487,10 +486,10 @@ ELSE
ZSIGQSAT(:,:)=0.
!We use ZSRCS because in Méso-NH, PSRCS can be a zero-length array in this case
!ZT is INOUT
- CALL CONDENSATION(IIU, IJU, IKU, IIB, IIE, IJB, IJE, IKB, IKE, KKL, &
+ CALL CONDENSATION(D, CST, ICEP, NEB, &
HFRAC_ICE, HCONDENS, HLAMBDA3, &
PPABST, PZZ, PRHODREF, ZT, PRV_IN, PRV_OUT, PRC_IN, PRC_OUT, PRI_IN, PRI_OUT, &
- PRS, PRG, ZSIGS, PMFCONV, PCLDFR, &
+ PRS, PRG, ZSIGS, LMFCONV, PMFCONV, PCLDFR, &
ZSRCS, .TRUE., OSIGMAS=.TRUE., &
OCND2=OCND2, PSIGQSAT=ZSIGQSAT, &
PLV=ZLV, PLS=ZLS, PCPH=ZCPH, &
diff --git a/src/common/micro/modd_neb.F90 b/src/common/micro/modd_neb.F90
index 984059f43..03fa2ecc0 100644
--- a/src/common/micro/modd_neb.F90
+++ b/src/common/micro/modd_neb.F90
@@ -36,8 +36,14 @@
!
IMPLICIT NONE
!
-REAL,SAVE :: XTMINMIX ! minimum temperature of mixed phase
-REAL,SAVE :: XTMAXMIX ! maximum temperature of mixed phase
+TYPE NEB_t
+ REAL :: XTMINMIX ! minimum temperature of mixed phase
+ REAL :: XTMAXMIX ! maximum temperature of mixed phase
+END TYPE NEB_t
+
+TYPE(NEB_t), SAVE, TARGET :: NEB
+
+REAL, POINTER :: XTMINMIX=>NEB%XTMINMIX, XTMAXMIX=>NEB%XTMAXMIX
!
!
END MODULE MODD_NEB
diff --git a/src/common/micro/modd_rain_ice_param.F90 b/src/common/micro/modd_rain_ice_param.F90
index 7568e2a68..4b6951a41 100644
--- a/src/common/micro/modd_rain_ice_param.F90
+++ b/src/common/micro/modd_rain_ice_param.F90
@@ -40,39 +40,40 @@
!
IMPLICIT NONE
!
-REAL,DIMENSION(2),SAVE :: XFSEDC ! Constants for sedimentation fluxes of C
-REAL,SAVE :: XFSEDR,XEXSEDR, & ! Constants for sedimentation
+TYPE RAIN_ICE_PARAM_t
+REAL,DIMENSION(2) :: XFSEDC ! Constants for sedimentation fluxes of C
+REAL :: XFSEDR,XEXSEDR, & ! Constants for sedimentation
XFSEDI,XEXCSEDI,XEXRSEDI, & ! fluxes of R, I, S and G
XFSEDS,XEXSEDS, &
XFSEDG,XEXSEDG
!
-REAL,SAVE :: XNU10,XALPHA1,XBETA1, & ! Constants for heterogeneous
+REAL :: XNU10,XALPHA1,XBETA1, & ! Constants for heterogeneous
XNU20,XALPHA2,XBETA2, & ! ice nucleation : HEN
XMNU0 ! mass of nucleated ice crystal
!
-REAL,SAVE :: XALPHA3,XBETA3, & ! Constants for homogeneous
+REAL :: XALPHA3,XBETA3, & ! Constants for homogeneous
XHON ! ice nucleation : HON
!
-REAL,SAVE :: XSCFAC, & ! Constants for raindrop
+REAL :: XSCFAC, & ! Constants for raindrop
X0EVAR,X1EVAR,XEX0EVAR,XEX1EVAR, & ! evaporation: EVA and for
X0DEPI,X2DEPI, & ! deposition : DEP on I,
X0DEPS,X1DEPS,XEX0DEPS,XEX1DEPS, & ! on S and
X0DEPG,X1DEPG,XEX0DEPG,XEX1DEPG ! on G
!
-REAL,SAVE :: XTIMAUTI,XTEXAUTI,XCRIAUTI, & ! Constants for pristine ice
+REAL :: XTIMAUTI,XTEXAUTI,XCRIAUTI, & ! Constants for pristine ice
XT0CRIAUTI,XACRIAUTI,XBCRIAUTI ! autoconversion : AUT
!
-REAL,SAVE :: XCOLIS,XCOLEXIS, & ! Constants for snow
+REAL :: XCOLIS,XCOLEXIS, & ! Constants for snow
XFIAGGS, & ! aggregation : AGG
XEXIAGGS
!
-REAL,SAVE :: XTIMAUTC, & ! Constants for cloud droplet
+REAL :: XTIMAUTC, & ! Constants for cloud droplet
XCRIAUTC ! autoconversion : AUT
!
-REAL,SAVE :: XFCACCR, & ! Constants for cloud droplet
+REAL :: XFCACCR, & ! Constants for cloud droplet
XEXCACCR ! accretion on raindrops : ACC
!
-REAL,SAVE :: XDCSLIM,XCOLCS, & ! Constants for the riming of
+REAL :: XDCSLIM,XCOLCS, & ! Constants for the riming of
XEXCRIMSS,XCRIMSS, & ! the aggregates : RIM
XEXCRIMSG,XCRIMSG, & !
XEXSRIMCG,XSRIMCG, & !
@@ -82,13 +83,13 @@ REAL,SAVE :: XDCSLIM,XCOLCS, & ! Constants for the riming of
XGAMINC_BOUND_MAX, & ! Max val. of Lbda_s for RIM
XRIMINTP1,XRIMINTP2 ! Csts for lin. interpol. of
! the tab. incomplete Gamma law
-INTEGER,SAVE :: NGAMINC ! Number of tab. Lbda_s
-REAL, DIMENSION(:), SAVE, ALLOCATABLE &
+INTEGER :: NGAMINC ! Number of tab. Lbda_s
+REAL, DIMENSION(:), ALLOCATABLE &
:: XGAMINC_RIM1, & ! Tab. incomplete Gamma funct.
XGAMINC_RIM2, & ! for XDS+2 and for XBS
XGAMINC_RIM4 ! and for 2+XDS+XBS-XBG
!
-REAL,SAVE :: XFRACCSS, & ! Constants for the accretion
+REAL :: XFRACCSS, & ! Constants for the accretion
XLBRACCS1,XLBRACCS2,XLBRACCS3, & ! raindrops onto the aggregates
XFSACCRG, & ! ACC (processes RACCSS and
XLBSACCR1,XLBSACCR2,XLBSACCR3, & ! SACCRG)
@@ -100,22 +101,22 @@ REAL,SAVE :: XFRACCSS, & ! Constants for the accretion
XACCINTP1R,XACCINTP2R ! Lbda_s and Lbda_r in the
! XKER_RACCSS and XKER_SACCRG
! tables
-INTEGER,SAVE :: NACCLBDAS, & ! Number of Lbda_s values and
+INTEGER :: NACCLBDAS, & ! Number of Lbda_s values and
NACCLBDAR ! of Lbda_r values in the
! XKER_RACCSS and XKER_SACCRG
! tables
-REAL,DIMENSION(:,:), SAVE, ALLOCATABLE &
+REAL,DIMENSION(:,:), ALLOCATABLE &
:: XKER_RACCSS, & ! Normalized kernel for RACCSS
XKER_RACCS, & ! Normalized kernel for RACCS
XKER_SACCRG ! Normalized kernel for SACCRG
-REAL,SAVE :: XFSCVMG ! Melting-conversion factor of
+REAL :: XFSCVMG ! Melting-conversion factor of
! the aggregates
!
-REAL,SAVE :: XCOLIR, & ! Constants for rain contact
+REAL :: XCOLIR, & ! Constants for rain contact
XEXRCFRI,XRCFRI, & ! freezing : CFR
XEXICFRR,XICFRR !
!
-REAL,SAVE :: XFCDRYG, & ! Constants for the dry growth
+REAL :: XFCDRYG, & ! Constants for the dry growth
XCOLIG,XCOLEXIG,XFIDRYG, & ! of the graupeln : DRY
XFIDRYG2, XEXFIDRYG, &
XCOLSG,XCOLEXSG,XFSDRYG, & ! processes RCDRYG
@@ -132,27 +133,27 @@ REAL,SAVE :: XFCDRYG, & ! Constants for the dry growth
XDRYINTP1S,XDRYINTP2S, & ! Lbda_r, Lbda_s and Lbda_g in
XDRYINTP1G,XDRYINTP2G ! the XKER_SDRYG and XKER_RDRYG
! tables
-INTEGER,SAVE :: NDRYLBDAR, & ! Number of Lbda_r,
+INTEGER :: NDRYLBDAR, & ! Number of Lbda_r,
NDRYLBDAS, & ! of Lbda_s and
NDRYLBDAG ! of Lbda_g values in
! the XKER_SDRYG and XKER_RDRYG
! tables
-REAL,DIMENSION(:,:), SAVE, ALLOCATABLE &
+REAL,DIMENSION(:,:), ALLOCATABLE &
:: XKER_SDRYG, & ! Normalized kernel for SDRYG
XKER_RDRYG ! Normalized kernel for RDRYG
!
! addition of Hail category
!
-REAL,SAVE :: XFSEDH,XEXSEDH ! Constants for sedimentation
+REAL :: XFSEDH,XEXSEDH ! Constants for sedimentation
!
!
-REAL,SAVE :: X0DEPH,X1DEPH,XEX0DEPH,XEX1DEPH ! Constants for deposition
+REAL :: X0DEPH,X1DEPH,XEX0DEPH,XEX1DEPH ! Constants for deposition
!
-REAL,SAVE :: XCOLIH, XCOLEXIH, & ! Constants for the dry growth
+REAL :: XCOLIH, XCOLEXIH, & ! Constants for the dry growth
& XCOLSH, XCOLEXSH, & ! of the hail
& XCOLGH, XCOLEXGH !
!
-REAL,SAVE :: XFWETH,XFSWETH, & ! Constants for the wet growth
+REAL :: XFWETH,XFSWETH, & ! Constants for the wet growth
XLBSWETH1,XLBSWETH2,XLBSWETH3, & ! of the hailstones : WET
XFGWETH, & ! processes RSWETH
XLBGWETH1,XLBGWETH2,XLBGWETH3, & ! RGWETH
@@ -171,15 +172,248 @@ REAL,SAVE :: XFWETH,XFSWETH, & ! Constants for the wet growth
XWETINTP1R,XWETINTP2R, & ! and Lbda_h in
XWETINTP1H,XWETINTP2H ! the XKER_SWETH, XKER_GWETH
! and XKER_RWETH tables
-INTEGER,SAVE :: NWETLBDAS, & ! Number of Lbda_s,
+INTEGER :: NWETLBDAS, & ! Number of Lbda_s,
NWETLBDAG, & ! of Lbda_g,
NWETLBDAR, & ! of Lbda_r and
NWETLBDAH ! of Lbda_h values in
! the XKER_SWETH, XKER_GWETH
! and XKER_RWETH tables
-REAL,DIMENSION(:,:), SAVE, ALLOCATABLE &
+REAL,DIMENSION(:,:), ALLOCATABLE &
:: XKER_SWETH, & ! Normalized kernel for SWETH
XKER_GWETH, & ! Normalized kernel for GWETH
XKER_RWETH ! Normalized kernel for RWETH
+END TYPE RAIN_ICE_PARAM_t
!
+TYPE(RAIN_ICE_PARAM_t), SAVE, TARGET :: RAIN_ICE_PARAM
+!
+REAL,DIMENSION(:),POINTER :: XFSEDC => NULL()
+
+REAL,POINTER :: XFSEDR => RAIN_ICE_PARAM%XFSEDR, &
+ XEXSEDR => RAIN_ICE_PARAM%XEXSEDR, &
+ XFSEDI => RAIN_ICE_PARAM%XFSEDI, &
+ XEXCSEDI => RAIN_ICE_PARAM%XEXCSEDI, &
+ XEXRSEDI => RAIN_ICE_PARAM%XEXRSEDI, &
+ XFSEDS => RAIN_ICE_PARAM%XFSEDS, &
+ XEXSEDS => RAIN_ICE_PARAM%XEXSEDS, &
+ XFSEDG => RAIN_ICE_PARAM%XFSEDG, &
+ XEXSEDG => RAIN_ICE_PARAM%XEXSEDG, &
+ XNU10 => RAIN_ICE_PARAM%XNU10, &
+ XALPHA1 => RAIN_ICE_PARAM%XALPHA1, &
+ XBETA1 => RAIN_ICE_PARAM%XBETA1, &
+ XNU20 => RAIN_ICE_PARAM%XNU20, &
+ XALPHA2 => RAIN_ICE_PARAM%XALPHA2, &
+ XBETA2 => RAIN_ICE_PARAM%XBETA2, &
+ XMNU0 => RAIN_ICE_PARAM%XMNU0, &
+ XALPHA3 => RAIN_ICE_PARAM%XALPHA3, &
+ XBETA3 => RAIN_ICE_PARAM%XBETA3, &
+ XHON => RAIN_ICE_PARAM%XHON, &
+ XSCFAC => RAIN_ICE_PARAM%XSCFAC, &
+ X0EVAR => RAIN_ICE_PARAM%X0EVAR, &
+ X1EVAR => RAIN_ICE_PARAM%X1EVAR, &
+ XEX0EVAR => RAIN_ICE_PARAM%XEX0EVAR, &
+ XEX1EVAR => RAIN_ICE_PARAM%XEX1EVAR, &
+ X0DEPI => RAIN_ICE_PARAM%X0DEPI, &
+ X2DEPI => RAIN_ICE_PARAM%X2DEPI, &
+ X0DEPS => RAIN_ICE_PARAM%X0DEPS, &
+ X1DEPS => RAIN_ICE_PARAM%X1DEPS, &
+ XEX0DEPS => RAIN_ICE_PARAM%XEX0DEPS, &
+ XEX1DEPS => RAIN_ICE_PARAM%XEX1DEPS, &
+ X0DEPG => RAIN_ICE_PARAM%X0DEPG, &
+ X1DEPG => RAIN_ICE_PARAM%X1DEPG, &
+ XEX0DEPG => RAIN_ICE_PARAM%XEX0DEPG, &
+ XEX1DEPG => RAIN_ICE_PARAM%XEX1DEPG, &
+ XTIMAUTI => RAIN_ICE_PARAM%XTIMAUTI, &
+ XTEXAUTI => RAIN_ICE_PARAM%XTEXAUTI, &
+ XCRIAUTI => RAIN_ICE_PARAM%XCRIAUTI, &
+ XT0CRIAUTI => RAIN_ICE_PARAM%XT0CRIAUTI, &
+ XACRIAUTI => RAIN_ICE_PARAM%XACRIAUTI, &
+ XBCRIAUTI => RAIN_ICE_PARAM%XBCRIAUTI, &
+ XCOLIS => RAIN_ICE_PARAM%XCOLIS, &
+ XCOLEXIS => RAIN_ICE_PARAM%XCOLEXIS, &
+ XFIAGGS => RAIN_ICE_PARAM%XFIAGGS, &
+ XEXIAGGS => RAIN_ICE_PARAM%XEXIAGGS, &
+ XTIMAUTC => RAIN_ICE_PARAM%XTIMAUTC, &
+ XCRIAUTC => RAIN_ICE_PARAM%XCRIAUTC, &
+ XFCACCR => RAIN_ICE_PARAM%XFCACCR, &
+ XEXCACCR => RAIN_ICE_PARAM%XEXCACCR, &
+ XDCSLIM => RAIN_ICE_PARAM%XDCSLIM, &
+ XCOLCS => RAIN_ICE_PARAM%XCOLCS, &
+ XEXCRIMSS => RAIN_ICE_PARAM%XEXCRIMSS, &
+ XCRIMSS => RAIN_ICE_PARAM%XCRIMSS, &
+ XEXCRIMSG => RAIN_ICE_PARAM%XEXCRIMSG, &
+ XCRIMSG => RAIN_ICE_PARAM%XCRIMSG, &
+ XEXSRIMCG => RAIN_ICE_PARAM%XEXSRIMCG, &
+ XSRIMCG => RAIN_ICE_PARAM%XSRIMCG, &
+ XEXSRIMCG2 => RAIN_ICE_PARAM%XEXSRIMCG2, &
+ XSRIMCG2 => RAIN_ICE_PARAM%XSRIMCG2, &
+ XSRIMCG3 => RAIN_ICE_PARAM%XSRIMCG3, &
+ XGAMINC_BOUND_MIN => RAIN_ICE_PARAM%XGAMINC_BOUND_MIN, &
+ XGAMINC_BOUND_MAX => RAIN_ICE_PARAM%XGAMINC_BOUND_MAX, &
+ XRIMINTP1 => RAIN_ICE_PARAM%XRIMINTP1, &
+ XRIMINTP2 => RAIN_ICE_PARAM%XRIMINTP2, &
+ XFRACCSS => RAIN_ICE_PARAM%XFRACCSS, &
+ XLBRACCS1 => RAIN_ICE_PARAM%XLBRACCS1, &
+ XLBRACCS2 => RAIN_ICE_PARAM%XLBRACCS2, &
+ XLBRACCS3 => RAIN_ICE_PARAM%XLBRACCS3, &
+ XFSACCRG => RAIN_ICE_PARAM%XFSACCRG, &
+ XLBSACCR1 => RAIN_ICE_PARAM%XLBSACCR1, &
+ XLBSACCR2 => RAIN_ICE_PARAM%XLBSACCR2, &
+ XLBSACCR3 => RAIN_ICE_PARAM%XLBSACCR3, &
+ XACCLBDAS_MIN => RAIN_ICE_PARAM%XACCLBDAS_MIN, &
+ XACCLBDAS_MAX => RAIN_ICE_PARAM%XACCLBDAS_MAX, &
+ XACCLBDAR_MIN => RAIN_ICE_PARAM%XACCLBDAR_MIN, &
+ XACCLBDAR_MAX => RAIN_ICE_PARAM%XACCLBDAR_MAX, &
+ XACCINTP1S => RAIN_ICE_PARAM%XACCINTP1S, &
+ XACCINTP2S => RAIN_ICE_PARAM%XACCINTP2S, &
+ XACCINTP1R => RAIN_ICE_PARAM%XACCINTP1R, &
+ XACCINTP2R => RAIN_ICE_PARAM%XACCINTP2R, &
+ XFSCVMG => RAIN_ICE_PARAM%XFSCVMG, &
+ XCOLIR => RAIN_ICE_PARAM%XCOLIR, &
+ XEXRCFRI => RAIN_ICE_PARAM%XEXRCFRI, &
+ XRCFRI => RAIN_ICE_PARAM%XRCFRI, &
+ XEXICFRR => RAIN_ICE_PARAM%XEXICFRR, &
+ XICFRR => RAIN_ICE_PARAM%XICFRR, &
+ XFCDRYG => RAIN_ICE_PARAM%XFCDRYG, &
+ XCOLIG => RAIN_ICE_PARAM%XCOLIG, &
+ XCOLEXIG => RAIN_ICE_PARAM%XCOLEXIG, &
+ XFIDRYG => RAIN_ICE_PARAM%XFIDRYG, &
+ XFIDRYG2 => RAIN_ICE_PARAM%XFIDRYG2, &
+ XEXFIDRYG => RAIN_ICE_PARAM%XEXFIDRYG, &
+ XCOLSG => RAIN_ICE_PARAM%XCOLSG, &
+ XCOLEXSG => RAIN_ICE_PARAM%XCOLEXSG, &
+ XFSDRYG => RAIN_ICE_PARAM%XFSDRYG, &
+ XLBSDRYG1 => RAIN_ICE_PARAM%XLBSDRYG1, &
+ XLBSDRYG2 => RAIN_ICE_PARAM%XLBSDRYG2, &
+ XLBSDRYG3 => RAIN_ICE_PARAM%XLBSDRYG3, &
+ XFRDRYG => RAIN_ICE_PARAM%XFRDRYG, &
+ XLBRDRYG1 => RAIN_ICE_PARAM%XLBRDRYG1, &
+ XLBRDRYG2 => RAIN_ICE_PARAM%XLBRDRYG2, &
+ XLBRDRYG3 => RAIN_ICE_PARAM%XLBRDRYG3, &
+ XDRYLBDAR_MIN => RAIN_ICE_PARAM%XDRYLBDAR_MIN, &
+ XDRYLBDAR_MAX => RAIN_ICE_PARAM%XDRYLBDAR_MAX, &
+ XDRYLBDAS_MIN => RAIN_ICE_PARAM%XDRYLBDAS_MIN, &
+ XDRYLBDAS_MAX => RAIN_ICE_PARAM%XDRYLBDAS_MAX, &
+ XDRYLBDAG_MIN => RAIN_ICE_PARAM%XDRYLBDAG_MIN, &
+ XDRYLBDAG_MAX => RAIN_ICE_PARAM%XDRYLBDAG_MAX, &
+ XDRYINTP1R => RAIN_ICE_PARAM%XDRYINTP1R, &
+ XDRYINTP2R => RAIN_ICE_PARAM%XDRYINTP2R, &
+ XDRYINTP1S => RAIN_ICE_PARAM%XDRYINTP1S, &
+ XDRYINTP2S => RAIN_ICE_PARAM%XDRYINTP2S, &
+ XDRYINTP1G => RAIN_ICE_PARAM%XDRYINTP1G, &
+ XDRYINTP2G => RAIN_ICE_PARAM%XDRYINTP2G, &
+ XFSEDH => RAIN_ICE_PARAM%XFSEDH, &
+ XEXSEDH => RAIN_ICE_PARAM%XEXSEDH, &
+ X0DEPH => RAIN_ICE_PARAM%X0DEPH, &
+ X1DEPH => RAIN_ICE_PARAM%X1DEPH, &
+ XEX0DEPH => RAIN_ICE_PARAM%XEX0DEPH, &
+ XEX1DEPH => RAIN_ICE_PARAM%XEX1DEPH, &
+ XCOLIH => RAIN_ICE_PARAM%XCOLIH, &
+ XCOLEXIH => RAIN_ICE_PARAM%XCOLEXIH, &
+ XCOLSH => RAIN_ICE_PARAM%XCOLSH, &
+ XCOLEXSH => RAIN_ICE_PARAM%XCOLEXSH, &
+ XCOLGH => RAIN_ICE_PARAM%XCOLGH, &
+ XCOLEXGH => RAIN_ICE_PARAM%XCOLEXGH, &
+ XFWETH => RAIN_ICE_PARAM%XFWETH, &
+ XFSWETH => RAIN_ICE_PARAM%XFSWETH, &
+ XLBSWETH1 => RAIN_ICE_PARAM%XLBSWETH1, &
+ XLBSWETH2 => RAIN_ICE_PARAM%XLBSWETH2, &
+ XLBSWETH3 => RAIN_ICE_PARAM%XLBSWETH3, &
+ XFGWETH => RAIN_ICE_PARAM%XFGWETH, &
+ XLBGWETH1 => RAIN_ICE_PARAM%XLBGWETH1, &
+ XLBGWETH2 => RAIN_ICE_PARAM%XLBGWETH2, &
+ XLBGWETH3 => RAIN_ICE_PARAM%XLBGWETH3, &
+ XFRWETH => RAIN_ICE_PARAM%XFRWETH, &
+ XLBRWETH1 => RAIN_ICE_PARAM%XLBRWETH1, &
+ XLBRWETH2 => RAIN_ICE_PARAM%XLBRWETH2, &
+ XLBRWETH3 => RAIN_ICE_PARAM%XLBRWETH3, &
+ XWETLBDAS_MIN => RAIN_ICE_PARAM%XWETLBDAS_MIN, &
+ XWETLBDAS_MAX => RAIN_ICE_PARAM%XWETLBDAS_MAX, &
+ XWETLBDAG_MIN => RAIN_ICE_PARAM%XWETLBDAG_MIN, &
+ XWETLBDAG_MAX => RAIN_ICE_PARAM%XWETLBDAG_MAX, &
+ XWETLBDAR_MIN => RAIN_ICE_PARAM%XWETLBDAR_MIN, &
+ XWETLBDAR_MAX => RAIN_ICE_PARAM%XWETLBDAR_MAX, &
+ XWETLBDAH_MIN => RAIN_ICE_PARAM%XWETLBDAH_MIN, &
+ XWETLBDAH_MAX => RAIN_ICE_PARAM%XWETLBDAH_MAX, &
+ XWETINTP1S => RAIN_ICE_PARAM%XWETINTP1S, &
+ XWETINTP2S => RAIN_ICE_PARAM%XWETINTP2S, &
+ XWETINTP1G => RAIN_ICE_PARAM%XWETINTP1G, &
+ XWETINTP2G => RAIN_ICE_PARAM%XWETINTP2G, &
+ XWETINTP1R => RAIN_ICE_PARAM%XWETINTP1R, &
+ XWETINTP2R => RAIN_ICE_PARAM%XWETINTP2R, &
+ XWETINTP1H => RAIN_ICE_PARAM%XWETINTP1H, &
+ XWETINTP2H => RAIN_ICE_PARAM%XWETINTP2H
+
+INTEGER, POINTER :: NGAMINC => RAIN_ICE_PARAM%NGAMINC, &
+ NACCLBDAS => RAIN_ICE_PARAM%NACCLBDAS, &
+ NACCLBDAR => RAIN_ICE_PARAM%NACCLBDAR, &
+ NDRYLBDAR => RAIN_ICE_PARAM%NDRYLBDAR, &
+ NDRYLBDAS => RAIN_ICE_PARAM%NDRYLBDAS, &
+ NDRYLBDAG => RAIN_ICE_PARAM%NDRYLBDAG, &
+ NWETLBDAS => RAIN_ICE_PARAM%NWETLBDAS, &
+ NWETLBDAG => RAIN_ICE_PARAM%NWETLBDAG, &
+ NWETLBDAR => RAIN_ICE_PARAM%NWETLBDAR, &
+ NWETLBDAH => RAIN_ICE_PARAM%NWETLBDAH
+
+REAL, DIMENSION(:), POINTER :: XGAMINC_RIM1 => NULL(), &
+ XGAMINC_RIM2 => NULL(), &
+ XGAMINC_RIM4 => NULL()
+
+REAL,DIMENSION(:,:), POINTER :: XKER_RACCSS => NULL(), &
+ XKER_RACCS => NULL(), &
+ XKER_SACCRG => NULL(), &
+ XKER_SDRYG => NULL(), &
+ XKER_RDRYG => NULL(), &
+ XKER_SWETH => NULL(), &
+ XKER_GWETH => NULL(), &
+ XKER_RWETH => NULL()
+CONTAINS
+SUBROUTINE RAIN_ICE_INIT()
+ IMPLICIT NONE
+ XFSEDC => RAIN_ICE_PARAM%XFSEDC
+END SUBROUTINE RAIN_ICE_INIT
+SUBROUTINE RAIN_ICE_ALLOCATE(HNAME, KDIM1, KDIM2)
+ IMPLICIT NONE
+ CHARACTER(LEN=*), INTENT(IN) :: HNAME
+ INTEGER, INTENT(IN) :: KDIM1
+ INTEGER, OPTIONAL, INTENT(IN) :: KDIM2
+
+ SELECT CASE(TRIM(HNAME))
+ !1D arrays
+ CASE('XGAMINC_RIM1')
+ ALLOCATE(RAIN_ICE_PARAM%XGAMINC_RIM1(KDIM1))
+ XGAMINC_RIM1 => RAIN_ICE_PARAM%XGAMINC_RIM1
+ CASE('XGAMINC_RIM2')
+ ALLOCATE(RAIN_ICE_PARAM%XGAMINC_RIM2(KDIM1))
+ XGAMINC_RIM2 => RAIN_ICE_PARAM%XGAMINC_RIM2
+ CASE('XGAMINC_RIM4')
+ ALLOCATE(RAIN_ICE_PARAM%XGAMINC_RIM4(KDIM1))
+ XGAMINC_RIM4 => RAIN_ICE_PARAM%XGAMINC_RIM4
+ !
+ !2D arrays
+ CASE('XKER_RACCSS')
+ ALLOCATE(RAIN_ICE_PARAM%XKER_RACCSS(KDIM1, KDIM2))
+ XKER_RACCSS=> RAIN_ICE_PARAM%XKER_RACCSS
+ CASE('XKER_RACCS')
+ ALLOCATE(RAIN_ICE_PARAM%XKER_RACCS(KDIM1, KDIM2))
+ XKER_RACCS=> RAIN_ICE_PARAM%XKER_RACCS
+ CASE('XKER_SACCRG')
+ ALLOCATE(RAIN_ICE_PARAM%XKER_SACCRG(KDIM1, KDIM2))
+ XKER_SACCRG=> RAIN_ICE_PARAM%XKER_SACCRG
+ CASE('XKER_SDRYG')
+ ALLOCATE(RAIN_ICE_PARAM%XKER_SDRYG(KDIM1, KDIM2))
+ XKER_SDRYG=> RAIN_ICE_PARAM%XKER_SDRYG
+ CASE('XKER_RDRYG')
+ ALLOCATE(RAIN_ICE_PARAM%XKER_RDRYG(KDIM1, KDIM2))
+ XKER_RDRYG=> RAIN_ICE_PARAM%XKER_RDRYG
+ CASE('XKER_SWETH')
+ ALLOCATE(RAIN_ICE_PARAM%XKER_SWETH(KDIM1, KDIM2))
+ XKER_SWETH=> RAIN_ICE_PARAM%XKER_SWETH
+ CASE('XKER_GWETH')
+ ALLOCATE(RAIN_ICE_PARAM%XKER_GWETH(KDIM1, KDIM2))
+ XKER_GWETH=> RAIN_ICE_PARAM%XKER_GWETH
+ CASE('XKER_RWETH')
+ ALLOCATE(RAIN_ICE_PARAM%XKER_RWETH(KDIM1, KDIM2))
+ XKER_RWETH=> RAIN_ICE_PARAM%XKER_RWETH
+ END SELECT
+END SUBROUTINE RAIN_ICE_ALLOCATE
END MODULE MODD_RAIN_ICE_PARAM
diff --git a/src/common/micro/mode_compute_frac_ice.F90 b/src/common/micro/mode_compute_frac_ice.F90
deleted file mode 100644
index ba2dffd7f..000000000
--- a/src/common/micro/mode_compute_frac_ice.F90
+++ /dev/null
@@ -1,93 +0,0 @@
-!MNH_LIC Copyright 2006-2019 CNRS, Meteo-France and Universite Paul Sabatier
-!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!MNH_LIC for details. version 1.
-! ######spl
- MODULE MODE_COMPUTE_FRAC_ICE
-! ############################
-!
-!!**** *COMPUTE_FRAC_ICE* - computes ice fraction
-!!
-!! PURPOSE
-!! -------
-!!
-!!** METHOD
-!! ------
-!!
-!!
-!! EXTERNAL
-!! --------
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!!
-!! REFERENCE
-!! ---------
-!!
-!! AUTHOR
-!! ------
-!! Julien PERGAUD * Meteo-France *
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 13/03/06
-!! S. Riette April 2011 optimisation
-!! S. Riette 08/2016 add option O
-!! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
-!! R. El Khatib 24-Aug-2021 Optimization by cache re-use + assume data is contiguous
-!! S. Riette Jan-2022 Merge the 3 procedures in one module + array shape declaration
-! R. El Khatib / S. Riette Jan-2022 written as an elemental subroutine
-!
-!
-!
-
-
-!****************** Don't use drHook !!!
-
-
-
-IMPLICIT NONE
-CONTAINS
-
-ELEMENTAL SUBROUTINE COMPUTE_FRAC_ICE(HFRAC_ICE, PFRAC_ICE, PT, KERR)
-!! --------------------------------------------------------------------------
-! 0. DECLARATIONS
-! ------------
-!
-USE MODD_NEB, ONLY : XTMINMIX, XTMAXMIX
-USE MODD_CST, ONLY : XTT
-!
-IMPLICIT NONE
-!
-!
-!* 0.1 declarations of arguments
-!
-CHARACTER(LEN=1), INTENT(IN) :: HFRAC_ICE ! scheme to use
-REAL, INTENT(IN) :: PT ! Temperature
-REAL, INTENT(INOUT) :: PFRAC_ICE ! Ice fraction (1 for ice only, 0 for liquid only)
-INTEGER, INTENT(OUT) :: KERR ! Error code in return
-!
-! 0.2 declaration of local variables
-!
-!------------------------------------------------------------------------
-! 1. Compute FRAC_ICE
-!
-KERR=0
-SELECT CASE(HFRAC_ICE)
- CASE ('T') !using Temperature
- PFRAC_ICE = MAX( 0., MIN(1., (( XTMAXMIX - PT ) / ( XTMAXMIX - XTMINMIX )) ) ) ! freezing interval
- CASE ('O') !using Temperature with old formulae
- PFRAC_ICE = MAX( 0., MIN(1., (( XTT - PT ) / 40.) ) ) ! freezing interval
- CASE ('N') !No ice
- PFRAC_ICE = 0.
- CASE ('S') !Same as previous
- ! (almost) nothing to do
- PFRAC_ICE = MAX( 0., MIN(1., PFRAC_ICE ) )
- CASE DEFAULT
- KERR=1
-END SELECT
-!
-END SUBROUTINE COMPUTE_FRAC_ICE
-!
-END MODULE MODE_COMPUTE_FRAC_ICE
diff --git a/src/common/micro/modi_condensation.F90 b/src/common/micro/modi_condensation.F90
index 7163e8208..22b37318f 100644
--- a/src/common/micro/modi_condensation.F90
+++ b/src/common/micro/modi_condensation.F90
@@ -4,35 +4,36 @@
!
INTERFACE
!
- SUBROUTINE CONDENSATION( KIU, KJU, KKU, KIB, KIE, KJB, KJE, KKB, KKE, KKL,&
+ SUBROUTINE CONDENSATION(D, CST, ICEP, NEB, &
HFRAC_ICE, HCONDENS, HLAMBDA3, &
PPABS, PZZ, PRHODREF, PT, PRV_IN, PRV_OUT, PRC_IN, PRC_OUT, PRI_IN, PRI_OUT, &
- PRS, PRG, PSIGS, PMFCONV, PCLDFR, PSIGRC, OUSERI,&
+ PRS, PRG, PSIGS, LMFCONV, PMFCONV, PCLDFR, PSIGRC, OUSERI,&
OSIGMAS, OCND2, PSIGQSAT, &
PLV, PLS, PCPH, &
PHLC_HRC, PHLC_HCF, PHLI_HRI, PHLI_HCF, PICE_CLD_WGT)
!
-USE MODD_SPP_TYPE
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+USE MODD_CST, ONLY: CST_t
+USE MODD_NEB, ONLY: NEB_t
+USE MODD_RAIN_ICE_PARAM, ONLY: RAIN_ICE_PARAM_t
!
-INTEGER, INTENT(IN) :: KIU ! horizontal dimension in x
-INTEGER, INTENT(IN) :: KJU ! horizontal dimension in y
-INTEGER, INTENT(IN) :: KKU ! vertical dimension
-INTEGER, INTENT(IN) :: KIB ! value of the first point in x
-INTEGER, INTENT(IN) :: KIE ! value of the last point in x
-INTEGER, INTENT(IN) :: KJB ! value of the first point in y
-INTEGER, INTENT(IN) :: KJE ! value of the last point in y
-INTEGER, INTENT(IN) :: KKB ! value of the first point in z
-INTEGER, INTENT(IN) :: KKE ! value of the last point in z
-INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+TYPE(CST_t), INTENT(IN) :: CST
+TYPE(RAIN_ICE_PARAM_t), INTENT(IN) :: ICEP
+TYPE(NEB_t), INTENT(IN) :: NEB
CHARACTER(LEN=1), INTENT(IN) :: HFRAC_ICE
CHARACTER(LEN=4), INTENT(IN) :: HCONDENS
CHARACTER(LEN=*), INTENT(IN) :: HLAMBDA3 ! formulation for lambda3 coeff
-REAL, DIMENSION(KIU,KJU,KKU), INTENT(IN) :: PPABS ! pressure (Pa)
-REAL, DIMENSION(KIU,KJU,KKU), INTENT(IN) :: PZZ ! height of model levels (m)
-REAL, DIMENSION(KIU,KJU,KKU), INTENT(IN) :: PRHODREF
-REAL, DIMENSION(KIU,KJU,KKU), INTENT(INOUT) :: PT ! grid scale T (K)
-REAL, DIMENSION(KIU,KJU,KKU), INTENT(IN) :: PRV_IN ! grid scale water vapor mixing ratio (kg/kg) in input
-REAL, DIMENSION(KIU,KJU,KKU), INTENT(OUT) :: PRV_OUT! grid scale water vapor mixing ratio (kg/kg) in output
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PPABS ! pressure (Pa)
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PZZ ! height of model levels (m)
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PRHODREF
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(INOUT) :: PT ! grid scale T (K)
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PRV_IN ! grid scale water vapor mixing ratio (kg/kg) in input
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(OUT) :: PRV_OUT! grid scale water vapor mixing ratio (kg/kg) in output
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PRC_IN ! grid scale r_c mixing ratio (kg/kg) in input
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(OUT) :: PRC_OUT! grid scale r_c mixing ratio (kg/kg) in output
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PRI_IN ! grid scale r_i (kg/kg) in input
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(OUT) :: PRI_OUT! grid scale r_i (kg/kg) in output
LOGICAL, INTENT(IN) :: OUSERI ! logical switch to compute both
! liquid and solid condensate (OUSERI=.TRUE.)
! or only solid condensate (OUSERI=.FALSE.)
@@ -40,27 +41,27 @@ LOGICAL, INTENT(IN) :: OSIGMAS! use present global Sigma
! or that from turbulence scheme
LOGICAL, INTENT(IN) :: OCND2 ! logical switch to sparate liquid and ice
! more rigid (DEFALT value : .FALSE.)
-REAL, DIMENSION(KIU,KJU), INTENT(IN) :: PSIGQSAT ! use an extra "qsat" variance contribution (OSIGMAS case)
+REAL, DIMENSION(D%NIT,D%NJT), INTENT(IN) :: PSIGQSAT ! use an extra "qsat" variance contribution (OSIGMAS case)
! multiplied by PSIGQSAT
-REAL, DIMENSION(KIU,KJU,KKU), INTENT(IN) :: PRC_IN ! grid scale r_c mixing ratio (kg/kg) in input
-REAL, DIMENSION(KIU,KJU,KKU), INTENT(OUT) :: PRC_OUT! grid scale r_c mixing ratio (kg/kg) in output
-REAL, DIMENSION(KIU,KJU,KKU), INTENT(IN) :: PRI_IN ! grid scale r_i (kg/kg) in input
-REAL, DIMENSION(KIU,KJU,KKU), INTENT(OUT) :: PRI_OUT! grid scale r_i (kg/kg) in output
-REAL, DIMENSION(KIU,KJU,KKU), INTENT(IN) :: PRS ! grid scale mixing ration of snow (kg/kg)
-REAL, DIMENSION(KIU,KJU,KKU), INTENT(IN) :: PRG ! grid scale mixing ration of graupel (kg/kg)
-REAL, DIMENSION(KIU,KJU,KKU), INTENT(IN) :: PSIGS ! Sigma_s from turbulence scheme
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PMFCONV! convective mass flux (kg /s m^2)
-REAL, DIMENSION(KIU,KJU,KKU), INTENT(OUT) :: PCLDFR ! cloud fraction
-REAL, DIMENSION(KIU,KJU,KKU), INTENT(OUT) :: PSIGRC ! s r_c / sig_s^2
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PRS ! grid scale mixing ration of snow (kg/kg)
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PRG ! grid scale mixing ration of graupel (kg/kg)
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PSIGS ! Sigma_s from turbulence scheme
+LOGICAL, INTENT(IN) :: LMFCONV ! =SIZE(PMFCONV)!=0
+REAL, DIMENSION(MERGE(D%NIT,0,LMFCONV),&
+ MERGE(D%NJT,0,LMFCONV),&
+ MERGE(D%NKT,0,LMFCONV)), INTENT(IN) :: PMFCONV! convective mass flux (kg /s m^2)
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(OUT) :: PCLDFR ! cloud fraction
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(OUT) :: PSIGRC ! s r_c / sig_s^2
+
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), OPTIONAL, INTENT(IN) :: PLV ! Latent heat L_v
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), OPTIONAL, INTENT(IN) :: PLS ! Latent heat L_s
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), OPTIONAL, INTENT(IN) :: PCPH ! Specific heat C_ph
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), OPTIONAL, INTENT(OUT) :: PHLC_HRC
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), OPTIONAL, INTENT(OUT) :: PHLC_HCF ! cloud fraction
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), OPTIONAL, INTENT(OUT) :: PHLI_HRI
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), OPTIONAL, INTENT(OUT) :: PHLI_HCF
+REAL, DIMENSION(D%NIT,D%NJT), OPTIONAL, INTENT(IN) :: PICE_CLD_WGT
-REAL, DIMENSION(KIU,KJU,KKU), OPTIONAL, INTENT(IN) :: PLV ! Latent heat L_v
-REAL, DIMENSION(KIU,KJU,KKU), OPTIONAL, INTENT(IN) :: PLS ! Latent heat L_s
-REAL, DIMENSION(KIU,KJU,KKU), OPTIONAL, INTENT(IN) :: PCPH ! Specific heat C_ph
-REAL, DIMENSION(KIU,KJU,KKU), OPTIONAL, INTENT(OUT) :: PHLC_HRC
-REAL, DIMENSION(KIU,KJU,KKU), OPTIONAL, INTENT(OUT) :: PHLC_HCF ! cloud fraction
-REAL, DIMENSION(KIU,KJU,KKU), OPTIONAL, INTENT(OUT) :: PHLI_HRI
-REAL, DIMENSION(KIU,KJU,KKU), OPTIONAL, INTENT(OUT) :: PHLI_HCF
-REAL, DIMENSION(KIU,KJU), OPTIONAL, INTENT(IN) :: PICE_CLD_WGT
END SUBROUTINE CONDENSATION
!
END INTERFACE
diff --git a/src/common/micro/modi_ice_adjust.F90 b/src/common/micro/modi_ice_adjust.F90
index e949147f5..9c962de2c 100644
--- a/src/common/micro/modi_ice_adjust.F90
+++ b/src/common/micro/modi_ice_adjust.F90
@@ -4,10 +4,11 @@
!
INTERFACE
!
- SUBROUTINE ICE_ADJUST (KKA, KKU, KKL, KRR, HFRAC_ICE, HCONDENS, HLAMBDA3,&
+ SUBROUTINE ICE_ADJUST (D, CST, ICEP, NEB, BUCONF, KRR, &
+ HFRAC_ICE, HCONDENS, HLAMBDA3,&
HBUNAME, OSUBG_COND, OSIGMAS, OCND2, HSUBG_MF_PDF,&
PTSTEP, PSIGQSAT, &
- PRHODJ, PEXNREF, PRHODREF, PSIGS, PMFCONV, &
+ PRHODJ, PEXNREF, PRHODREF, PSIGS, LMFCONV, PMFCONV,&
PPABST, PZZ, &
PEXN, PCF_MF, PRC_MF, PRI_MF, &
PRV, PRC, PRVS, PRCS, PTH, PTHS, PSRCS, PCLDFR, &
@@ -16,16 +17,22 @@ INTERFACE
PHLC_HRC, PHLC_HCF, PHLI_HRI, PHLI_HCF, &
TBUDGETS, KBUDGETS, &
PICE_CLD_WGT)
-USE MODD_BUDGET, ONLY: TBUDGETDATA
+USE MODD_BUDGET, ONLY: TBUDGETDATA, TBUDGETCONF_t
+USE MODD_CST, ONLY: CST_t
+USE MODD_RAIN_ICE_PARAM, ONLY: RAIN_ICE_PARAM_t
+USE MODD_NEB, ONLY: NEB_t
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
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(RAIN_ICE_PARAM_t), INTENT(IN) :: ICEP
+TYPE(NEB_t), INTENT(IN) :: NEB
+TYPE(TBUDGETCONF_t), INTENT(IN) :: BUCONF
INTEGER, INTENT(IN) :: KRR ! Number of moist variables
CHARACTER(LEN=1), INTENT(IN) :: HFRAC_ICE
CHARACTER(LEN=80), INTENT(IN) :: HCONDENS
@@ -42,50 +49,56 @@ LOGICAL :: OCND2 ! logical switch to sparate
CHARACTER(LEN=80), INTENT(IN) :: HSUBG_MF_PDF
REAL, INTENT(IN) :: PTSTEP ! Double Time step
! (single if cold start)
-REAL, DIMENSION(:,:), INTENT(IN) :: PSIGQSAT ! coeff applied to qsat variance contribution
+REAL, DIMENSION(D%NIT,D%NJT), INTENT(IN) :: PSIGQSAT ! coeff applied to qsat variance contribution
!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PEXNREF ! Reference Exner function
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PRHODREF
!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSIGS ! Sigma_s at time t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PMFCONV ! convective mass flux
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! Absolute Pressure at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! height of model layer
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXN ! Exner function
+REAL, DIMENSION(MERGE(D%NIT,0,OSUBG_COND),&
+ MERGE(D%NJT,0,OSUBG_COND),&
+ MERGE(D%NKT,0,OSUBG_COND)), INTENT(IN) :: PSIGS ! Sigma_s at time t
+LOGICAL, INTENT(IN) :: LMFCONV ! =SIZE(PMFCONV)!=0
+REAL, DIMENSION(MERGE(D%NIT,0,LMFCONV),&
+ MERGE(D%NJT,0,LMFCONV),&
+ MERGE(D%NKT,0,LMFCONV)), INTENT(IN) :: PMFCONV ! convective mass flux
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PPABST ! Absolute Pressure at t
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PZZ ! height of model layer
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PEXN ! Exner function
!
-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 ice mixing ratio
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PCF_MF! Convective Mass Flux Cloud fraction
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PRC_MF! Convective Mass Flux liquid mixing ratio
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PRI_MF! Convective Mass Flux ice mixing ratio
!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRV ! Water vapor m.r. to adjust
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRC ! Cloud water m.r. to adjust
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRVS ! Water vapor m.r. source
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRCS ! Cloud water m.r. source
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTH ! Theta to adjust
-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(OUT) :: PCLDFR ! Cloud fraction
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PRV ! Water vapor m.r. to adjust
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PRC ! Cloud water m.r. to adjust
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(INOUT) :: PRVS ! Water vapor m.r. source
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(INOUT) :: PRCS ! Cloud water m.r. source
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PTH ! Theta to adjust
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(INOUT) :: PTHS ! Theta source
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(OUT) :: PSRCS ! Second-order flux
+ ! s'rc'/2Sigma_s2 at time t+1
+ ! multiplied by Lambda_3
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(OUT) :: PCLDFR ! Cloud fraction
!
-REAL, DIMENSION(:,:,:), INTENT(INOUT):: PRIS ! Cloud ice m.r. at t+1
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRR ! Rain water m.r. to adjust
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRI ! Cloud ice m.r. to adjust
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRS ! Aggregate m.r. to adjust
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRG ! Graupel m.r. to adjust
-REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(IN) :: PRH ! Hail m.r. to adjust
-REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(OUT) :: POUT_RV ! Adjusted value
-REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(OUT) :: POUT_RC ! Adjusted value
-REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(OUT) :: POUT_RI ! Adjusted value
-REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(OUT) :: POUT_TH ! Adjusted value
-REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(OUT) :: PHLC_HRC
-REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(OUT) :: PHLC_HCF
-REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(OUT) :: PHLI_HRI
-REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(OUT) :: PHLI_HCF
-TYPE(TBUDGETDATA), DIMENSION(KBUDGETS), INTENT(INOUT) :: TBUDGETS
-INTEGER, INTENT(IN) :: KBUDGETS
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PICE_CLD_WGT
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(INOUT):: PRIS ! Cloud ice m.r. at t+1
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PRR ! Rain water m.r. to adjust
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PRI ! Cloud ice m.r. to adjust
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PRS ! Aggregate m.r. to adjust
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PRG ! Graupel m.r. to adjust
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), OPTIONAL, INTENT(IN) :: PRH ! Hail m.r. to adjust
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), OPTIONAL, INTENT(OUT) :: POUT_RV ! Adjusted value
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), OPTIONAL, INTENT(OUT) :: POUT_RC ! Adjusted value
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), OPTIONAL, INTENT(OUT) :: POUT_RI ! Adjusted value
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), OPTIONAL, INTENT(OUT) :: POUT_TH ! Adjusted value
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), OPTIONAL, INTENT(OUT) :: PHLC_HRC
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), OPTIONAL, INTENT(OUT) :: PHLC_HCF
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), OPTIONAL, INTENT(OUT) :: PHLI_HRI
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), OPTIONAL, INTENT(OUT) :: PHLI_HCF
+TYPE(TBUDGETDATA), DIMENSION(KBUDGETS), INTENT(INOUT) :: TBUDGETS
+INTEGER, INTENT(IN) :: KBUDGETS
+REAL, DIMENSION(D%NIT,D%NJT), OPTIONAL, INTENT(IN) :: PICE_CLD_WGT
+
!
END SUBROUTINE ICE_ADJUST
!
diff --git a/src/mesonh/aux/mode_fill_dimphyexn.F90 b/src/mesonh/aux/mode_fill_dimphyexn.F90
new file mode 100644
index 000000000..69bdb37f3
--- /dev/null
+++ b/src/mesonh/aux/mode_fill_dimphyexn.F90
@@ -0,0 +1,74 @@
+!MNH_LIC Copyright 1995-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_FILL_DIMPHYEX
+IMPLICIT NONE
+CONTAINS
+SUBROUTINE FILL_DIMPHYEX(YDDIMPHYEX, KIT, KJT, KKT)
+! #########################
+!
+!!
+!! PURPOSE
+!! -------
+! This subroutine computes the dimensions according to the running model.
+!
+!!
+!!** IMPLICIT ARGUMENTS
+!! ------------------
+!! None
+!!
+!! REFERENCE
+!! ---------
+!!
+!! AUTHOR
+!! ------
+!! S. Riette, Météo-France
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original January 2022
+!
+!-----------------------------------------------------------------
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+USE MODD_PARAMETERS, ONLY: JPVEXT
+USE PARKIND1, ONLY : JPRB
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+TYPE(DIMPHYEX_t), INTENT(OUT) :: YDDIMPHYEX ! Structure to fill in
+INTEGER, INTENT(IN) :: KIT, KJT, KKT ! Array dimensions
+
+!
+!* 0.2 declaration of local variables
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!-------------------------------------------------------------------------------
+!
+IF (LHOOK) CALL DR_HOOK('FILL_DIMPHYEX', 0, ZHOOK_HANDLE)
+!
+YDDIMPHYEX%NIT=KIT
+YDDIMPHYEX%NJT=KJT
+CALL GET_INDICE_ll(YDDIMPHYEX%NIB, YDDIMPHYEX%NJB,&
+ &YDDIMPHYEX%NIE, YDDIMPHYEX%NJE)
+!
+YDDIMPHYEX%NKL=1
+YDDIMPHYEX%NKT=KKT
+YDDIMPHYEX%NKA=1
+YDDIMPHYEX%NKU=KKT
+YDDIMPHYEX%NKB=1+JPVEXT
+YDDIMPHYEX%NKE=KKT-JPVEXT
+YDDIMPHYEX%NKTB=1+JPVEXT
+YDDIMPHYEX%NKTE=KKT-JPVEXT
+!
+IF (LHOOK) CALL DR_HOOK('FILL_DIMPHYEX', 1, ZHOOK_HANDLE)
+!
+END SUBROUTINE FILL_DIMPHYEX
+END MODULE MODE_FILL_DIMPHYEX
diff --git a/src/mesonh/micro/ini_rain_ice.f90 b/src/mesonh/micro/ini_rain_ice.f90
index 7f8bb85b0..c172f556e 100644
--- a/src/mesonh/micro/ini_rain_ice.f90
+++ b/src/mesonh/micro/ini_rain_ice.f90
@@ -191,7 +191,10 @@ REAL :: PDRYLBDAG_MAX,PDRYLBDAS_MAX,PDRYLBDAG_MIN,PDRYLBDAS_MIN
REAL :: PDRYLBDAR_MAX,PDRYLBDAR_MIN
REAL :: PWETLBDAS_MAX,PWETLBDAG_MAX,PWETLBDAS_MIN,PWETLBDAG_MIN
REAL :: PWETLBDAR_MAX,PWETLBDAH_MAX,PWETLBDAR_MIN,PWETLBDAH_MIN
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------------
+IF (LHOOK) CALL DR_HOOK('INI_RAIN_ICE',0,ZHOOK_HANDLE)
!
!
!* 0. FUNCTION STATEMENTS
@@ -453,6 +456,7 @@ ZRHO00 = 101325.*(1.+ZRV)/(XRD+ZRV*XRV)/293.15
!
!* 4.2 Constants for sedimentation
!
+IF(.NOT.ASSOCIATED(XFSEDC)) CALL RAIN_ICE_INIT()
XFSEDC(1) = GAMMA(XNUC+(XDC+3.)/XALPHAC)/GAMMA(XNUC+3./XALPHAC)* &
(ZRHO00)**XCEXVT
XFSEDC(2) = GAMMA(XNUC2+(XDC+3.)/XALPHAC2)/GAMMA(XNUC2+3./XALPHAC2)* &
@@ -673,9 +677,9 @@ XGAMINC_BOUND_MIN = 1.0E-1 ! Minimal value of (Lbda * D_cs^lim)**alpha
XGAMINC_BOUND_MAX = 1.0E7 ! Maximal value of (Lbda * D_cs^lim)**alpha
ZRATE = EXP(LOG(XGAMINC_BOUND_MAX/XGAMINC_BOUND_MIN)/REAL(NGAMINC-1))
!
-IF( .NOT.ALLOCATED(XGAMINC_RIM1) ) ALLOCATE( XGAMINC_RIM1(NGAMINC) )
-IF( .NOT.ALLOCATED(XGAMINC_RIM2) ) ALLOCATE( XGAMINC_RIM2(NGAMINC) )
-IF( .NOT.ALLOCATED(XGAMINC_RIM4) ) ALLOCATE( XGAMINC_RIM4(NGAMINC) )
+IF( .NOT.ASSOCIATED(XGAMINC_RIM1) ) CALL RAIN_ICE_ALLOCATE('XGAMINC_RIM1', NGAMINC)
+IF( .NOT.ASSOCIATED(XGAMINC_RIM2) ) CALL RAIN_ICE_ALLOCATE('XGAMINC_RIM2', NGAMINC)
+IF( .NOT.ASSOCIATED(XGAMINC_RIM4) ) CALL RAIN_ICE_ALLOCATE('XGAMINC_RIM4', NGAMINC)
!
DO J1=1,NGAMINC
ZBOUND = XGAMINC_BOUND_MIN*ZRATE**(J1-1)
@@ -725,9 +729,9 @@ IND = 50 ! Interval number, collection efficiency and infinite diameter
ZESR = 1.0 ! factor used to integrate the dimensional distributions when
ZFDINFTY = 20.0 ! computing the kernels XKER_RACCSS, XKER_RACCS and XKER_SACCRG
!
-IF( .NOT.ALLOCATED(XKER_RACCSS) ) ALLOCATE( XKER_RACCSS(NACCLBDAS,NACCLBDAR) )
-IF( .NOT.ALLOCATED(XKER_RACCS ) ) ALLOCATE( XKER_RACCS (NACCLBDAS,NACCLBDAR) )
-IF( .NOT.ALLOCATED(XKER_SACCRG) ) ALLOCATE( XKER_SACCRG(NACCLBDAR,NACCLBDAS) )
+IF( .NOT.ASSOCIATED(XKER_RACCSS) ) CALL RAIN_ICE_ALLOCATE('XKER_RACCSS', NACCLBDAS,NACCLBDAR)
+IF( .NOT.ASSOCIATED(XKER_RACCS ) ) CALL RAIN_ICE_ALLOCATE('XKER_RACCS', NACCLBDAS,NACCLBDAR)
+IF( .NOT.ASSOCIATED(XKER_SACCRG) ) CALL RAIN_ICE_ALLOCATE('XKER_SACCRG', NACCLBDAR,NACCLBDAS)
!
CALL READ_XKER_RACCS (KACCLBDAS,KACCLBDAR,KND, &
PALPHAS,PNUS,PALPHAR,PNUR,PESR,PBS,PBR,PCS,PDS,PCR,PDR, &
@@ -935,7 +939,7 @@ IND = 50 ! Interval number, collection efficiency and infinite diameter
ZEGS = 1.0 ! factor used to integrate the dimensional distributions when
ZFDINFTY = 20.0 ! computing the kernels XKER_SDRYG
!
-IF( .NOT.ALLOCATED(XKER_SDRYG) ) ALLOCATE( XKER_SDRYG(NDRYLBDAG,NDRYLBDAS) )
+IF( .NOT.ASSOCIATED(XKER_SDRYG) ) CALL RAIN_ICE_ALLOCATE('XKER_SDRYG', NDRYLBDAG,NDRYLBDAS)
!
CALL READ_XKER_SDRYG (KDRYLBDAG,KDRYLBDAS,KND, &
PALPHAG,PNUG,PALPHAS,PNUS,PEGS,PBS,PCG,PDG,PCS,PDS, &
@@ -1001,7 +1005,7 @@ IND = 50 ! Number of interval used to integrate the dimensional
ZEGR = 1.0 ! distributions when computing the kernel XKER_RDRYG
ZFDINFTY = 20.0
!
-IF( .NOT.ALLOCATED(XKER_RDRYG) ) ALLOCATE( XKER_RDRYG(NDRYLBDAG,NDRYLBDAR) )
+IF( .NOT.ASSOCIATED(XKER_RDRYG) ) CALL RAIN_ICE_ALLOCATE('XKER_RDRYG', NDRYLBDAG,NDRYLBDAR)
!
CALL READ_XKER_RDRYG (KDRYLBDAG,KDRYLBDAR,KND, &
PALPHAG,PNUG,PALPHAR,PNUR,PEGR,PBR,PCG,PDG,PCR,PDR, &
@@ -1139,7 +1143,7 @@ IND = 50 ! Interval number, collection efficiency and infinite diameter
ZEHS = 1.0 ! factor used to integrate the dimensional distributions when
ZFDINFTY = 20.0 ! computing the kernels XKER_SWETH
!
-IF( .NOT.ALLOCATED(XKER_SWETH) ) ALLOCATE( XKER_SWETH(NWETLBDAH,NWETLBDAS) )
+IF( .NOT.ASSOCIATED(XKER_SWETH) ) CALL RAIN_ICE_ALLOCATE('XKER_SWETH', NWETLBDAH,NWETLBDAS)
!
CALL READ_XKER_SWETH (KWETLBDAH,KWETLBDAS,KND, &
PALPHAH,PNUH,PALPHAS,PNUS,PEHS,PBS,PCH,PDH,PCS,PDS, &
@@ -1205,7 +1209,7 @@ IND = 50 ! Number of interval used to integrate the dimensional
ZEHG = 1.0 ! distributions when computing the kernel XKER_GWETH
ZFDINFTY = 20.0
!
-IF( .NOT.ALLOCATED(XKER_GWETH) ) ALLOCATE( XKER_GWETH(NWETLBDAH,NWETLBDAG) )
+IF( .NOT.ASSOCIATED(XKER_GWETH) ) CALL RAIN_ICE_ALLOCATE('XKER_GWETH', NWETLBDAH,NWETLBDAG)
!
CALL READ_XKER_GWETH (KWETLBDAH,KWETLBDAG,KND, &
PALPHAH,PNUH,PALPHAG,PNUG,PEHG,PBG,PCH,PDH,PCG,PDG, &
@@ -1271,7 +1275,7 @@ IND = 50 ! Number of interval used to integrate the dimensional
ZEHR = 1.0 ! distributions when computing the kernel XKER_RWETH
ZFDINFTY = 20.0
!
-IF( .NOT.ALLOCATED(XKER_RWETH) ) ALLOCATE( XKER_RWETH(NWETLBDAH,NWETLBDAR) )
+IF( .NOT.ASSOCIATED(XKER_RWETH) ) CALL RAIN_ICE_ALLOCATE('XKER_RWETH', NWETLBDAH,NWETLBDAR)
!
CALL READ_XKER_RWETH (KWETLBDAH,KWETLBDAR,KND, &
PALPHAH,PNUH,PALPHAR,PNUR,PEHR,PBR,PCH,PDH,PCR,PDR, &
@@ -1377,6 +1381,7 @@ IF (GFLAG) THEN
WRITE(UNIT=KLUOUT,FMT='(" distribution:AL=",E13.6,"NU=",E13.6)') &
XALPHAH,XNUH
END IF
+IF (LHOOK) CALL DR_HOOK('INI_RAIN_ICE',1,ZHOOK_HANDLE)
CONTAINS
!
!------------------------------------------------------------------------------
diff --git a/src/mesonh/micro/modd_cst.f90 b/src/mesonh/micro/modd_cst.f90
deleted file mode 100644
index 73607888c..000000000
--- a/src/mesonh/micro/modd_cst.f90
+++ /dev/null
@@ -1,116 +0,0 @@
-!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 MODD_CST
-! ###############
-!
-!!**** *MODD_CST* - declaration of Physic constants
-!!
-!! PURPOSE
-!! -------
-! The purpose of this declarative module is to declare the
-! Physics constants.
-!
-!!
-!!** IMPLICIT ARGUMENTS
-!! ------------------
-!! None
-!!
-!! REFERENCE
-!! ---------
-!! Book2 of documentation of Meso-NH (MODD_CST)
-!!
-!! AUTHOR
-!! ------
-!! V. Ducrocq *Meteo France*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 16/05/94
-!! J. Stein 02/01/95 add xrholw
-!! J.-P. Pinty 13/12/95 add XALPI,XBETAI,XGAMI
-!! J. Stein 25/07/97 add XTH00
-!! V. Masson 05/10/98 add XRHOLI
-!! C. Mari 31/10/00 add NDAYSEC
-!! V. Masson 01/03/03 add conductivity of ice
-!! J.Escobar : 10/2017 : for real*4 , add XMNH_HUGE_12_LOG
-!! J.L. Redelsperger 03/2021 add constants for ocean penetrating solar
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-IMPLICIT NONE
-REAL,SAVE :: XPI ! Pi
-!
-REAL,SAVE :: XDAY,XSIYEA,XSIDAY ! day duration, sideral year duration,
- ! sideral day duration
-!
-REAL,SAVE :: XKARMAN ! von karman constant
-REAL,SAVE :: XLIGHTSPEED ! light speed
-REAL,SAVE :: XPLANCK ! Planck constant
-REAL,SAVE :: XBOLTZ ! Boltzman constant
-REAL,SAVE :: XAVOGADRO ! Avogadro number
-!
-REAL,SAVE :: XRADIUS,XOMEGA ! Earth radius, earth rotation
-REAL,SAVE :: XG ! Gravity constant
-!
-REAL,SAVE :: XP00 ! Reference pressure
-REAL,SAVE :: XP00OCEAN ! Reference pressure for ocean model
-REAL,SAVE :: XRH00OCEAN ! Reference density for ocean model
-!
-REAL,SAVE :: XSTEFAN,XI0 ! Stefan-Boltzman constant, solar constant
-!
-REAL,SAVE :: XMD,XMV ! Molar mass of dry air and molar mass of vapor
-REAL,SAVE :: XRD,XRV ! Gaz constant for dry air, gaz constant for vapor
-REAL,SAVE :: XEPSILO ! XMV/XMD
-REAL,SAVE :: XCPD,XCPV ! Cpd (dry air), Cpv (vapor)
-REAL,SAVE :: XRHOLW ! Volumic mass of liquid water
-REAL,SAVE :: XCL,XCI ! Cl (liquid), Ci (ice)
-REAL,SAVE :: XTT ! Triple point temperature
-REAL,SAVE :: XLVTT ! Vaporization heat constant
-REAL,SAVE :: XLSTT ! Sublimation heat constant
-REAL,SAVE :: XLMTT ! Melting heat constant
-REAL,SAVE :: XESTT ! Saturation vapor pressure at triple point
- ! temperature
-REAL,SAVE :: XALPW,XBETAW,XGAMW ! Constants for saturation vapor
- ! pressure function
-REAL,SAVE :: XALPI,XBETAI,XGAMI ! Constants for saturation vapor
- ! pressure function over solid ice
-REAL,SAVE :: XCONDI ! thermal conductivity of ice (W m-1 K-1)
-REAL,SAVE :: XALPHAOC ! thermal expansion coefficient for ocean (K-1)
-REAL,SAVE :: XBETAOC ! Haline contraction coeff for ocean (S-1)
-REAL,SAVE :: XTH00 ! reference value for the potential temperature
-REAL,SAVE :: XTH00OCEAN ! Ref value for pot temp in ocean model
-REAL,SAVE :: XSA00OCEAN ! Ref value for SAlinity in ocean model
-REAL,SAVE :: XROC=0.69! 3 coeffs for SW penetration in Ocean (Hoecker et al)
-REAL,SAVE :: XD1=1.1
-REAL,SAVE :: XD2=23.
-! Values used in SURFEX CMO
-!REAL,SAVE :: XROC=0.58
-!REAL,SAVE :: XD1=0.35
-!REAL,SAVE :: XD2=23.
-
-REAL,SAVE :: XRHOLI ! Volumic mass of liquid water
-!
-INTEGER, SAVE :: NDAYSEC ! Number of seconds in a day
-!
-!
-! Some machine precision value depending of real4/8 use
-!
-REAL,SAVE :: XMNH_TINY ! minimum real on this machine
-REAL,SAVE :: XMNH_TINY_12 ! sqrt(minimum real on this machine)
-REAL,SAVE :: XMNH_EPSILON ! minimum space with 1.0
-REAL,SAVE :: XMNH_HUGE ! maximum real on this machine
-REAL,SAVE :: XMNH_HUGE_12_LOG ! maximum log(sqrt(real)) on this machine
-
-REAL,SAVE :: XEPS_DT ! default value for DT test
-REAL,SAVE :: XRES_FLAT_CART ! default flat&cart residual tolerance
-REAL,SAVE :: XRES_OTHER ! default not flat&cart residual tolerance
-REAL,SAVE :: XRES_PREP ! default prep residual tolerance
-
-!
-END MODULE MODD_CST
diff --git a/src/mesonh/turb/shallow_mf.f90 b/src/mesonh/turb/shallow_mf.f90
index 23dbbec39..7373c5c3d 100644
--- a/src/mesonh/turb/shallow_mf.f90
+++ b/src/mesonh/turb/shallow_mf.f90
@@ -177,6 +177,7 @@ END MODULE MODI_SHALLOW_MF
!
USE MODD_CST
USE MODD_PARAMETERS, ONLY: JPVEXT
+USE MODD_NEB, ONLY: NEB
USE MODD_PARAM_MFSHALL_n
USE MODD_TURB_n, ONLY: CTURBLEN
@@ -188,7 +189,6 @@ USE MODI_MF_TURB
USE MODI_MF_TURB_EXPL
USE MODI_MF_TURB_GREYZONE
USE MODI_COMPUTE_MF_CLOUD
-USE MODE_COMPUTE_FRAC_ICE, ONLY : COMPUTE_FRAC_ICE
USE MODI_SHUMAN_MF
!
USE MODI_COMPUTE_BL89_ML
@@ -323,7 +323,7 @@ IF (SIZE(PRM,3).GE.4) THEN
ZFRAC_ICE(:,:) = PRM(:,:,4) / (PRM(:,:,2)+PRM(:,:,4))
ENDWHERE
ENDIF
-CALL COMPUTE_FRAC_ICE(HFRAC_ICE,ZFRAC_ICE(:,:),PTHM(:,:)*PEXNM(:,:), IERR(:,:))
+CALL COMPUTE_FRAC_ICE(HFRAC_ICE,NEB,ZFRAC_ICE(:,:),PTHM(:,:)*PEXNM(:,:), IERR(:,:))
! Conservative variables at t-dt
CALL THL_RT_FROM_TH_R_MF(KRR,KRRL,KRRI, &
@@ -435,4 +435,7 @@ IF( HMF_UPDRAFT == 'DUAL') THEN
! PDVDT_MF=0.
ENDIF
!
+CONTAINS
+INCLUDE "compute_frac_ice.func.h"
+!
END SUBROUTINE SHALLOW_MF
--
GitLab