diff --git a/.gitignore b/.gitignore
index e627ed90f69b3b3d8559760944babc6051aa86fe..844de1003fa392396b7ffc9909cb347c8980668c 100644
--- a/.gitignore
+++ b/.gitignore
@@ -8,3 +8,7 @@
# Ignore the content of the fiat directory but not the directory itself
/build/with_fcm/fiat/**
!/build/with_fcm/fiat/.gitkeep
+
+# VI temp files
+.*.swp
+.*.swo
diff --git a/docs/TODO b/docs/TODO
index 5e2a3d1124007df6720b9a18484dc62f56c88fef..3a497a2c80faa9eca027e5bafb50b398f14e7d41 100644
--- a/docs/TODO
+++ b/docs/TODO
@@ -23,6 +23,7 @@ Ecrire doc sur marche à suivre pour intégrer un nouveau développement:
- dev dans MNH Ã faire en array-syntax
- dev dans AROME Ã faire en boucles do
- intégration dans PHYEX: en array-syntax avec directives mnh_expand
+ - vérifier les directives mnh_expand à l'aide du script verify_mnh_expand.py
- les 3 tests suivants doivent donner les mêmes résultats (au bit près) dans chacun des deux modèles:
- compilation directe sans activer mnh_expand
- compilation en activant mnh_expand
@@ -50,7 +51,6 @@ Pb identifiés à corriger plus tard:
- th_r_from_thl_rt appelée partout, il faudrait limiter à OTEST
- doute sur le codage de MODD_PRECISION
- appel à abort à travers print_msg non testé
- - indentation inorrecte dans les blocs mnh_expand
- sedimentation momentum non branchée (et à trasformer comme sedim_stat)
- si possible, modifier ice4_sedimentation_split* dans le même esprit que stat
- il faudrait nettoyer les interfaces pour supprimer les clés passées directement
@@ -88,3 +88,5 @@ La taille du buffer utilisé pour th_r_from_thl_rt doit être mise en module et
rain_ice:
- séparer l'avance temporelle du découpage en sous-blocs en créant une couche driver supplémentaire. Cette couche pourrait avoir différentes implémentations (filtre LLMICRO seul, filtre LLMICRO + découpage en sous-blocs, filtre LLMICRO + découpage en sous-blocs en respectant les colonnes, en passant tous les points)
- mettre le code des interpolations linéaires et bi-linéaires dans des routines avec deux implémentations: avec et sans packing
+
+Dans shallow_mf (et toutes les routines appelées en-dessous) il faut remplacer l'utilisation des D%NIB, D%NIE, D%NIT par ce qui sera utilisé dans la turbulence
diff --git a/src/arome/ext/apl_arome.F90 b/src/arome/ext/apl_arome.F90
index a1c496c1f17091abdf59c284391be7f607c1083a..b18816287327048856542d44b0d90c2b9801e69a 100644
--- a/src/arome/ext/apl_arome.F90
+++ b/src/arome/ext/apl_arome.F90
@@ -2911,7 +2911,7 @@ IF (LMFSHAL) THEN
ZARG_FLXZTHVMF_ => ZFLXZTHVMF_(:,1:KLEV)
ENDIF
- CALL ARO_SHALLOW_MF (KKL=IKL, KLON=KFDIA,KLEV=KLEV,KRR=NRR,KRRL=NRRL,&
+ CALL ARO_SHALLOW_MF (KKL=IKL, KLON=KFDIA, KLEV=KLEV, KFDIA=KFDIA, KRR=NRR, KRRL=NRRL,&
& KRRI=NRRI,KSV=NGFL_EXT,HMF_UPDRAFT=CMF_UPDRAFT, HMF_CLOUD=CMF_CLOUD,&
& HFRAC_ICE=CFRAC_ICE_SHALLOW_MF,&
& OMIXUV=LMIXUV, ONOMIXLG=.FALSE.,KSV_LGBEG=0,KSV_LGEND=0,&
diff --git a/src/arome/ext/aro_shallow_mf.F90 b/src/arome/ext/aro_shallow_mf.F90
index 4a59175ab8c1a3ebdb725629820e8a1f87b6e109..6029e44ee50d20715e123dfd68a1c6d61ed53ed6 100644
--- a/src/arome/ext/aro_shallow_mf.F90
+++ b/src/arome/ext/aro_shallow_mf.F90
@@ -1,5 +1,5 @@
! ######spl
- SUBROUTINE ARO_SHALLOW_MF(KKL, KLON,KLEV, KRR, KRRL, KRRI,KSV, &
+ SUBROUTINE ARO_SHALLOW_MF(KKL, KLON, KLEV, KFDIA, KRR, KRRL, KRRI,KSV, &
HMF_UPDRAFT, HMF_CLOUD, HFRAC_ICE, OMIXUV, &
ONOMIXLG,KSV_LGBEG,KSV_LGEND, &
KTCOUNT, PTSTEP, &
@@ -63,9 +63,16 @@
!* 0. DECLARATIONS
! ------------
!
-USE MODD_PARAMETERS, ONLY: JPVEXT, JPHEXT
+USE MODD_PARAMETERS, ONLY: JPVEXT
+USE MODD_CST, ONLY: CST
+USE MODD_NEB, ONLY: NEB
+USE MODD_TURB_n, ONLY: TURBN
+USE MODD_CTURB, ONLY: CSTURB
+USE MODD_PARAM_MFSHALL_n, ONLY: PARAM_MFSHALLN
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
!
USE MODI_SHALLOW_MF
+USE MODE_FILL_DIMPHYEX, ONLY: FILL_DIMPHYEX
!
IMPLICIT NONE
!
@@ -77,6 +84,7 @@ INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground
! atmosphere top, -1 otherwise
INTEGER, INTENT(IN) :: KLON !NPROMA under CPG
INTEGER, INTENT(IN) :: KLEV !Number of vertical levels
+INTEGER, INTENT(IN) :: KFDIA
INTEGER, INTENT(IN) :: KRR ! Number of moist variables
INTEGER, INTENT(IN) :: KRRL ! Number of liquide water variables
INTEGER, INTENT(IN) :: KRRI ! Number of ice variables
@@ -138,23 +146,12 @@ REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PEMF ! updraft mass flux
!
!* 0.2 Declarations of local variables :
!
-INTEGER :: JRR ! Loop index for the moist
-INTEGER :: IIB ! Define the physical domain
-INTEGER :: IIE !
-INTEGER :: IJB !
-INTEGER :: IJE !
-INTEGER :: IKB !
-INTEGER :: IKE !
-INTEGER :: IKA, IKU
-INTEGER :: JI, JJ, JL, JK !
-INTEGER ::II
INTEGER, DIMENSION(size(PRHODJ,1)) :: IKLCL,IKETL,IKCTL
REAL,DIMENSION(size(PRHODJ,1),size(PRHODJ,2)) :: ZFLXZTHMF,ZFLXZRMF,ZFLXZUMF,ZFLXZVMF
REAL,DIMENSION(size(PRHODJ,1),size(PRHODJ,2)) :: ZDETR,ZENTR
-!
-!
-
+TYPE(DIMPHYEX_t) :: YLDIMPHYEX
REAL :: ZIMPL ! degree of implicitness
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!
!
@@ -163,23 +160,10 @@ REAL :: ZIMPL ! degree of implicitness
!* 1. PRELIMINARY COMPUTATIONS
! ------------------------
!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('ARO_SHALLOW_MF',0,ZHOOK_HANDLE)
-
-IIB=1+JPHEXT
-IIE=SIZE(PZZ,1) - JPHEXT
-IJB=1+JPHEXT
-IJE=1 - JPHEXT
-IF(KKL==1)THEN
- IKA=1
- IKU=SIZE(PZZ,2)
-ELSE
- IKA=SIZE(PZZ,2)
- IKU=1
-ENDIF
-IKB=IKA+KKL*JPVEXT
-IKE=IKU-KKL*JPVEXT
+!Dimensions
+CALL FILL_DIMPHYEX(YLDIMPHYEX, KLON, 1, KLEV, JPVEXT, KFDIA)
!
!
!------------------------------------------------------------------------------
@@ -219,11 +203,12 @@ ZIMPL=1.
!
! ---------------------------------
!
- CALL SHALLOW_MF(KKA=IKA,KKU=IKU,KKL=KKL,KRR=KRR,KRRL=KRRL,KRRI=KRRI, &
+ CALL SHALLOW_MF(YLDIMPHYEX, CST, NEB, PARAM_MFSHALLN, TURBN, CSTURB, &
+ &KRR=KRR, KRRL=KRRL, KRRI=KRRI, KSV=KSV, &
&HMF_UPDRAFT=HMF_UPDRAFT, HMF_CLOUD=HMF_CLOUD,HFRAC_ICE=HFRAC_ICE,OMIXUV=OMIXUV, &
&ONOMIXLG=ONOMIXLG,KSV_LGBEG=KSV_LGBEG,KSV_LGEND=KSV_LGEND, &
&PIMPL_MF=ZIMPL, PTSTEP=PTSTEP, &
- &PDZZ=PDZZF,PZZ=PZZ, &
+ &PDZZ=PDZZF,PZZ=PZZ, &
&PRHODJ=PRHODJ,PRHODREF=PRHODREF, &
&PPABSM=PPABSM,PEXNM=PEXNM, &
&PSFTH=PSFTH,PSFRV=PSFRV, &
diff --git a/src/arome/ext/aro_shallow_mf.h b/src/arome/ext/aro_shallow_mf.h
index 07cdb7a7d38e75a76c8c45716c095ddcd22a0e1c..4ec74085e310c9fb67e57b49c972af5708139581 100644
--- a/src/arome/ext/aro_shallow_mf.h
+++ b/src/arome/ext/aro_shallow_mf.h
@@ -1,5 +1,5 @@
INTERFACE
- SUBROUTINE ARO_SHALLOW_MF(KKL, KLON,KLEV, KRR, KRRL, KRRI,KSV,&
+ SUBROUTINE ARO_SHALLOW_MF(KKL, KLON, KLEV, KFDIA, KRR, KRRL, KRRI,KSV,&
& HMF_UPDRAFT, HMF_CLOUD, HFRAC_ICE, OMIXUV,&
& ONOMIXLG,KSV_LGBEG,KSV_LGEND,&
& KTCOUNT, PTSTEP,&
@@ -18,6 +18,7 @@ USE PARKIND1 ,ONLY : JPIM ,JPRB
INTEGER(KIND=JPIM), INTENT(IN) :: KKL
INTEGER(KIND=JPIM), INTENT(IN) :: KLON
INTEGER(KIND=JPIM), INTENT(IN) :: KLEV
+INTEGER(KIND=JPIM), INTENT(IN) :: KFDIA
INTEGER(KIND=JPIM), INTENT(IN) :: KRR
INTEGER(KIND=JPIM), INTENT(IN) :: KRRL
INTEGER(KIND=JPIM), INTENT(IN) :: KRRI
diff --git a/src/arome/ext/arp_shallow_mf.F90 b/src/arome/ext/arp_shallow_mf.F90
index f79aee52db64c9364b9ea455f4407b35b9982604..1a5193bc91f7bb1f71a7cc7c6ea02743dd4efc03 100644
--- a/src/arome/ext/arp_shallow_mf.F90
+++ b/src/arome/ext/arp_shallow_mf.F90
@@ -45,6 +45,7 @@
!! Original 11/2010
!! S. Riette shallow_mf now outputs ice cloud
!! S. Riette Jan 2012: support for both order of vertical levels
+!! S. Riette April 2022: call abort, waiting for an update from an arpege developper...
!!
!-------------------------------------------------------------------------------
!
@@ -55,7 +56,15 @@ USE YOMCST , ONLY : RG, RATM, RKAPPA, RD, RCPD, RCPV
!USE MODD_PARAMETERS
!
+USE MODD_CST, ONLY: CST
+USE MODD_NEB, ONLY: NEB
+USE MODD_TURB_n, ONLY: TURBN
+USE MODD_CTURB, ONLY: CSTURB
+USE MODD_PARAM_MFSHALL_n, ONLY: PARAM_MFSHALLN
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+!
USE MODI_SHALLOW_MF
+USE MODE_FILL_DIMPHYEX, ONLY: FILL_DIMPHYEX
USE MODD_CST
USE YOMCT3
!
@@ -181,6 +190,8 @@ REAL, DIMENSION(KIDIA:KFDIA,KLEV+2) :: ZTKE
REAL, DIMENSION(KIDIA:KFDIA,KLEV+2) :: ZU
REAL, DIMENSION(KIDIA:KFDIA,KLEV+2) :: ZV
REAL, DIMENSION(KIDIA:KFDIA,KLEV+2) :: ZZZF
+TYPE(DIMPHYEX_t) :: YLDIMPHYEX
+#include "abor1.intfb.h"
!------------------------------------------------------------------------------
@@ -190,6 +201,14 @@ REAL, DIMENSION(KIDIA:KFDIA,KLEV+2) :: ZZZF
! Controle :
+!shallow_mf code is now ready to deal with KIDIA/KFDIA
+!Array copies can be suppressed (no need to limit the horizontal domain nor to add the two extra levels)
+!CALL FILL_DIMPHYEX(YLDIMPHYEX, KLON, 1, KLEV, 0, KFDIA)
+
+!For now, copies are done
+CALL FILL_DIMPHYEX(YLDIMPHYEX, KFDIA, 1, KLEV, 1, KFDIA)
+
+CALL ABOR1('ARP_SHALLOW_MF: code must be checked before being activated again')
! Avec inversion des boucles
IKA=1 ! <== Bottom index of array
@@ -372,7 +391,8 @@ ZDRTDT_MF(:,:) = 0.
!
! ---------------------------------
- CALL SHALLOW_MF(KKA=IKA,KKU=IKU,KKL=IKL,KRR=IKR,KRRL=IKRL,KRRI=IKRI, &
+ CALL SHALLOW_MF(YLDIMPHYEX, CST, NEB, PARAM_MFSHALLN, TURBN, CSTURB, &
+ KRR=IKR,KRRL=IKRL,KRRI=IKRI, KSV=1, &
HMF_UPDRAFT=HMF_UPDRAFT, HMF_CLOUD=HMF_CLOUD,HFRAC_ICE='N',OMIXUV=LLOMIXUV, &
ONOMIXLG=LLONOMIXLG,KSV_LGBEG=ISV_LGBEG,KSV_LGEND=ISV_LGEND, &
PIMPL_MF=PIMPL, PTSTEP=ZDT, &
diff --git a/src/common/micro/compute_frac_ice.func.h b/src/common/micro/compute_frac_ice.func.h
index f63cfe5548499d148d97b967ea89afe934f7857c..8c6d4e617d519e2277d3a7defe3b11c95513cafc 100644
--- a/src/common/micro/compute_frac_ice.func.h
+++ b/src/common/micro/compute_frac_ice.func.h
@@ -30,13 +30,13 @@ 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
+INTEGER, OPTIONAL, INTENT(OUT) :: KERR ! Error code in return
!
!------------------------------------------------------------------------
! 1. Compute FRAC_ICE
!
-KERR=0
+IF (PRESENT(KERR)) 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
@@ -48,7 +48,7 @@ SELECT CASE(HFRAC_ICE)
! (almost) nothing to do
PFRAC_ICE = MAX( 0., MIN(1., PFRAC_ICE ) )
CASE DEFAULT
- KERR=1
+ IF (PRESENT(KERR)) KERR=1
END SELECT
END SUBROUTINE COMPUTE_FRAC_ICE
diff --git a/src/common/micro/mode_ice4_compute_pdf.F90 b/src/common/micro/mode_ice4_compute_pdf.F90
index b1d379c55a85bb75c1d6b7cae2d40e87caca3a10..7ccb88c1274867edbcff476743ebf920ea8dc2cc 100644
--- a/src/common/micro/mode_ice4_compute_pdf.F90
+++ b/src/common/micro/mode_ice4_compute_pdf.F90
@@ -152,8 +152,7 @@ ELSEIF(HSUBG_AUCV_RC=='PDF ') THEN
PHLC_LCF(:)=0.
PHLC_HRC(:)=PRCT(:)
PHLC_LRC(:)=0.
- ELSEWHERE(PRCT(:)> (ZRCRAUTC(:)-PSIGMA_RC(:)) .AND. &
- & PRCT(:)<=(ZRCRAUTC(:)+PSIGMA_RC(:)) )
+ ELSEWHERE(PRCT(:)> (ZRCRAUTC(:)-PSIGMA_RC(:)) .AND. PRCT(:)<=(ZRCRAUTC(:)+PSIGMA_RC(:)) )
PHLC_HCF(:)=(PRCT(:)+PSIGMA_RC(:)-ZRCRAUTC(:))/ &
&(2.*PSIGMA_RC(:))
PHLC_LCF(:)=MAX(0., PCF(:)-PHLC_HCF(:))
diff --git a/src/common/turb/modd_param_mfshalln.F90 b/src/common/turb/modd_param_mfshalln.F90
index 936d408ae32e3996df7c130e438f71c0180b9d9b..72a5644bf955b2cf90266ebeed7b161564f081bc 100644
--- a/src/common/turb/modd_param_mfshalln.F90
+++ b/src/common/turb/modd_param_mfshalln.F90
@@ -94,6 +94,7 @@ REAL :: XLAMBDA_MF ! Lambda to compute ThetaS1 from ThetaL
END TYPE PARAM_MFSHALL_t
TYPE(PARAM_MFSHALL_t), DIMENSION(JPMODELMAX), TARGET, SAVE :: PARAM_MFSHALL_MODEL
+TYPE(PARAM_MFSHALL_t), POINTER, SAVE :: PARAM_MFSHALLN => NULL()
REAL , POINTER :: XIMPL_MF=>NULL()
CHARACTER (LEN=4), POINTER :: CMF_UPDRAFT=>NULL()
@@ -131,6 +132,8 @@ CONTAINS
SUBROUTINE PARAM_MFSHALL_GOTO_MODEL(KFROM, KTO)
INTEGER, INTENT(IN) :: KFROM, KTO
!
+PARAM_MFSHALLN => PARAM_MFSHALL_MODEL(KTO)
+!
! Save current state for allocated arrays
!
! Current model is set to model KTO
diff --git a/src/common/turb/mode_compute_bl89_ml.F90 b/src/common/turb/mode_compute_bl89_ml.F90
index 92e576ecb88c25e956df59916a7483e367944cbd..8a8449608426da7b4f40f19053268cde75d8d0f6 100644
--- a/src/common/turb/mode_compute_bl89_ml.F90
+++ b/src/common/turb/mode_compute_bl89_ml.F90
@@ -2,7 +2,7 @@ MODULE MODE_COMPUTE_BL89_ML
IMPLICIT NONE
CONTAINS
! ######spl
- SUBROUTINE COMPUTE_BL89_ML(KKA,KKB,KKE,KKU,KKL,PDZZ2D, &
+ SUBROUTINE COMPUTE_BL89_ML(D, CST, CSTURB,PDZZ2D, &
PTKEM_DEP,PG_O_THVREF,PVPT,KK,OUPORDN,OFLUX,PSHEAR,PLWORK)
USE PARKIND1, ONLY : JPRB
@@ -40,8 +40,9 @@ CONTAINS
!but algorithm must remain the same.
!!!!!!!!!!!!
!
-USE MODD_CTURB
-USE MODD_PARAMETERS, ONLY: JPVEXT
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+USE MODD_CST, ONLY: CST_t
+USE MODD_CTURB, ONLY: CSTURB_t
!
USE MODE_MSG
!
@@ -51,34 +52,31 @@ IMPLICIT NONE
!
! 0.1 arguments
!
-INTEGER, INTENT(IN) :: KKA ! near ground array index
-INTEGER, INTENT(IN) :: KKB ! near ground physical index
-INTEGER, INTENT(IN) :: KKE ! uppest atmosphere physical index
-INTEGER, INTENT(IN) :: KKU ! uppest atmosphere array index
-INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
-REAL, DIMENSION(:,:), INTENT(IN) :: PDZZ2D ! height difference between two mass levels
-REAL, DIMENSION(:), INTENT(IN) :: PTKEM_DEP ! TKE to consume
-REAL, DIMENSION(:), INTENT(IN) :: PG_O_THVREF ! g/ThetaVRef at the departure point
-REAL, DIMENSION(:,:), INTENT(IN) :: PVPT ! ThetaV on mass levels
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+TYPE(CST_t), INTENT(IN) :: CST
+TYPE(CSTURB_t), INTENT(IN) :: CSTURB
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(IN) :: PDZZ2D ! height difference between two mass levels
+REAL, DIMENSION(D%NIT), INTENT(IN) :: PTKEM_DEP ! TKE to consume
+REAL, DIMENSION(D%NIT), INTENT(IN) :: PG_O_THVREF ! g/ThetaVRef at the departure point
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(IN) :: PVPT ! ThetaV on mass levels
INTEGER, INTENT(IN) :: KK ! index of departure level
LOGICAL, INTENT(IN) :: OUPORDN ! switch to compute upward (true) or
! downward (false) mixing length
LOGICAL, INTENT(IN) :: OFLUX ! Computation must be done from flux level
-REAL, DIMENSION(:), INTENT(OUT) :: PLWORK ! Resulting mixing length
-REAL, DIMENSION(:,:), INTENT(IN) :: PSHEAR ! vertical wind shear for RM17 mixing length
+REAL, DIMENSION(D%NIT), INTENT(OUT) :: PLWORK ! Resulting mixing length
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(IN) :: PSHEAR ! vertical wind shear for RM17 mixing length
! 0.2 Local variable
!
-REAL, DIMENSION(SIZE(PVPT,1)) :: ZLWORK1,ZLWORK2 ! Temporary mixing length
-REAL, DIMENSION(SIZE(PVPT,1)) :: ZINTE,ZPOTE ! TKE and potential energy
+REAL, DIMENSION(D%NIT) :: ZLWORK1,ZLWORK2 ! Temporary mixing length
+REAL, DIMENSION(D%NIT) :: ZINTE,ZPOTE ! TKE and potential energy
! between 2 levels
-REAL, DIMENSION(SIZE(PVPT,1)) :: ZVPT_DEP ! Thetav on departure point
+REAL, DIMENSION(D%NIT) :: ZVPT_DEP ! Thetav on departure point
!
-REAL, DIMENSION(SIZE(PVPT,1),SIZE(PVPT,2)) :: ZDELTVPT,ZHLVPT
+REAL, DIMENSION(D%NIT,D%NKT) :: ZDELTVPT,ZHLVPT
!Virtual Potential Temp at Half level and DeltaThv between
!2 mass levels
-INTEGER :: IIJU !Internal Domain
INTEGER :: J1D !horizontal loop counter
INTEGER :: JKK !loop counters
REAL :: ZTEST,ZTEST0,ZTESTM !test for vectorization
@@ -88,20 +86,19 @@ REAL :: ZTEST,ZTEST0,ZTESTM !test for vectorization
! --------------
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('COMPUTE_BL89_ML',0,ZHOOK_HANDLE)
-IIJU=SIZE(PVPT,1)
!
-ZDELTVPT(:,:)=DZM_MF(PVPT(:,:), KKA, KKU, KKL)
-ZDELTVPT(:,KKA)=0.
-WHERE (ABS(ZDELTVPT(:,:))<XLINF)
- ZDELTVPT(:,:)=XLINF
+CALL DZM_MF(D, PVPT(:,:), ZDELTVPT(:,:))
+ZDELTVPT(:,D%NKA)=0.
+WHERE (ABS(ZDELTVPT(:,:))<CSTURB%XLINF)
+ ZDELTVPT(:,:)=CSTURB%XLINF
END WHERE
!
-ZHLVPT(:,:)=MZM_MF(PVPT(:,:), KKA, KKU, KKL)
+CALL MZM_MF(D, PVPT(:,:), ZHLVPT(:,:))
!
!We consider that gradient between mass levels KKB and KKB+KKL is the same as
!the gradient between flux level KKB and mass level KKB
-ZDELTVPT(:,KKB)=PDZZ2D(:,KKB)*ZDELTVPT(:,KKB+KKL)/PDZZ2D(:,KKB+KKL)
-ZHLVPT(:,KKB)=PVPT(:,KKB)-ZDELTVPT(:,KKB)*0.5
+ZDELTVPT(:,D%NKB)=PDZZ2D(:,D%NKB)*ZDELTVPT(:,D%NKB+D%NKL)/PDZZ2D(:,D%NKB+D%NKL)
+ZHLVPT(:,D%NKB)=PVPT(:,D%NKB)-ZDELTVPT(:,D%NKB)*0.5
!
!
!
@@ -116,12 +113,12 @@ IF (OUPORDN.EQV..TRUE.) THEN
IF(OFLUX)THEN
ZVPT_DEP(:)=ZHLVPT(:,KK) ! departure point is on flux level
!We must compute what happens between flux level KK and mass level KK
- DO J1D=1,IIJU
+ DO J1D=1,D%NIT
ZTEST0=0.5+SIGN(0.5,ZINTE(J1D)) ! test if there's energy to consume
! Energy consumed if parcel cross the entire layer
ZPOTE(J1D) = ZTEST0*(PG_O_THVREF(J1D) * &
(0.5*(ZHLVPT(J1D,KK)+ PVPT(J1D,KK)) - ZVPT_DEP(J1D)) + &
- XRM17*PSHEAR(J1D,KK)*SQRT(ABS(PTKEM_DEP(J1D)))) * &
+ CSTURB%XRM17*PSHEAR(J1D,KK)*SQRT(ABS(PTKEM_DEP(J1D)))) * &
PDZZ2D(J1D,KK)*0.5
! Test if it rests some energy to consume
ZTEST =0.5+SIGN(0.5,ZINTE(J1D)-ZPOTE(J1D))
@@ -130,9 +127,9 @@ IF (OUPORDN.EQV..TRUE.) THEN
! Lenght travelled by parcel to nullify energy
ZLWORK2(J1D)= ( - PG_O_THVREF(J1D) * &
( ZHLVPT(J1D,KK) - ZVPT_DEP(J1D) ) &
- - XRM17*PSHEAR(J1D,KK)*SQRT(ABS(PTKEM_DEP(J1D))) &
+ - CSTURB%XRM17*PSHEAR(J1D,KK)*SQRT(ABS(PTKEM_DEP(J1D))) &
+ SQRT (ABS( &
- (XRM17*PSHEAR(J1D,KK)*SQRT(ABS(PTKEM_DEP(J1D))) + &
+ (CSTURB%XRM17*PSHEAR(J1D,KK)*SQRT(ABS(PTKEM_DEP(J1D))) + &
PG_O_THVREF(J1D) * (ZHLVPT(J1D,KK) - ZVPT_DEP(J1D)) )**2 &
+ 2. * ZINTE(J1D) * PG_O_THVREF(J1D) &
* ZDELTVPT(J1D,KK) / PDZZ2D(J1D,KK) )) ) / &
@@ -147,24 +144,24 @@ IF (OUPORDN.EQV..TRUE.) THEN
ZVPT_DEP(:)=PVPT(:,KK) ! departure point is on mass level
ENDIF
- DO JKK=KK+KKL,KKE,KKL
+ DO JKK=KK+D%NKL,D%NKE,D%NKL
IF(ZTESTM > 0.) THEN
ZTESTM=0
- DO J1D=1,IIJU
+ DO J1D=1,D%NIT
ZTEST0=0.5+SIGN(0.5,ZINTE(J1D))
ZPOTE(J1D) = ZTEST0*(PG_O_THVREF(J1D) * &
(ZHLVPT(J1D,JKK) - ZVPT_DEP(J1D)) &
- + XRM17*PSHEAR(J1D,JKK)*SQRT(ABS(PTKEM_DEP(J1D))))* PDZZ2D(J1D,JKK)
+ + CSTURB%XRM17*PSHEAR(J1D,JKK)*SQRT(ABS(PTKEM_DEP(J1D))))* PDZZ2D(J1D,JKK)
ZTEST =0.5+SIGN(0.5,ZINTE(J1D)-ZPOTE(J1D))
ZTESTM=ZTESTM+ZTEST0
ZLWORK1(J1D)=PDZZ2D(J1D,JKK)
!ZLWORK2 jump of the last reached level
ZLWORK2(J1D)= ( - PG_O_THVREF(J1D) * &
- ( PVPT(J1D,JKK-KKL) - ZVPT_DEP(J1D) ) &
- - XRM17*PSHEAR(J1D,JKK)*sqrt(abs(PTKEM_DEP(J1D))) &
+ ( PVPT(J1D,JKK-D%NKL) - ZVPT_DEP(J1D) ) &
+ - CSTURB%XRM17*PSHEAR(J1D,JKK)*sqrt(abs(PTKEM_DEP(J1D))) &
+ SQRT (ABS( &
- (XRM17*PSHEAR(J1D,JKK)*sqrt(abs(PTKEM_DEP(J1D))) + &
- PG_O_THVREF(J1D) * (PVPT(J1D,JKK-KKL) - ZVPT_DEP(J1D)) )**2 &
+ (CSTURB%XRM17*PSHEAR(J1D,JKK)*sqrt(abs(PTKEM_DEP(J1D))) + &
+ PG_O_THVREF(J1D) * (PVPT(J1D,JKK-D%NKL) - ZVPT_DEP(J1D)) )**2 &
+ 2. * ZINTE(J1D) * PG_O_THVREF(J1D) &
* ZDELTVPT(J1D,JKK) / PDZZ2D(J1D,JKK) )) ) / &
( PG_O_THVREF(J1D) * ZDELTVPT(J1D,JKK) / PDZZ2D(J1D,JKK) )
@@ -186,22 +183,22 @@ IF (OUPORDN.EQV..FALSE.) THEN
ZINTE(:)=PTKEM_DEP(:)
PLWORK=0.
ZTESTM=1.
- DO JKK=KK,KKB,-KKL
+ DO JKK=KK,D%NKB,-D%NKL
IF(ZTESTM > 0.) THEN
ZTESTM=0
- DO J1D=1,IIJU
+ DO J1D=1,D%NIT
ZTEST0=0.5+SIGN(0.5,ZINTE(J1D))
ZPOTE(J1D) = ZTEST0*(-PG_O_THVREF(J1D) * &
(ZHLVPT(J1D,JKK) - PVPT(J1D,KK)) &
- + XRM17*PSHEAR(J1D,JKK)*SQRT(ABS(PTKEM_DEP(J1D))))* PDZZ2D(J1D,JKK)
+ + CSTURB%XRM17*PSHEAR(J1D,JKK)*SQRT(ABS(PTKEM_DEP(J1D))))* PDZZ2D(J1D,JKK)
ZTEST =0.5+SIGN(0.5,ZINTE(J1D)-ZPOTE(J1D))
ZTESTM=ZTESTM+ZTEST0
ZLWORK1(J1D)=PDZZ2D(J1D,JKK)
ZLWORK2(J1D)= ( + PG_O_THVREF(J1D) * &
( PVPT(J1D,JKK) - PVPT(J1D,KK) ) &
- -XRM17*PSHEAR(J1D,JKK)*sqrt(abs(PTKEM_DEP(J1D))) &
+ -CSTURB%XRM17*PSHEAR(J1D,JKK)*sqrt(abs(PTKEM_DEP(J1D))) &
+ SQRT (ABS( &
- (XRM17*PSHEAR(J1D,JKK)*sqrt(abs(PTKEM_DEP(J1D))) - &
+ (CSTURB%XRM17*PSHEAR(J1D,JKK)*sqrt(abs(PTKEM_DEP(J1D))) - &
PG_O_THVREF(J1D) * (PVPT(J1D,JKK) - PVPT(J1D,KK)) )**2 &
+ 2. * ZINTE(J1D) * PG_O_THVREF(J1D) &
* ZDELTVPT(J1D,JKK) / PDZZ2D(J1D,JKK) )) ) / &
diff --git a/src/common/turb/mode_compute_entr_detr.F90 b/src/common/turb/mode_compute_entr_detr.F90
deleted file mode 100644
index 7d8fae529856f3a50b886d7d64389b5b8f30f7e2..0000000000000000000000000000000000000000
--- a/src/common/turb/mode_compute_entr_detr.F90
+++ /dev/null
@@ -1,443 +0,0 @@
-!MNH_LIC Copyright 2009-2021 CNRS, Meteo-France and Universite Paul Sabatier
-!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!MNH_LIC for details. version 1.
-! ######spl
- MODULE MODE_COMPUTE_ENTR_DETR
-! ##############################
-!
-IMPLICIT NONE
-CONTAINS
-! ######spl
- SUBROUTINE COMPUTE_ENTR_DETR(KK,KKB,KKE,KKL,OTEST,OTESTLCL,&
- HFRAC_ICE,PFRAC_ICE,PRHODREF,&
- PPRE_MINUS_HALF,&
- PPRE_PLUS_HALF,PZZ,PDZZ,&
- PTHVM,PTHLM,PRTM,PW_UP2,PTH_UP,&
- PTHL_UP,PRT_UP,PLUP,&
- PRC_UP,PRI_UP,PTHV_UP,&
- PRSAT_UP,PRC_MIX,PRI_MIX, &
- PENTR,PDETR,PENTR_CLD,PDETR_CLD,&
- PBUO_INTEG_DRY,PBUO_INTEG_CLD,&
- PPART_DRY)
-! #############################################################
-
-!!
-!!***COMPUTE_ENTR_DETR* - calculates caracteristics of the updraft or downdraft
-!! using model of the EDMF scheme
-!!
-!! PURPOSE
-!! -------
-!!**** The purpose of this routine is to compute entrainement and
-!! detrainement at one level of the updraft
-!
-!!** METHOD
-!! ------
-!!
-!! EXTERNAL
-!! --------
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!! REFERENCE
-!! ---------
-!! Book 1 of Meso-NH documentation (chapter Convection)
-!!
-!!
-!! AUTHOR
-!! ------
-!! J.Pergaud : 2009
-!!
-!! MODIFICATIONS
-!! -------------
-!! Y.Seity (06/2010) Bug correction
-!! V.Masson (09/2010) Optimization
-!! S. Riette april 2011 : ice added, protection against zero divide by Yves Bouteloup
-!! protection against too big ZPART_DRY, interface modified
-!! S. Riette Jan 2012: support for both order of vertical levels
-!! S. Riette & J. Escobar (11/2013) : remove div by 0 on real*4 case
-!! P.Marguinaud Jun 2012: fix uninitialized variable
-!! P.Marguinaud Nov 2012: fix gfortran bug
-!! S. Riette Apr 2013: bugs correction, rewriting (for optimisation) and
-!! improvement of continuity at the condensation level
-!! S. Riette Nov 2013: protection against zero divide for min value of dry PDETR
-!! R.Honnert Oct 2016 : Update with AROME
-! P. Wautelet 08/02/2019: bugfix: compute ZEPSI_CLOUD only once and only when it is needed
-!! R. El Khatib 29-Apr-2019 portability fix : compiler may get confused by embricked WHERE statements
-!! eventually breaking tests with NaN initializations at compile time.
-!! Replace by IF conditions and traditional DO loops can only improve the performance.
-! P. Wautelet 10/02/2021: bugfix: initialized PPART_DRY everywhere
-!! --------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_CST
-!
-USE MODD_PARAM_MFSHALL_n
-!
-USE MODE_TH_R_FROM_THL_RT_1D, ONLY: TH_R_FROM_THL_RT_1D
-!
-USE MODE_THERMO
-USE PARKIND1, ONLY : JPRB
-USE YOMHOOK , ONLY : LHOOK, DR_HOOK
-
-IMPLICIT NONE
-!
-!
-!* 1.1 Declaration of Arguments
-!
-!
-INTEGER, INTENT(IN) :: KK
-INTEGER, INTENT(IN) :: KKB ! near ground physical index
-INTEGER, INTENT(IN) :: KKE ! uppest atmosphere physical index
-INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
-LOGICAL,DIMENSION(:), INTENT(IN) :: OTEST ! test to see if updraft is running
-LOGICAL,DIMENSION(:), INTENT(IN) :: OTESTLCL !test of condensation
-CHARACTER(LEN=1), INTENT(IN) :: HFRAC_ICE ! frac_ice can be compute using
- ! Temperature (T) or prescribed
- ! (Y)
-REAL, DIMENSION(:), INTENT(IN) :: PFRAC_ICE ! fraction of ice
-!
-! prognostic variables at t- deltat
-!
-REAL, DIMENSION(:), INTENT(IN) :: PRHODREF !rhodref
-REAL, DIMENSION(:), INTENT(IN) :: PPRE_MINUS_HALF ! Pressure at flux level KK
-REAL, DIMENSION(:), INTENT(IN) :: PPRE_PLUS_HALF ! Pressure at flux level KK+KKL
-REAL, DIMENSION(:,:), INTENT(IN) :: PZZ ! Height at the flux point
-REAL, DIMENSION(:,:), INTENT(IN) :: PDZZ ! metrics coefficient
-REAL, DIMENSION(:,:), INTENT(IN) :: PTHVM ! ThetaV environment
-
-!
-! thermodynamical variables which are transformed in conservative var.
-!
-REAL, DIMENSION(:,:), INTENT(IN) :: PTHLM ! Thetal
-REAL, DIMENSION(:,:), INTENT(IN) :: PRTM ! total mixing ratio
-REAL, DIMENSION(:,:), INTENT(IN) :: PW_UP2 ! Vertical velocity^2
-REAL, DIMENSION(:), INTENT(IN) :: PTH_UP,PTHL_UP,PRT_UP ! updraft properties
-REAL, DIMENSION(:), INTENT(IN) :: PLUP ! LUP compute from the ground
-REAL, DIMENSION(:), INTENT(IN) :: PRC_UP,PRI_UP ! Updraft cloud content
-REAL, DIMENSION(:), INTENT(IN) :: PTHV_UP ! Thetav of updraft
-REAL, DIMENSION(:), INTENT(IN) :: PRSAT_UP ! Mixing ratio at saturation in updraft
-REAL, DIMENSION(:), INTENT(INOUT) :: PRC_MIX, PRI_MIX ! Mixture cloud content
-REAL, DIMENSION(:), INTENT(OUT) :: PENTR ! Mass flux entrainment of the updraft
-REAL, DIMENSION(:), INTENT(OUT) :: PDETR ! Mass flux detrainment of the updraft
-REAL, DIMENSION(:), INTENT(OUT) :: PENTR_CLD ! Mass flux entrainment of the updraft in cloudy part
-REAL, DIMENSION(:), INTENT(OUT) :: PDETR_CLD ! Mass flux detrainment of the updraft in cloudy part
-REAL, DIMENSION(:), INTENT(OUT) :: PBUO_INTEG_DRY, PBUO_INTEG_CLD! Integral Buoyancy
-REAL, DIMENSION(:), INTENT(OUT) :: PPART_DRY ! ratio of dry part at the transition level
-!
-!
-! 1.2 Declaration of local variables
-!
-!
-
-! Variables for cloudy part
-REAL, DIMENSION(SIZE(PTHLM,1)) :: ZKIC, ZKIC_F2 ! fraction of env. mass in the muxtures
-REAL, DIMENSION(SIZE(PTHLM,1)) :: ZEPSI,ZDELTA ! factor entrainment detrainment
-REAL :: ZEPSI_CLOUD ! factor entrainment detrainment
-REAL :: ZCOEFFMF_CLOUD ! factor for compputing entr. detr.
-REAL, DIMENSION(SIZE(PTHLM,1)) :: ZMIXTHL,ZMIXRT ! Thetal and rt in the mixtures
-REAL, DIMENSION(SIZE(PTHLM,1)) :: ZTHMIX ! Theta and Thetav of mixtures
-REAL, DIMENSION(SIZE(PTHLM,1)) :: ZRVMIX,ZRCMIX,ZRIMIX ! mixing ratios in mixtures
-REAL, DIMENSION(SIZE(PTHLM,1)) :: ZTHVMIX, ZTHVMIX_F2 ! Theta and Thetav of mixtures
-REAL, DIMENSION(SIZE(PTHLM,1)) :: ZTHV_UP_F2 ! thv_up at flux point kk+kkl
-REAL, DIMENSION(SIZE(PTHLM,1)) :: ZRSATW, ZRSATI ! working arrays (mixing ratio at saturation)
-REAL, DIMENSION(SIZE(PTHLM,1)) :: ZTHV ! theta V of environment at the bottom of cloudy part
-REAL :: ZKIC_INIT !Initial value of ZKIC
-REAL :: ZCOTHVU ! Variation of Thvup between bottom and top of cloudy part
-
-! Variables for dry part
-REAL :: ZFOESW, ZFOESI ! saturating vapor pressure
-REAL :: ZDRSATODP ! d.Rsat/dP
-REAL :: ZT ! Temperature
-REAL :: ZWK ! Work array
-
-! Variables for dry and cloudy parts
-REAL, DIMENSION(SIZE(PTHLM,1)) :: ZCOEFF_MINUS_HALF,& ! Variation of Thv between mass points kk-kkl and kk
- ZCOEFF_PLUS_HALF ! Variation of Thv between mass points kk and kk+kkl
-REAL, DIMENSION(SIZE(PTHLM,1)) :: ZPRE ! pressure at the bottom of the cloudy part
-REAL, DIMENSION(SIZE(PTHVM,1)) :: ZG_O_THVREF
-REAL, DIMENSION(SIZE(PTHLM,1)) :: ZFRAC_ICE ! fraction of ice
-REAL :: ZRVORD ! RV/RD
-REAL, DIMENSION(SIZE(PTHLM,1)) :: ZDZ_STOP,& ! Exact Height of the LCL above flux level KK
- ZTHV_MINUS_HALF,& ! Thv at flux point(kk)
- ZTHV_PLUS_HALF ! Thv at flux point(kk+kkl)
-REAL :: ZDZ ! Delta Z used in computations
-INTEGER :: JI, JLOOP
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!----------------------------------------------------------------------------------
-
-! 1.3 Initialisation
-! ------------------
- IF (LHOOK) CALL DR_HOOK('COMPUTE_ENTR_DETR',0,ZHOOK_HANDLE)
-
- ZRVORD = XRV / XRD !=1.607
- ZG_O_THVREF(:)=XG/PTHVM(:,KK)
- ZCOEFFMF_CLOUD=XENTR_MF * XG / XCRAD_MF
-
- ZFRAC_ICE(:)=PFRAC_ICE(:) ! to not modify fraction of ice
-
- ZPRE(:)=PPRE_MINUS_HALF(:)
-
-! 1.4 Estimation of PPART_DRY
- DO JLOOP=1,SIZE(OTEST)
- IF(OTEST(JLOOP) .AND. OTESTLCL(JLOOP)) THEN
- !No dry part when condensation level is reached
- PPART_DRY(JLOOP)=0.
- ZDZ_STOP(JLOOP)=0.
- ZPRE(JLOOP)=PPRE_MINUS_HALF(JLOOP)
- ELSE IF (OTEST(JLOOP) .AND. .NOT. OTESTLCL(JLOOP)) THEN
- !Temperature at flux level KK
- ZT=PTH_UP(JLOOP)*(PPRE_MINUS_HALF(JLOOP)/XP00) ** (XRD/XCPD)
- !Saturating vapor pressure at flux level KK
- ZFOESW = MIN(EXP( XALPW - XBETAW/ZT - XGAMW*LOG(ZT) ), 0.99*PPRE_MINUS_HALF(JLOOP))
- ZFOESI = MIN(EXP( XALPI - XBETAI/ZT - XGAMI*LOG(ZT) ), 0.99*PPRE_MINUS_HALF(JLOOP))
- !Computation of d.Rsat / dP (partial derivations with respect to P and T
- !and use of T=Theta*(P/P0)**(R/Cp) to transform dT into dP with theta_up
- !constant at the vertical)
- ZDRSATODP=(XBETAW/ZT-XGAMW)*(1-ZFRAC_ICE(JLOOP))+(XBETAI/ZT-XGAMI)*ZFRAC_ICE(JLOOP)
- ZDRSATODP=((XRD/XCPD)*ZDRSATODP-1.)*PRSAT_UP(JLOOP)/ &
- &(PPRE_MINUS_HALF(JLOOP)-(ZFOESW*(1-ZFRAC_ICE(JLOOP)) + ZFOESI*ZFRAC_ICE(JLOOP)))
- !Use of d.Rsat / dP and pressure at flux level KK to find pressure (ZPRE)
- !where Rsat is equal to PRT_UP
- ZPRE(JLOOP)=PPRE_MINUS_HALF(JLOOP)+(PRT_UP(JLOOP)-PRSAT_UP(JLOOP))/ZDRSATODP
- !Fraction of dry part (computed with pressure and used with heights, no
- !impact found when using log function here and for pressure on flux levels
- !computation)
- PPART_DRY(JLOOP)=MAX(0., MIN(1., (PPRE_MINUS_HALF(JLOOP)-ZPRE(JLOOP))/(PPRE_MINUS_HALF(JLOOP)-PPRE_PLUS_HALF(JLOOP))))
- !Height above flux level KK of the cloudy part
- ZDZ_STOP(JLOOP) = (PZZ(JLOOP,KK+KKL)-PZZ(JLOOP,KK))*PPART_DRY(JLOOP)
- ELSE
- PPART_DRY(JLOOP)=0. ! value does not matter, here
- END IF
- END DO
-
-! 1.5 Gradient and flux values of thetav
- IF(KK/=KKB)THEN
- ZCOEFF_MINUS_HALF(:)=((PTHVM(:,KK)-PTHVM(:,KK-KKL))/PDZZ(:,KK))
- ZTHV_MINUS_HALF(:) = PTHVM(:,KK) - ZCOEFF_MINUS_HALF(:)*0.5*(PZZ(:,KK+KKL)-PZZ(:,KK))
- ELSE
- ZCOEFF_MINUS_HALF(:)=0.
- ZTHV_MINUS_HALF(:) = PTHVM(:,KK)
- ENDIF
- ZCOEFF_PLUS_HALF(:) = ((PTHVM(:,KK+KKL)-PTHVM(:,KK))/PDZZ(:,KK+KKL))
- ZTHV_PLUS_HALF(:) = PTHVM(:,KK) + ZCOEFF_PLUS_HALF(:)*0.5*(PZZ(:,KK+KKL)-PZZ(:,KK))
-
-! 2 Dry part computation:
-! Integral buoyancy and computation of PENTR and PDETR for dry part
-! --------------------------------------------------------------------
-
-DO JLOOP=1,SIZE(OTEST)
- IF (OTEST(JLOOP) .AND. PPART_DRY(JLOOP)>0.) THEN
- !Buoyancy computation in two parts to use change of gradient of theta v of environment
- !Between flux level KK and min(mass level, bottom of cloudy part)
- ZDZ=MIN(ZDZ_STOP(JLOOP),(PZZ(JLOOP,KK+KKL)-PZZ(JLOOP,KK))*0.5)
- PBUO_INTEG_DRY(JLOOP) = ZG_O_THVREF(JLOOP)*ZDZ*&
- (0.5 * ( - ZCOEFF_MINUS_HALF(JLOOP))*ZDZ &
- - ZTHV_MINUS_HALF(JLOOP) + PTHV_UP(JLOOP) )
-
- !Between mass flux KK and bottom of cloudy part (if above mass flux)
- ZDZ=MAX(0., ZDZ_STOP(JLOOP)-(PZZ(JLOOP,KK+KKL)-PZZ(JLOOP,KK))*0.5)
- PBUO_INTEG_DRY(JLOOP) = PBUO_INTEG_DRY(JLOOP) + ZG_O_THVREF(JLOOP)*ZDZ*&
- (0.5 * ( - ZCOEFF_PLUS_HALF(JLOOP))*ZDZ &
- - PTHVM(JLOOP,KK) + PTHV_UP(JLOOP) )
-
- !Entr//Detr. computation
- IF (PBUO_INTEG_DRY(JLOOP)>=0.) THEN
- PENTR(JLOOP) = 0.5/(XABUO-XBENTR*XENTR_DRY)*&
- LOG(1.+ (2.*(XABUO-XBENTR*XENTR_DRY)/PW_UP2(JLOOP,KK))* &
- PBUO_INTEG_DRY(JLOOP))
- PDETR(JLOOP) = 0.
- ELSE
- PENTR(JLOOP) = 0.
- PDETR(JLOOP) = 0.5/(XABUO)*&
- LOG(1.+ (2.*(XABUO)/PW_UP2(JLOOP,KK))* &
- (-PBUO_INTEG_DRY(JLOOP)))
- ENDIF
- PENTR(JLOOP) = XENTR_DRY*PENTR(JLOOP)/(PZZ(JLOOP,KK+KKL)-PZZ(JLOOP,KK))
- PDETR(JLOOP) = XDETR_DRY*PDETR(JLOOP)/(PZZ(JLOOP,KK+KKL)-PZZ(JLOOP,KK))
- !Minimum value of detrainment
- ZWK=PLUP(JLOOP)-0.5*(PZZ(JLOOP,KK)+PZZ(JLOOP,KK+KKL))
- ZWK=SIGN(MAX(1., ABS(ZWK)), ZWK) ! ZWK must not be zero
- PDETR(JLOOP) = MAX(PPART_DRY(JLOOP)*XDETR_LUP/ZWK, PDETR(JLOOP))
- ELSE
- !No dry part, condensation reached (OTESTLCL)
- PBUO_INTEG_DRY(JLOOP) = 0.
- PENTR(JLOOP)=0.
- PDETR(JLOOP)=0.
- ENDIF
-ENDDO
-
-! 3 Wet part computation
-! -----------------------
-
-! 3.1 Integral buoyancy for cloudy part
-
- ! Compute theta_v of updraft at flux level KK+KKL
- !MIX variables are used to avoid declaring new variables
- !but we are dealing with updraft and not mixture
- ZRCMIX(:)=PRC_UP(:)
- ZRIMIX(:)=PRI_UP(:)
- CALL TH_R_FROM_THL_RT_1D(HFRAC_ICE,ZFRAC_ICE,&
- PPRE_PLUS_HALF,PTHL_UP,PRT_UP,&
- ZTHMIX,ZRVMIX,ZRCMIX,ZRIMIX,&
- ZRSATW, ZRSATI,OOCEAN=.FALSE.)
- ZTHV_UP_F2(:) = ZTHMIX(:)*(1.+ZRVORD*ZRVMIX(:))/(1.+PRT_UP(:))
-
- ! Integral buoyancy for cloudy part
- DO JLOOP=1,SIZE(OTEST)
- IF(OTEST(JLOOP) .AND. PPART_DRY(JLOOP)<1.) THEN
- !Gradient of Theta V updraft over the cloudy part, assuming that thetaV updraft don't change
- !between flux level KK and bottom of cloudy part
- ZCOTHVU=(ZTHV_UP_F2(JLOOP)-PTHV_UP(JLOOP))/((PZZ(JLOOP,KK+KKL)-PZZ(JLOOP,KK))*(1-PPART_DRY(JLOOP)))
-
- !Computation in two parts to use change of gradient of theta v of environment
- !Between bottom of cloudy part (if under mass level) and mass level KK
- ZDZ=MAX(0., 0.5*(PZZ(JLOOP,KK+KKL)-PZZ(JLOOP,KK))-ZDZ_STOP(JLOOP))
- PBUO_INTEG_CLD(JLOOP) = ZG_O_THVREF(JLOOP)*ZDZ*&
- (0.5*( ZCOTHVU - ZCOEFF_MINUS_HALF(JLOOP))*ZDZ &
- - (PTHVM(JLOOP,KK)-ZDZ*ZCOEFF_MINUS_HALF(JLOOP)) + PTHV_UP(JLOOP) )
-
- !Between max(mass level, bottom of cloudy part) and flux level KK+KKL
- ZDZ=(PZZ(JLOOP,KK+KKL)-PZZ(JLOOP,KK))-MAX(ZDZ_STOP(JLOOP),0.5*(PZZ(JLOOP,KK+KKL)-PZZ(JLOOP,KK)))
- PBUO_INTEG_CLD(JLOOP) = PBUO_INTEG_CLD(JLOOP)+ZG_O_THVREF(JLOOP)*ZDZ*&
- (0.5*( ZCOTHVU - ZCOEFF_PLUS_HALF(JLOOP))*ZDZ&
- - (PTHVM(JLOOP,KK)+(0.5*((PZZ(JLOOP,KK+KKL)-PZZ(JLOOP,KK)))-ZDZ)*ZCOEFF_PLUS_HALF(JLOOP)) +&
- PTHV_UP(JLOOP) )
-
- ELSE
- !No cloudy part
- PBUO_INTEG_CLD(JLOOP)=0.
- END IF
- END DO
-
-! 3.2 Critical mixed fraction for KK+KKL flux level (ZKIC_F2) and
-! for bottom of cloudy part (ZKIC), then a mean for the cloudy part
-! (put also in ZKIC)
-!
-! computation by estimating unknown
-! T^mix r_c^mix and r_i^mix from enthalpy^mix and r_w^mix
-! We determine the zero crossing of the linear curve
-! evaluating the derivative using ZMIXF=0.1
-
- ZKIC_INIT=0.1 ! starting value for critical mixed fraction for CLoudy Part
-
- ! Compute thetaV of environment at the bottom of cloudy part
- ! and cons then non cons. var. of mixture at the bottom of cloudy part
-
- ! JI computed to avoid KKL(KK-KKL) being < KKL*KKB
-JI=KKL*MAX(KKL*(KK-KKL),KKL*KKB)
-DO JLOOP=1,SIZE(OTEST)
- IF(OTEST(JLOOP) .AND. PPART_DRY(JLOOP)>0.5) THEN
- ZDZ=ZDZ_STOP(JLOOP)-0.5*(PZZ(JLOOP,KK+KKL)-PZZ(JLOOP,KK))
- ZTHV(JLOOP)= PTHVM(JLOOP,KK)+ZCOEFF_PLUS_HALF(JLOOP)*ZDZ
- ZMIXTHL(JLOOP) = ZKIC_INIT * &
- (PTHLM(JLOOP,KK)+ZDZ*(PTHLM(JLOOP,KK+KKL)-PTHLM(JLOOP,KK))/PDZZ(JLOOP,KK+KKL)) + &
- (1. - ZKIC_INIT)*PTHL_UP(JLOOP)
- ZMIXRT(JLOOP) = ZKIC_INIT * &
- (PRTM(JLOOP,KK)+ZDZ*(PRTM(JLOOP,KK+KKL)-PRTM(JLOOP,KK))/PDZZ(JLOOP,KK+KKL)) + &
- (1. - ZKIC_INIT)*PRT_UP(JLOOP)
- ELSEIF(OTEST(JLOOP)) THEN
- ZDZ=0.5*(PZZ(JLOOP,KK+KKL)-PZZ(JLOOP,KK))-ZDZ_STOP(JLOOP)
- ZTHV(JLOOP)= PTHVM(JLOOP,KK)-ZCOEFF_MINUS_HALF(JLOOP)*ZDZ
- ZMIXTHL(JLOOP) = ZKIC_INIT * &
- (PTHLM(JLOOP,KK)-ZDZ*(PTHLM(JLOOP,KK)-PTHLM(JLOOP,JI))/PDZZ(JLOOP,KK)) + &
- (1. - ZKIC_INIT)*PTHL_UP(JLOOP)
- ZMIXRT(JLOOP) = ZKIC_INIT * &
- (PRTM(JLOOP,KK)-ZDZ*(PRTM(JLOOP,KK)-PRTM(JLOOP,JI))/PDZZ(JLOOP,KK)) + &
- (1. - ZKIC_INIT)*PRT_UP(JLOOP)
- ELSE
-#ifdef REPRO55
- ZMIXTHL(JLOOP) = 0.1
-#else
- ZMIXTHL(JLOOP) = 300.
-#endif
- ZMIXRT(JLOOP) = 0.1
- ENDIF
-ENDDO
- CALL TH_R_FROM_THL_RT_1D(HFRAC_ICE,ZFRAC_ICE,&
- ZPRE,ZMIXTHL,ZMIXRT,&
- ZTHMIX,ZRVMIX,PRC_MIX,PRI_MIX,&
- ZRSATW, ZRSATI,OOCEAN=.FALSE.)
- ZTHVMIX(:) = ZTHMIX(:)*(1.+ZRVORD*ZRVMIX(:))/(1.+ZMIXRT(:))
-
- ! Compute cons then non cons. var. of mixture at the flux level KK+KKL with initial ZKIC
- ZMIXTHL(:) = ZKIC_INIT * 0.5*(PTHLM(:,KK)+PTHLM(:,KK+KKL))+(1. - ZKIC_INIT)*PTHL_UP(:)
- ZMIXRT(:) = ZKIC_INIT * 0.5*(PRTM(:,KK)+PRTM(:,KK+KKL))+(1. - ZKIC_INIT)*PRT_UP(:)
- CALL TH_R_FROM_THL_RT_1D(HFRAC_ICE,ZFRAC_ICE,&
- PPRE_PLUS_HALF,ZMIXTHL,ZMIXRT,&
- ZTHMIX,ZRVMIX,PRC_MIX,PRI_MIX,&
- ZRSATW, ZRSATI,OOCEAN=.FALSE.)
- ZTHVMIX_F2(:) = ZTHMIX(:)*(1.+ZRVORD*ZRVMIX(:))/(1.+ZMIXRT(:))
-
- !Computation of mean ZKIC over the cloudy part
-DO JLOOP=1,SIZE(OTEST)
- IF (OTEST(JLOOP)) THEN
- ! Compute ZKIC at the bottom of cloudy part
- ! Thetav_up at bottom is equal to Thetav_up at flux level KK
- IF (ABS(PTHV_UP(JLOOP)-ZTHVMIX(JLOOP))<1.E-10) THEN
- ZKIC(JLOOP)=1.
- ELSE
- ZKIC(JLOOP) = MAX(0.,PTHV_UP(JLOOP)-ZTHV(JLOOP))*ZKIC_INIT / &
- (PTHV_UP(JLOOP)-ZTHVMIX(JLOOP))
- END IF
- ! Compute ZKIC_F2 at flux level KK+KKL
- IF (ABS(ZTHV_UP_F2(JLOOP)-ZTHVMIX_F2(JLOOP))<1.E-10) THEN
- ZKIC_F2(JLOOP)=1.
- ELSE
- ZKIC_F2(JLOOP) = MAX(0.,ZTHV_UP_F2(JLOOP)-ZTHV_PLUS_HALF(JLOOP))*ZKIC_INIT / &
- (ZTHV_UP_F2(JLOOP)-ZTHVMIX_F2(JLOOP))
- END IF
- !Mean ZKIC over the cloudy part
- ZKIC(JLOOP)=MAX(MIN(0.5*(ZKIC(JLOOP)+ZKIC_F2(JLOOP)),1.),0.)
- END IF
-END DO
-
-! 3.3 Integration of PDF
-! According to Kain and Fritsch (1990), we replace delta Mt
-! in eq. (7) and (8) using eq. (5). Here we compute the ratio
-! of integrals without computing delta Me
-
- !Constant PDF
- !For this PDF, eq. (5) is delta Me=0.5*delta Mt
-DO JLOOP=1,SIZE(OTEST)
- IF(OTEST(JLOOP)) THEN
- ZEPSI(JLOOP) = ZKIC(JLOOP)**2. !integration multiplied by 2
- ZDELTA(JLOOP) = (1.-ZKIC(JLOOP))**2. !idem
- ENDIF
-ENDDO
-
- !Triangular PDF
- !Calculus must be verified before activating this part, but in this state,
- !results on ARM case are almost identical
- !For this PDF, eq. (5) is also delta Me=0.5*delta Mt
- !WHERE(OTEST)
- ! !Integration multiplied by 2
- ! WHERE(ZKIC<0.5)
- ! ZEPSI(:)=8.*ZKIC(:)**3/3.
- ! ZDELTA(:)=1.-4.*ZKIC(:)**2+8.*ZKIC(:)**3/3.
- ! ELSEWHERE
- ! ZEPSI(:)=5./3.-4*ZKIC(:)**2+8.*ZKIC(:)**3/3.
- ! ZDELTA(:)=8.*(1.-ZKIC(:))**3/3.
- ! ENDWHERE
- !ENDWHERE
-
-! 3.4 Computation of PENTR and PDETR
-DO JLOOP=1,SIZE(OTEST)
- IF(OTEST(JLOOP)) THEN
- ZEPSI_CLOUD=MIN(ZDELTA(JLOOP), ZEPSI(JLOOP))
- PENTR_CLD(JLOOP) = (1.-PPART_DRY(JLOOP))*ZCOEFFMF_CLOUD*PRHODREF(JLOOP)*ZEPSI_CLOUD
- PDETR_CLD(JLOOP) = (1.-PPART_DRY(JLOOP))*ZCOEFFMF_CLOUD*PRHODREF(JLOOP)*ZDELTA(JLOOP)
- PENTR(JLOOP) = PENTR(JLOOP)+PENTR_CLD(JLOOP)
- PDETR(JLOOP) = PDETR(JLOOP)+PDETR_CLD(JLOOP)
- ELSE
- PENTR_CLD(JLOOP) = 0.
- PDETR_CLD(JLOOP) = 0.
- ENDIF
-ENDDO
-
-IF (LHOOK) CALL DR_HOOK('COMPUTE_ENTR_DETR',1,ZHOOK_HANDLE)
-END SUBROUTINE COMPUTE_ENTR_DETR
-END MODULE MODE_COMPUTE_ENTR_DETR
diff --git a/src/common/turb/mode_compute_function_thermo_mf.F90 b/src/common/turb/mode_compute_function_thermo_mf.F90
index 64cc93462a8539820657547cf78cff60ce859fb9..265a8c5cd77fd8425d3b17ce6dd0ac3b3b077120 100644
--- a/src/common/turb/mode_compute_function_thermo_mf.F90
+++ b/src/common/turb/mode_compute_function_thermo_mf.F90
@@ -8,7 +8,7 @@
!
IMPLICIT NONE
CONTAINS
- SUBROUTINE COMPUTE_FUNCTION_THERMO_MF( KRR,KRRL,KRRI, &
+ SUBROUTINE COMPUTE_FUNCTION_THERMO_MF(D, CST, KRR,KRRL,KRRI, &
PTH, PR, PEXN, PFRAC_ICE, PPABS, &
PT,PAMOIST,PATHETA )
! #################################################################
@@ -50,7 +50,8 @@ CONTAINS
!* 0. DECLARATIONS
! ------------
!
-USE MODD_CST
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+USE MODD_CST, ONLY: CST_t
USE PARKIND1, ONLY : JPRB
USE YOMHOOK , ONLY : LHOOK, DR_HOOK
!
@@ -59,25 +60,27 @@ IMPLICIT NONE
!
!* 0.1 declarations of arguments
!
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+TYPE(CST_t), INTENT(IN) :: CST
INTEGER, INTENT(IN) :: KRR ! number of moist var.
INTEGER, INTENT(IN) :: KRRL ! number of liquid water var.
INTEGER, INTENT(IN) :: KRRI ! number of ice water var.
-REAL, DIMENSION(:,:), INTENT(IN) :: PTH ! theta
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PR ! water species
-REAL, DIMENSION(:,:) , INTENT(IN) :: PPABS,PEXN ! pressure, Exner funct.
-REAL, DIMENSION(:,:) , INTENT(IN) :: PFRAC_ICE ! ice fraction
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(IN) :: PTH ! theta
+REAL, DIMENSION(D%NIT,D%NKT,KRR), INTENT(IN) :: PR ! water species
+REAL, DIMENSION(D%NIT,D%NKT) , INTENT(IN) :: PPABS,PEXN ! pressure, Exner funct.
+REAL, DIMENSION(D%NIT,D%NKT) , INTENT(IN) :: PFRAC_ICE ! ice fraction
-REAL, DIMENSION(:,:), INTENT(OUT) :: PT ! temperature
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(OUT) :: PT ! temperature
-REAL, DIMENSION(:,:), INTENT(OUT) :: PAMOIST,PATHETA
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(OUT) :: PAMOIST,PATHETA
!
!-------------------------------------------------------------------------------
!
!* 0.2 Declarations of local variables
!
REAL :: ZEPS ! XMV / XMD
-REAL, DIMENSION(SIZE(PTH,1),SIZE(PTH,2)) :: &
+REAL, DIMENSION(D%NIT,D%NKT) :: &
ZCP, & ! Cp
ZE, & ! Saturation mixing ratio
ZDEDT, & ! Saturation mixing ratio derivative
@@ -94,21 +97,21 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('COMPUTE_FUNCTION_THERMO_MF',0,ZHOOK_HANDLE)
!
- ZEPS = XMV / XMD
+ ZEPS = CST%XMV / CST%XMD
!
!* Cph
!
-ZCP=XCPD
+ZCP=CST%XCPD
-IF (KRR > 0) ZCP(:,:) = ZCP(:,:) + XCPV * PR(:,:,1)
+IF (KRR > 0) ZCP(:,:) = ZCP(:,:) + CST%XCPV * PR(:,:,1)
DO JRR = 2,1+KRRL ! loop on the liquid components
- ZCP(:,:) = ZCP(:,:) + XCL * PR(:,:,JRR)
+ ZCP(:,:) = ZCP(:,:) + CST%XCL * PR(:,:,JRR)
END DO
DO JRR = 2+KRRL,1+KRRL+KRRI ! loop on the solid components
- ZCP(:,:) = ZCP(:,:) + XCI * PR(:,:,JRR)
+ ZCP(:,:) = ZCP(:,:) + CST%XCI * PR(:,:,JRR)
END DO
!* Temperature
@@ -122,11 +125,11 @@ IF ( KRRL >= 1 ) THEN
!
!* Lv/Cph
!
- ZLVOCP(:,:) = (XLVTT + (XCPV-XCL) * (PT(:,:)-XTT) ) / ZCP(:,:)
+ ZLVOCP(:,:) = (CST%XLVTT + (CST%XCPV-CST%XCL) * (PT(:,:)-CST%XTT) ) / ZCP(:,:)
!
!* Saturation vapor pressure with respect to water
!
- ZE(:,:) = EXP( XALPW - XBETAW/PT(:,:) - XGAMW*ALOG( PT(:,:) ) )
+ ZE(:,:) = EXP( CST%XALPW - CST%XBETAW/PT(:,:) - CST%XGAMW*ALOG( PT(:,:) ) )
!
!* Saturation mixing ratio with respect to water
!
@@ -134,7 +137,7 @@ IF ( KRRL >= 1 ) THEN
!
!* Compute the saturation mixing ratio derivative (rvs')
!
- ZDEDT(:,:) = ( XBETAW / PT(:,:) - XGAMW ) / PT(:,:) &
+ ZDEDT(:,:) = ( CST%XBETAW / PT(:,:) - CST%XGAMW ) / PT(:,:) &
* ZE(:,:) * ( 1. + ZE(:,:) / ZEPS )
!
!* Compute Amoist
@@ -148,9 +151,9 @@ IF ( KRRL >= 1 ) THEN
( 1. + ZDEDT(:,:) * ZLVOCP(:,:) ) * &
( &
ZE(:,:) * (1. + ZE(:,:)/ZEPS) &
- * ( -2.*XBETAW/PT(:,:) + XGAMW ) / PT(:,:)**2 &
+ * ( -2.*CST%XBETAW/PT(:,:) + CST%XGAMW ) / PT(:,:)**2 &
+ZDEDT(:,:) * (1. + 2. * ZE(:,:)/ZEPS) &
- * ( XBETAW/PT(:,:) - XGAMW ) / PT(:,:) &
+ * ( CST%XBETAW/PT(:,:) - CST%XGAMW ) / PT(:,:) &
) &
- ZDEDT(:,:) &
)
@@ -163,11 +166,11 @@ IF ( KRRL >= 1 ) THEN
!
!* Ls/Cph
!
- ZLSOCP(:,:) = (XLSTT + (XCPV-XCI) * (PT(:,:)-XTT) ) / ZCP(:,:)
+ ZLSOCP(:,:) = (CST%XLSTT + (CST%XCPV-CST%XCI) * (PT(:,:)-CST%XTT) ) / ZCP(:,:)
!
!* Saturation vapor pressure with respect to ice
!
- ZE(:,:) = EXP( XALPI - XBETAI/PT(:,:) - XGAMI*ALOG( PT(:,:) ) )
+ ZE(:,:) = EXP( CST%XALPI - CST%XBETAI/PT(:,:) - CST%XGAMI*ALOG( PT(:,:) ) )
!
!* Saturation mixing ratio with respect to ice
!
@@ -175,7 +178,7 @@ IF ( KRRL >= 1 ) THEN
!
!* Compute the saturation mixing ratio derivative (rvs')
!
- ZDEDT(:,:) = ( XBETAI / PT(:,:) - XGAMI ) / PT(:,:) &
+ ZDEDT(:,:) = ( CST%XBETAI / PT(:,:) - CST%XGAMI ) / PT(:,:) &
* ZE(:,:) * ( 1. + ZE(:,:) / ZEPS )
!
!* Compute Amoist
@@ -189,9 +192,9 @@ IF ( KRRL >= 1 ) THEN
( 1. + ZDEDT(:,:) * ZLSOCP(:,:) ) * &
( &
ZE(:,:) * (1. + ZE(:,:)/ZEPS) &
- * ( -2.*XBETAI/PT(:,:) + XGAMI ) / PT(:,:)**2 &
+ * ( -2.*CST%XBETAI/PT(:,:) + CST%XGAMI ) / PT(:,:)**2 &
+ZDEDT(:,:) * (1. + 2. * ZE(:,:)/ZEPS) &
- * ( XBETAI/PT(:,:) - XGAMI ) / PT(:,:) &
+ * ( CST%XBETAI/PT(:,:) - CST%XGAMI ) / PT(:,:) &
) &
- ZDEDT(:,:) &
)
diff --git a/src/common/turb/mode_compute_mf_cloud.F90 b/src/common/turb/mode_compute_mf_cloud.F90
index 7792adb25787829f9d597b25f55bd389ae29d32e..5ed752cb5bec17b56f9e98c53f5b2e785e346c50 100644
--- a/src/common/turb/mode_compute_mf_cloud.F90
+++ b/src/common/turb/mode_compute_mf_cloud.F90
@@ -11,7 +11,7 @@ IMPLICIT NONE
CONTAINS
!
! ######spl
- SUBROUTINE COMPUTE_MF_CLOUD(KKA,KKB,KKE,KKU,KKL,KRR,KRRL,KRRI,HMF_CLOUD,&
+ SUBROUTINE COMPUTE_MF_CLOUD(D, CST, PARAMMF, KRR, KRRL, KRRI, HMF_CLOUD,&
PFRAC_ICE, &
PRC_UP,PRI_UP,PEMF, &
PTHL_UP, PRT_UP, PFRAC_UP, &
@@ -60,6 +60,10 @@ CONTAINS
!* 0. DECLARATIONS
! ------------
!
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+USE MODD_CST, ONLY: CST_t
+USE MODD_PARAM_MFSHALL_n, ONLY: PARAM_MFSHALL_t
+!
USE MODE_MSG
!
USE MODE_COMPUTE_MF_CLOUD_DIRECT, ONLY: COMPUTE_MF_CLOUD_DIRECT
@@ -75,33 +79,31 @@ IMPLICIT NONE
!
!
!
-INTEGER, INTENT(IN) :: KKA ! near ground array index
-INTEGER, INTENT(IN) :: KKB ! near ground physical index
-INTEGER, INTENT(IN) :: KKE ! uppest atmosphere physical index
-INTEGER, INTENT(IN) :: KKU ! uppest atmosphere array index
-INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+TYPE(CST_t), INTENT(IN) :: CST
+TYPE(PARAM_MFSHALL_t), INTENT(IN) :: PARAMMF
INTEGER, INTENT(IN) :: KRR ! number of moist var.
INTEGER, INTENT(IN) :: KRRL ! number of liquid water var.
INTEGER, INTENT(IN) :: KRRI ! number of ice water var.
CHARACTER (LEN=4), INTENT(IN) :: HMF_CLOUD ! Type of statistical cloud scheme
-REAL, DIMENSION(:,:), INTENT(IN) :: PFRAC_ICE ! liquid/ice fraction
-REAL, DIMENSION(:,:), INTENT(IN) :: PRC_UP,PRI_UP,PEMF! updraft characteritics
-REAL, DIMENSION(:,:), INTENT(IN) :: PTHL_UP, PRT_UP ! rc,w,Mass Flux,Thetal,rt
-REAL, DIMENSION(:,:), INTENT(IN) :: PFRAC_UP ! Updraft Fraction
-REAL, DIMENSION(:,:), INTENT(IN) :: PTHV_UP ! updraft thetaV
-REAL, DIMENSION(:,:), INTENT(IN) :: PFRAC_ICE_UP ! liquid/solid fraction in updraft
-REAL, DIMENSION(:,:), INTENT(IN) :: PRSAT_UP ! Rsat in updraft
-REAL, DIMENSION(:,:), INTENT(IN) :: PEXNM ! exner function
-REAL, DIMENSION(:,:), INTENT(IN) :: PTHLM, PRTM ! cons. var. at t-dt
-REAL, DIMENSION(:,:), INTENT(IN) :: PTHM, PTHVM ! theta and thetaV
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRM ! water var. at t-dt
-REAL, DIMENSION(:,:), INTENT(IN) :: PDZZ, PZZ
-INTEGER, DIMENSION(:), INTENT(IN) :: KKLCL ! index of updraft condensation level
-REAL, DIMENSION(:,:), INTENT(IN) :: PPABSM, PRHODREF ! environement
-REAL, DIMENSION(:,:), INTENT(OUT) :: PRC_MF, PRI_MF ! cloud content (INPUT=environment, OUTPUT=conv. cloud)
-REAL, DIMENSION(:,:), INTENT(OUT) :: PCF_MF ! and cloud fraction for MF scheme
-REAL, DIMENSION(:,:), INTENT(OUT) :: PSIGMF ! SQRT(variance) for statistical cloud scheme
-REAL, DIMENSION(:), INTENT(IN) :: PDEPTH ! Deepness of cloud
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(IN) :: PFRAC_ICE ! liquid/ice fraction
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(IN) :: PRC_UP,PRI_UP,PEMF! updraft characteritics
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(IN) :: PTHL_UP, PRT_UP ! rc,w,Mass Flux,Thetal,rt
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(IN) :: PFRAC_UP ! Updraft Fraction
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(IN) :: PTHV_UP ! updraft thetaV
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(IN) :: PFRAC_ICE_UP ! liquid/solid fraction in updraft
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(IN) :: PRSAT_UP ! Rsat in updraft
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(IN) :: PEXNM ! exner function
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(IN) :: PTHLM, PRTM ! cons. var. at t-dt
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(IN) :: PTHM, PTHVM ! theta and thetaV
+REAL, DIMENSION(D%NIT,D%NKT,KRR), INTENT(IN) :: PRM ! water var. at t-dt
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(IN) :: PDZZ, PZZ
+INTEGER, DIMENSION(D%NIT), INTENT(IN) :: KKLCL ! index of updraft condensation level
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(IN) :: PPABSM, PRHODREF ! environement
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(OUT) :: PRC_MF, PRI_MF ! cloud content (INPUT=environment, OUTPUT=conv. cloud)
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(OUT) :: PCF_MF ! and cloud fraction for MF scheme
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(OUT) :: PSIGMF ! SQRT(variance) for statistical cloud scheme
+REAL, DIMENSION(D%NIT), INTENT(IN) :: PDEPTH ! Deepness of cloud
!
! 1.2 Declaration of local variables
@@ -122,14 +124,14 @@ PSIGMF = 0.
IF (HMF_CLOUD == 'DIRE') THEN
!Direct cloud scheme
- CALL COMPUTE_MF_CLOUD_DIRECT(KKB, KKE, KKL, &
+ CALL COMPUTE_MF_CLOUD_DIRECT(D, PARAMMF, &
&KKLCL(:), PFRAC_UP(:,:), PRC_UP(:,:), PRI_UP(:,:),&
&PRC_MF(:,:), PRI_MF(:,:), PCF_MF(:,:))
!
ELSEIF (HMF_CLOUD == 'STAT') THEN
!Statistical scheme using the PDF proposed by Bougeault (81, 82) and
!Bechtold et al (95).
- CALL COMPUTE_MF_CLOUD_STAT(KKA, KKB, KKE, KKU, KKL, KRR, KRRL, KRRI,&
+ CALL COMPUTE_MF_CLOUD_STAT(D, CST, PARAMMF, KRR, KRRL, KRRI,&
&PFRAC_ICE,&
&PTHLM, PRTM, PPABSM, PRM,&
&PDZZ, PTHM, PEXNM,&
@@ -137,7 +139,7 @@ ELSEIF (HMF_CLOUD == 'STAT') THEN
&PSIGMF)
ELSEIF (HMF_CLOUD == 'BIGA') THEN
!Statistical scheme using the bi-gaussian PDF proposed by E. Perraud.
- CALL COMPUTE_MF_CLOUD_BIGAUS(KKA, KKB, KKE, KKU, KKL,&
+ CALL COMPUTE_MF_CLOUD_BIGAUS(D, CST, PARAMMF,&
&PEMF, PDEPTH,&
&PRT_UP, PTHV_UP, PFRAC_ICE_UP, PRSAT_UP,&
&PRTM, PTHM, PTHVM,&
diff --git a/src/common/turb/mode_compute_mf_cloud_bigaus.F90 b/src/common/turb/mode_compute_mf_cloud_bigaus.F90
index 6fc2dfe69e294576ad93e95559820d106b0eaa72..180532c20cab2bf81bc79b47634932894c890f6f 100644
--- a/src/common/turb/mode_compute_mf_cloud_bigaus.F90
+++ b/src/common/turb/mode_compute_mf_cloud_bigaus.F90
@@ -9,7 +9,7 @@
!
IMPLICIT NONE
CONTAINS
- SUBROUTINE COMPUTE_MF_CLOUD_BIGAUS(KKA, KKB, KKE, KKU, KKL,&
+ SUBROUTINE COMPUTE_MF_CLOUD_BIGAUS(D, CST, PARAMMF,&
PEMF, PDEPTH,&
PRT_UP, PTHV_UP, PFRAC_ICE_UP, PRSAT_UP,&
PRTM, PTHM, PTHVM,&
@@ -57,13 +57,11 @@ CONTAINS
!
!* 0. DECLARATIONS
! ------------
-USE MODD_PARAM_MFSHALL_n, ONLY : XALPHA_MF, XSIGMA_MF
-USE MODD_CST, ONLY : XPI, XG
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+USE MODD_CST, ONLY: CST_t
+USE MODD_PARAM_MFSHALL_n, ONLY: PARAM_MFSHALL_t
!
USE MODI_SHUMAN_MF, ONLY: MZF_MF, GZ_M_W_MF
-USE MODI_GAMMA_INC
-!
-USE MODE_THERMO
!
USE PARKIND1, ONLY : JPRB
USE YOMHOOK , ONLY : LHOOK, DR_HOOK
@@ -72,35 +70,33 @@ IMPLICIT NONE
!
!* 0.1 Declaration of Arguments
!
-INTEGER, INTENT(IN) :: KKA ! near ground array index
-INTEGER, INTENT(IN) :: KKB ! near ground physical index
-INTEGER, INTENT(IN) :: KKE ! uppest atmosphere physical index
-INTEGER, INTENT(IN) :: KKU ! uppest atmosphere array index
-INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
-REAL, DIMENSION(:,:), INTENT(IN) :: PEMF ! updraft characteritics
-REAL, DIMENSION(:), INTENT(IN) :: PDEPTH ! Deepness of cloud
-REAL, DIMENSION(:,:), INTENT(IN) :: PTHV_UP, PRSAT_UP, PRT_UP ! updraft characteritics
-REAL, DIMENSION(:,:), INTENT(IN) :: PFRAC_ICE_UP ! liquid/ice fraction in updraft
-REAL, DIMENSION(:,:), INTENT(IN) :: PTHM, PRTM, PTHVM ! env. var. at t-dt
-REAL, DIMENSION(:,:), INTENT(IN) :: PDZZ, PZZ
-REAL, DIMENSION(:,:), INTENT(IN) :: PRHODREF
-REAL, DIMENSION(:,:), INTENT(OUT) :: PRC_MF, PRI_MF ! cloud content
-REAL, DIMENSION(:,:), INTENT(OUT) :: PCF_MF ! and cloud fraction for MF scheme
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+TYPE(CST_t), INTENT(IN) :: CST
+TYPE(PARAM_MFSHALL_t), INTENT(IN) :: PARAMMF
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(IN) :: PEMF ! updraft characteritics
+REAL, DIMENSION(D%NIT), INTENT(IN) :: PDEPTH ! Deepness of cloud
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(IN) :: PTHV_UP, PRSAT_UP, PRT_UP ! updraft characteritics
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(IN) :: PFRAC_ICE_UP ! liquid/ice fraction in updraft
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(IN) :: PTHM, PRTM, PTHVM ! env. var. at t-dt
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(IN) :: PDZZ, PZZ
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(IN) :: PRHODREF
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(OUT) :: PRC_MF, PRI_MF ! cloud content
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(OUT) :: PCF_MF ! and cloud fraction for MF scheme
!
!* 0.1 Declaration of local variables
!
!
-REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZGRAD_Z_RT, & !
+REAL, DIMENSION(D%NIT,D%NKT) :: ZGRAD_Z_RT, & !
& ZALPHA_UP_M, & ! Variables used to compute variance
& ZSIGMF ! and sqrt(variance)
-REAL, DIMENSION(SIZE(PTHM,1)) :: ZOMEGA_UP_M !
-REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZW1 ! working array
-INTEGER :: JK ! vertical loop control
-REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZEMF_M, ZTHV_UP_M, & !
+REAL, DIMENSION(D%NIT) :: ZOMEGA_UP_M !
+REAL, DIMENSION(D%NIT,D%NKT) :: ZW1 ! working array
+INTEGER :: JI, JK ! loop control
+REAL, DIMENSION(D%NIT,D%NKT) :: ZEMF_M, ZTHV_UP_M, & !
& ZRSAT_UP_M, ZRT_UP_M,& ! Interpolation on mass points
& ZFRAC_ICE_UP_M !
-REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZCOND ! condensate
-REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZA, ZGAM ! used for integration
+REAL, DIMENSION(D%NIT,D%NKT) :: ZCOND ! condensate
+REAL, DIMENSION(D%NIT,D%NKT) :: ZA, ZGAM ! used for integration
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('COMPUTE_MF_CLOUD_BIGAUS',0,ZHOOK_HANDLE)
@@ -113,70 +109,83 @@ IF (LHOOK) CALL DR_HOOK('COMPUTE_MF_CLOUD_BIGAUS',0,ZHOOK_HANDLE)
!
!
!Vertical gradient of RT, result on mass points
-ZW1(:,:)=GZ_M_W_MF(PRTM(:,:), PDZZ(:,:), KKA, KKU, KKL)
-ZGRAD_Z_RT(:,:)=MZF_MF(ZW1(:,:), KKA, KKU, KKL)
+CALL GZ_M_W_MF(D, PRTM(:,:), PDZZ(:,:), ZW1(:,:))
+CALL MZF_MF(D, ZW1(:,:), ZGRAD_Z_RT(:,:))
!Interpolation on mass points
-ZTHV_UP_M(:,:) = MZF_MF(PTHV_UP(:,:), KKA, KKU, KKL)
-ZRSAT_UP_M(:,:)= MZF_MF(PRSAT_UP(:,:), KKA, KKU, KKL)
-ZRT_UP_M(:,:) = MZF_MF(PRT_UP(:,:), KKA, KKU, KKL)
-ZEMF_M(:,:) = MZF_MF(PEMF(:,:), KKA, KKU, KKL)
-ZFRAC_ICE_UP_M(:,:) = MZF_MF(PFRAC_ICE_UP(:,:), KKA, KKU, KKL)
+CALL MZF_MF(D, PTHV_UP(:,:), ZTHV_UP_M(:,:))
+CALL MZF_MF(D, PRSAT_UP(:,:), ZRSAT_UP_M(:,:))
+CALL MZF_MF(D, PRT_UP(:,:), ZRT_UP_M(:,:))
+CALL MZF_MF(D, PEMF(:,:), ZEMF_M(:,:))
+CALL MZF_MF(D, PFRAC_ICE_UP(:,:), ZFRAC_ICE_UP_M(:,:))
!computation of omega star up
ZOMEGA_UP_M(:)=0.
-DO JK=KKB,KKE-KKL,KKL
+DO JK=D%NKB,D%NKE-D%NKL,D%NKL
+ !$mnh_expand_array(JI=D%NIB:D%NIE)
!Vertical integration over the entire column but only buoyant points are used
- !ZOMEGA_UP_M(:)=ZOMEGA_UP_M(:) + &
- ! ZEMF_M(:,JK) * &
- ! MAX(0.,(ZTHV_UP_M(:,JK)-PTHVM(:,JK))) * &
- ! (PZZ(:,JK+KKL)-PZZ(:,JK)) / &
- ! (PTHM(:,JK) * PRHODREF(:,JK))
+ !ZOMEGA_UP_M(D%NIB:D%NIE)=ZOMEGA_UP_M(D%NIB:D%NIE) + &
+ ! ZEMF_M(D%NIB:D%NIE,JK) * &
+ ! MAX(0.,(ZTHV_UP_M(D%NIB:D%NIE,JK)-PTHVM(D%NIB:D%NIE,JK))) * &
+ ! (PZZ(D%NIB:D%NIE,JK+KKL)-PZZ(D%NIB:D%NIE,JK)) / &
+ ! (PTHM(D%NIB:D%NIE,JK) * PRHODREF(D%NIB:D%NIE,JK))
!Vertical integration over the entire column
- ZOMEGA_UP_M(:)=ZOMEGA_UP_M(:) + &
- ZEMF_M(:,JK) * &
- (ZTHV_UP_M(:,JK)-PTHVM(:,JK)) * &
- (PZZ(:,JK+KKL)-PZZ(:,JK)) / &
- (PTHM(:,JK) * PRHODREF(:,JK))
+ ZOMEGA_UP_M(D%NIB:D%NIE)=ZOMEGA_UP_M(D%NIB:D%NIE) + &
+ ZEMF_M(D%NIB:D%NIE,JK) * &
+ (ZTHV_UP_M(D%NIB:D%NIE,JK)-PTHVM(D%NIB:D%NIE,JK)) * &
+ (PZZ(D%NIB:D%NIE,JK+D%NKL)-PZZ(D%NIB:D%NIE,JK)) / &
+ (PTHM(D%NIB:D%NIE,JK) * PRHODREF(D%NIB:D%NIE,JK))
+ !$mnh_end_expand_array(JI=D%NIB:D%NIE)
ENDDO
-ZOMEGA_UP_M(:)=MAX(ZOMEGA_UP_M(:), 1.E-20)
-ZOMEGA_UP_M(:)=(XG*ZOMEGA_UP_M(:))**(1./3.)
+!$mnh_expand_array(JI=D%NIB:D%NIE)
+ZOMEGA_UP_M(D%NIB:D%NIE)=MAX(ZOMEGA_UP_M(D%NIB:D%NIE), 1.E-20)
+ZOMEGA_UP_M(D%NIB:D%NIE)=(CST%XG*ZOMEGA_UP_M(D%NIB:D%NIE))**(1./3.)
+!$mnh_end_expand_array(JI=D%NIB:D%NIE)
!computation of alpha up
-DO JK=KKA,KKU,KKL
- ZALPHA_UP_M(:,JK)=ZEMF_M(:,JK)/(XALPHA_MF*PRHODREF(:,JK)*ZOMEGA_UP_M(:))
+DO JK=D%NKA,D%NKU,D%NKL
+ !$mnh_expand_array(JI=D%NIB:D%NIE)
+ ZALPHA_UP_M(D%NIB:D%NIE,JK)=ZEMF_M(D%NIB:D%NIE,JK)/(PARAMMF%XALPHA_MF*PRHODREF(D%NIB:D%NIE,JK)*ZOMEGA_UP_M(D%NIB:D%NIE))
+ ZALPHA_UP_M(D%NIB:D%NIE,JK)=MAX(0., MIN(ZALPHA_UP_M(D%NIB:D%NIE,JK), 1.))
+ !$mnh_end_expand_array(JI=D%NIB:D%NIE)
ENDDO
-ZALPHA_UP_M(:,:)=MAX(0., MIN(ZALPHA_UP_M(:,:), 1.))
!computation of sigma of the distribution
-DO JK=KKA,KKU,KKL
- ZSIGMF(:,JK)=ZEMF_M(:,JK) * &
- (ZRT_UP_M(:,JK) - PRTM(:,JK)) * &
- PDEPTH(:) * ZGRAD_Z_RT(:,JK) / &
- (XSIGMA_MF * ZOMEGA_UP_M(:) * PRHODREF(:,JK))
+DO JK=D%NKA,D%NKU,D%NKL
+ !$mnh_expand_array(JI=D%NIB:D%NIE)
+ ZSIGMF(D%NIB:D%NIE,JK)=ZEMF_M(D%NIB:D%NIE,JK) * &
+ (ZRT_UP_M(D%NIB:D%NIE,JK) - PRTM(D%NIB:D%NIE,JK)) * &
+ PDEPTH(D%NIB:D%NIE) * ZGRAD_Z_RT(D%NIB:D%NIE,JK) / &
+ (PARAMMF%XSIGMA_MF * ZOMEGA_UP_M(D%NIB:D%NIE) * PRHODREF(D%NIB:D%NIE,JK))
+ !$mnh_end_expand_array(JI=D%NIB:D%NIE)
ENDDO
-ZSIGMF(:,:)=SQRT(MAX(ABS(ZSIGMF(:,:)), 1.E-40))
+!$mnh_expand_array(JI=D%NIB:D%NIE,JK=D%NKTB:D%NKTE)
+ZSIGMF(D%NIB:D%NIE,:)=SQRT(MAX(ABS(ZSIGMF(D%NIB:D%NIE,:)), 1.E-40))
+!$mnh_end_expand_array(JI=D%NIB:D%NIE,JK=D%NKTB:D%NKTE)
!
!* 2. PDF integration
! ------------------------------------------------
!
+!$mnh_expand_array(JI=D%NIB:D%NIE,JK=D%NKTB:D%NKTE)
!The mean of the distribution is ZRT_UP
!Computation of ZA and ZGAM (=efrc(ZA)) coefficient
-ZA(:,:)=(ZRSAT_UP_M(:,:)-ZRT_UP_M(:,:))/(sqrt(2.)*ZSIGMF(:,:))
+ZA(D%NIB:D%NIE,:)=(ZRSAT_UP_M(D%NIB:D%NIE,:)-ZRT_UP_M(D%NIB:D%NIE,:))/(sqrt(2.)*ZSIGMF(D%NIB:D%NIE,:))
!Approximation of erf function
-ZGAM(:,:)=1-SIGN(1., ZA(:,:))*SQRT(1-EXP(-4*ZA(:,:)**2/XPI))
+ZGAM(D%NIB:D%NIE,:)=1-SIGN(1., ZA(D%NIB:D%NIE,:))*SQRT(1-EXP(-4*ZA(D%NIB:D%NIE,:)**2/CST%XPI))
!computation of cloud fraction
-PCF_MF(:,:)=MAX( 0., MIN(1.,0.5*ZGAM(:,:) * ZALPHA_UP_M(:,:)))
+PCF_MF(D%NIB:D%NIE,:)=MAX( 0., MIN(1.,0.5*ZGAM(D%NIB:D%NIE,:) * ZALPHA_UP_M(D%NIB:D%NIE,:)))
!computation of condensate, then PRC and PRI
-ZCOND(:,:)=(EXP(-ZA(:,:)**2)-ZA(:,:)*SQRT(XPI)*ZGAM(:,:))*ZSIGMF(:,:)/SQRT(2.*XPI) * ZALPHA_UP_M(:,:)
-ZCOND(:,:)=MAX(ZCOND(:,:), 0.) !due to approximation of ZGAM value, ZCOND could be slightly negative
-PRC_MF(:,:)=(1.-ZFRAC_ICE_UP_M(:,:)) * ZCOND(:,:)
-PRI_MF(:,:)=( ZFRAC_ICE_UP_M(:,:)) * ZCOND(:,:)
-
+ZCOND(D%NIB:D%NIE,:)=(EXP(-ZA(D%NIB:D%NIE,:)**2)-ZA(D%NIB:D%NIE,:)*SQRT(CST%XPI)*ZGAM(D%NIB:D%NIE,:))* &
+ &ZSIGMF(D%NIB:D%NIE,:)/SQRT(2.*CST%XPI) * ZALPHA_UP_M(D%NIB:D%NIE,:)
+ZCOND(D%NIB:D%NIE,:)=MAX(ZCOND(D%NIB:D%NIE,:), 0.) !due to approximation of ZGAM value, ZCOND could be slightly negative
+PRC_MF(D%NIB:D%NIE,:)=(1.-ZFRAC_ICE_UP_M(D%NIB:D%NIE,:)) * ZCOND(D%NIB:D%NIE,:)
+PRI_MF(D%NIB:D%NIE,:)=( ZFRAC_ICE_UP_M(D%NIB:D%NIE,:)) * ZCOND(D%NIB:D%NIE,:)
+!$mnh_end_expand_array(JI=D%NIB:D%NIE,JK=D%NKTB:D%NKTE)
+!
IF (LHOOK) CALL DR_HOOK('COMPUTE_MF_CLOUD_BIGAUS',1,ZHOOK_HANDLE)
END SUBROUTINE COMPUTE_MF_CLOUD_BIGAUS
diff --git a/src/common/turb/mode_compute_mf_cloud_direct.F90 b/src/common/turb/mode_compute_mf_cloud_direct.F90
index 8db27676d2e1d61c5d6dfd5b859699106e6756c2..ba6f5dde3957ff7dcdde8d794747fd231b36dac5 100644
--- a/src/common/turb/mode_compute_mf_cloud_direct.F90
+++ b/src/common/turb/mode_compute_mf_cloud_direct.F90
@@ -8,7 +8,7 @@
!
IMPLICIT NONE
CONTAINS
- SUBROUTINE COMPUTE_MF_CLOUD_DIRECT(KKB, KKE, KKL, &
+ SUBROUTINE COMPUTE_MF_CLOUD_DIRECT(D, PARAMMF, &
&KKLCL, PFRAC_UP, PRC_UP, PRI_UP,&
&PRC_MF, PRI_MF, PCF_MF)
! #################################################################
@@ -53,7 +53,8 @@ CONTAINS
!
!* 0. DECLARATIONS
! ------------
-USE MODD_PARAM_MFSHALL_n, ONLY : XKCF_MF
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+USE MODD_PARAM_MFSHALL_n, ONLY : PARAM_MFSHALL_t
USE PARKIND1, ONLY : JPRB
USE YOMHOOK , ONLY : LHOOK, DR_HOOK
!
@@ -61,14 +62,13 @@ IMPLICIT NONE
!
!* 0.1 Declaration of Arguments
!
-INTEGER, INTENT(IN) :: KKB ! near ground physical index
-INTEGER, INTENT(IN) :: KKE ! uppest atmosphere physical index
-INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
-INTEGER, DIMENSION(:), INTENT(IN) :: KKLCL ! index of updraft condensation level
-REAL, DIMENSION(:,:), INTENT(IN) :: PFRAC_UP ! Updraft Fraction
-REAL, DIMENSION(:,:), INTENT(IN) :: PRC_UP,PRI_UP ! updraft characteritics
-REAL, DIMENSION(:,:), INTENT(OUT) :: PRC_MF, PRI_MF ! cloud content
-REAL, DIMENSION(:,:), INTENT(OUT) :: PCF_MF ! and cloud fraction for MF scheme
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+TYPE(PARAM_MFSHALL_t), INTENT(IN) :: PARAMMF
+INTEGER, DIMENSION(D%NIT), INTENT(IN) :: KKLCL ! index of updraft condensation level
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(IN) :: PFRAC_UP ! Updraft Fraction
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(IN) :: PRC_UP,PRI_UP ! updraft characteritics
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(OUT) :: PRC_MF, PRI_MF ! cloud content
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(OUT) :: PCF_MF ! and cloud fraction for MF scheme
!
!* 0.1 Declaration of local variables
!
@@ -89,21 +89,21 @@ PRC_MF(:,:)=0.
PRI_MF(:,:)=0.
PCF_MF(:,:)=0.
-DO JI=1,SIZE(PCF_MF,1)
+DO JI=D%NIB,D%NIE
#ifdef REPRO48
- JK0=KKLCL(JI)-KKL ! first mass level with cloud
- JK0=MAX(JK0, MIN(KKB,KKE)) !protection if KKL=1
- JK0=MIN(JK0, MAX(KKB,KKE)) !protection if KKL=-1
- DO JK=JK0,KKE-KKL,KKL
+ JK0=KKLCL(JI)-D%NKL ! first mass level with cloud
+ JK0=MAX(JK0, MIN(D%NKB,D%NKE)) !protection if KKL=1
+ JK0=MIN(JK0, MAX(D%NKB,D%NKE)) !protection if KKL=-1
+ DO JK=JK0,D%NKE-D%NKL,D%NKL
#else
- DO JK=KKLCL(JI),KKE-KKL,KKL
+ DO JK=KKLCL(JI),D%NKE-D%NKL,D%NKL
#endif
- PCF_MF(JI,JK ) = MAX( 0., MIN(1.,XKCF_MF *0.5* ( &
- & PFRAC_UP(JI,JK) + PFRAC_UP(JI,JK+KKL) ) ))
- PRC_MF(JI,JK) = 0.5* XKCF_MF * ( PFRAC_UP(JI,JK)*PRC_UP(JI,JK) &
- + PFRAC_UP(JI,JK+KKL)*PRC_UP(JI,JK+KKL) )
- PRI_MF(JI,JK) = 0.5* XKCF_MF * ( PFRAC_UP(JI,JK)*PRI_UP(JI,JK) &
- + PFRAC_UP(JI,JK+KKL)*PRI_UP(JI,JK+KKL) )
+ PCF_MF(JI,JK ) = MAX( 0., MIN(1.,PARAMMF%XKCF_MF *0.5* ( &
+ & PFRAC_UP(JI,JK) + PFRAC_UP(JI,JK+D%NKL) ) ))
+ PRC_MF(JI,JK) = 0.5* PARAMMF%XKCF_MF * ( PFRAC_UP(JI,JK)*PRC_UP(JI,JK) &
+ + PFRAC_UP(JI,JK+D%NKL)*PRC_UP(JI,JK+D%NKL) )
+ PRI_MF(JI,JK) = 0.5* PARAMMF%XKCF_MF * ( PFRAC_UP(JI,JK)*PRI_UP(JI,JK) &
+ + PFRAC_UP(JI,JK+D%NKL)*PRI_UP(JI,JK+D%NKL) )
END DO
END DO
diff --git a/src/common/turb/mode_compute_mf_cloud_stat.F90 b/src/common/turb/mode_compute_mf_cloud_stat.F90
index 12fcce462fef6b0eb2c4b73fec8b6058a78ada08..28032ab6218ed7a02c471b81b9c68bf7034e9698 100644
--- a/src/common/turb/mode_compute_mf_cloud_stat.F90
+++ b/src/common/turb/mode_compute_mf_cloud_stat.F90
@@ -9,7 +9,7 @@
IMPLICIT NONE
CONTAINS
! ######spl
- SUBROUTINE COMPUTE_MF_CLOUD_STAT(KKA, KKB, KKE, KKU, KKL, KRR, KRRL, KRRI,&
+ SUBROUTINE COMPUTE_MF_CLOUD_STAT(D, CST, PARAMMF, KRR, KRRL, KRRI,&
&PFRAC_ICE,&
&PTHLM, PRTM, PPABSM, PRM,&
&PDZZ, PTHM, PEXNM, &
@@ -52,8 +52,9 @@ CONTAINS
!
!* 0. DECLARATIONS
! ------------
-USE MODD_PARAM_MFSHALL_n, ONLY : XTAUSIGMF
-USE MODD_PARAMETERS, ONLY : JPHEXT, JPVEXT
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+USE MODD_CST, ONLY: CST_t
+USE MODD_PARAM_MFSHALL_n, ONLY: PARAM_MFSHALL_t
!
USE MODI_SHUMAN_MF, ONLY: MZF_MF, MZM_MF, GZ_M_W_MF
USE MODE_COMPUTE_FUNCTION_THERMO_MF, ONLY: COMPUTE_FUNCTION_THERMO_MF
@@ -65,31 +66,31 @@ IMPLICIT NONE
!
!* 0.1 Declaration of Arguments
!
-INTEGER, INTENT(IN) :: KKA ! near ground array index
-INTEGER, INTENT(IN) :: KKB ! near ground physical index
-INTEGER, INTENT(IN) :: KKE ! uppest atmosphere physical index
-INTEGER, INTENT(IN) :: KKU ! uppest atmosphere array index
-INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+TYPE(CST_t), INTENT(IN) :: CST
+TYPE(PARAM_MFSHALL_t), INTENT(IN) :: PARAMMF
INTEGER, INTENT(IN) :: KRR ! number of moist var.
INTEGER, INTENT(IN) :: KRRL ! number of liquid water var.
INTEGER, INTENT(IN) :: KRRI ! number of ice water var.
-REAL, DIMENSION(:,:), INTENT(IN) :: PFRAC_ICE ! liquid/ice fraction
-REAL, DIMENSION(:,:), INTENT(IN) :: PTHLM, PRTM ! cons. var. at t-dt
-REAL, DIMENSION(:,:), INTENT(IN) :: PPABSM ! Pressure at time t-1
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRM ! water var. at t-dt
-REAL, DIMENSION(:,:), INTENT(IN) :: PDZZ
-REAL, DIMENSION(:,:), INTENT(IN) :: PTHM ! environement
-REAL, DIMENSION(:,:), INTENT(IN) :: PEXNM
-REAL, DIMENSION(:,:), INTENT(IN) :: PEMF ! updraft characteritics
-REAL, DIMENSION(:,:), INTENT(IN) :: PTHL_UP, PRT_UP ! rc,w,Mass Flux,Thetal,rt
-REAL, DIMENSION(:,:), INTENT(OUT) :: PSIGMF ! SQRT(variance) for statistical cloud scheme
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(IN) :: PFRAC_ICE ! liquid/ice fraction
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(IN) :: PTHLM, PRTM ! cons. var. at t-dt
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(IN) :: PPABSM ! Pressure at time t-1
+REAL, DIMENSION(D%NIT,D%NKT,KRR), INTENT(IN) :: PRM ! water var. at t-dt
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(IN) :: PDZZ
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(IN) :: PTHM ! environement
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(IN) :: PEXNM
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(IN) :: PEMF ! updraft characteritics
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(IN) :: PTHL_UP, PRT_UP ! rc,w,Mass Flux,Thetal,rt
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(OUT) :: PSIGMF ! SQRT(variance) for statistical cloud scheme
!
!* 0.1 Declaration of local variables
!
!
-REAL, DIMENSION(SIZE(PTHLM,1),SIZE(PTHLM,2)) :: ZFLXZ
-REAL, DIMENSION(SIZE(PTHLM,1),SIZE(PTHLM,2)) :: ZT
-REAL, DIMENSION(SIZE(PTHLM,1),SIZE(PTHLM,2)) :: ZAMOIST, ZATHETA
+REAL, DIMENSION(D%NIT,D%NKT) :: ZFLXZ
+REAL, DIMENSION(D%NIT,D%NKT) :: ZT
+REAL, DIMENSION(D%NIT,D%NKT) :: ZAMOIST, ZATHETA
+REAL, DIMENSION(D%NIT,D%NKT) :: ZWK
+INTEGER :: JI, JK
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!* 0.2 initialisation
@@ -103,7 +104,7 @@ IF (LHOOK) CALL DR_HOOK('COMPUTE_MF_CLOUD_STAT',0,ZHOOK_HANDLE)
! ------------------------------------------------
!
! Thermodynamics functions
-CALL COMPUTE_FUNCTION_THERMO_MF( KRR,KRRL,KRRI, &
+CALL COMPUTE_FUNCTION_THERMO_MF( D, CST, KRR,KRRL,KRRI, &
PTHM,PRM,PEXNM,PFRAC_ICE,PPABSM, &
ZT,ZAMOIST,ZATHETA )
!
@@ -113,14 +114,20 @@ IF (KRRL > 0) THEN
!
!
- ZFLXZ(:,:) = -2 * XTAUSIGMF * PEMF(:,:)*(PTHL_UP(:,:)-MZM_MF(PTHLM(:,:), KKA, KKU, KKL)) * &
- GZ_M_W_MF(PTHLM(:,:),PDZZ(:,:), KKA, KKU, KKL)
-!
-! Avoid negative values
- ZFLXZ(:,:) = MAX(0.,ZFLXZ(:,:))
-
+ CALL MZM_MF(D, PTHLM(:,:), ZFLXZ(:,:))
+ CALL GZ_M_W_MF(D, PTHLM(:,:), PDZZ(:,:), ZWK(:,:))
+ !$mnh_expand_array(JI=D%NIB:D%NIE,JK=D%NKTB:D%NKTE)
+ ZFLXZ(D%NIB:D%NIE,:) = -2 * PARAMMF%XTAUSIGMF * PEMF(D%NIB:D%NIE,:)* &
+ & (PTHL_UP(D%NIB:D%NIE,:)-ZFLXZ(D%NIB:D%NIE,:)) * ZWK(D%NIB:D%NIE,:)
+ !
+ ! Avoid negative values
+ ZFLXZ(D%NIB:D%NIE,:) = MAX(0.,ZFLXZ(D%NIB:D%NIE,:))
+ !$mnh_end_expand_array(JI=D%NIB:D%NIE,JK=D%NKTB:D%NKTE)
- PSIGMF(:,:) = MZF_MF(ZFLXZ(:,:), KKA, KKU, KKL) * ZATHETA(:,:)**2
+ CALL MZF_MF(D, ZFLXZ(:,:), PSIGMF(:,:))
+ !$mnh_expand_array(JI=D%NIB:D%NIE,JK=D%NKTB:D%NKTE)
+ PSIGMF(D%NIB:D%NIE,:) = PSIGMF(D%NIB:D%NIE,:) * ZATHETA(D%NIB:D%NIE,:)**2
+ !$mnh_end_expand_array(JI=D%NIB:D%NIE,JK=D%NKTB:D%NKTE)
!
!
@@ -129,18 +136,26 @@ IF (KRRL > 0) THEN
!
!
!
- ZFLXZ(:,:) = -2 * XTAUSIGMF * PEMF(:,:)*(PRT_UP(:,:)-MZM_MF(PRTM(:,:), KKA, KKU, KKL)) * &
- GZ_M_W_MF(PRTM(:,:),PDZZ(:,:), KKA, KKU, KKL)
-!
-! Avoid negative values
- ZFLXZ(:,:) = MAX(0.,ZFLXZ(:,:))
-!
+ CALL MZM_MF(D, PRTM(:,:), ZFLXZ(:,:))
+ CALL GZ_M_W_MF(D, PRTM(:,:), PDZZ(:,:), ZWK(:,:))
+ !$mnh_expand_array(JI=D%NIB:D%NIE,JK=D%NKTB:D%NKTE)
+ ZFLXZ(D%NIB:D%NIE,:) = -2 * PARAMMF%XTAUSIGMF * PEMF(D%NIB:D%NIE,:)* &
+ & (PRT_UP(D%NIB:D%NIE,:)-ZFLXZ(D%NIB:D%NIE,:)) * ZWK(D%NIB:D%NIE,:)
+ !
+ ! Avoid negative values
+ ZFLXZ(D%NIB:D%NIE,:) = MAX(0.,ZFLXZ(D%NIB:D%NIE,:))
+ !$mnh_end_expand_array(JI=D%NIB:D%NIE,JK=D%NKTB:D%NKTE)
- PSIGMF(:,:) = PSIGMF(:,:) + ZAMOIST(:,:) **2 * MZF_MF(ZFLXZ(:,:), KKA, KKU, KKL)
+ CALL MZF_MF(D, ZFLXZ(:,:), ZWK(:,:))
+ !$mnh_expand_array(JI=D%NIB:D%NIE,JK=D%NKTB:D%NKTE)
+ PSIGMF(D%NIB:D%NIE,:) = PSIGMF(D%NIB:D%NIE,:) + ZAMOIST(D%NIB:D%NIE,:) **2 * ZWK(D%NIB:D%NIE,:)
+ !$mnh_end_expand_array(JI=D%NIB:D%NIE,JK=D%NKTB:D%NKTE)
!
! 1.3 Vertical part of Sigma_s
!
- PSIGMF(:,:) = SQRT( MAX (PSIGMF(:,:) , 0.) )
+ !$mnh_expand_array(JI=D%NIB:D%NIE,JK=D%NKTB:D%NKTE)
+ PSIGMF(D%NIB:D%NIE,:) = SQRT( MAX (PSIGMF(D%NIB:D%NIE,:) , 0.) )
+ !$mnh_end_expand_array(JI=D%NIB:D%NIE,JK=D%NKTB:D%NKTE)
ELSE
PSIGMF(:,:) = 0.
END IF
diff --git a/src/common/turb/mode_compute_updraft.F90 b/src/common/turb/mode_compute_updraft.F90
index f3b480826cbba990948d580dd7f9d1ccbda64702..6e3a533dc072a25b2bf35e0e91a744e24d64e745 100644
--- a/src/common/turb/mode_compute_updraft.F90
+++ b/src/common/turb/mode_compute_updraft.F90
@@ -9,7 +9,8 @@
!
IMPLICIT NONE
CONTAINS
- SUBROUTINE COMPUTE_UPDRAFT(KKA,KKB,KKE,KKU,KKL,HFRAC_ICE, &
+ SUBROUTINE COMPUTE_UPDRAFT(D, CST, NEB, PARAMMF, TURB, CSTURB, &
+ KSV, HFRAC_ICE, &
OENTR_DETR,OMIXUV, &
ONOMIXLG,KSV_LGBEG,KSV_LGEND, &
PZZ,PDZZ, &
@@ -60,18 +61,19 @@ CONTAINS
!! R.Honnert Oct 2016 : Add ZSURF and Update with AROME
!! Q.Rodier 01/2019 : support RM17 mixing length
!! R.Honnert 01/2019 : add LGZ (reduction of the mass-flux surface closure with the resolution)
+!! S. Riette 06/2022: compute_entr_detr is inlined
!! --------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_CST, ONLY: XG, XRV, XRD
-USE MODD_PARAM_MFSHALL_n, ONLY: LGZ, XALP_PERT, XCMF, XPRES_UV, XFRAC_UP_MAX, &
- XABUO, XBENTR, XENTR_DRY, XBDETR, XGZ
-USE MODD_TURB_n, ONLY : CTURBLEN
-
-USE MODE_COMPUTE_ENTR_DETR, ONLY: COMPUTE_ENTR_DETR
-USE MODE_TH_R_FROM_THL_RT_1D, ONLY: TH_R_FROM_THL_RT_1D
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+USE MODD_CST, ONLY: CST_t
+USE MODD_NEB, ONLY: NEB_t
+USE MODD_PARAM_MFSHALL_n, ONLY: PARAM_MFSHALL_t
+USE MODD_TURB_n, ONLY: TURB_t
+USE MODD_CTURB, ONLY: CSTURB_t
+!
USE MODI_SHUMAN_MF, ONLY: MZM_MF, MZF_MF, GZ_M_W_MF
USE MODE_COMPUTE_BL89_ML, ONLY: COMPUTE_BL89_ML
@@ -84,60 +86,62 @@ IMPLICIT NONE
!
!
!
-INTEGER, INTENT(IN) :: KKA ! near ground array index
-INTEGER, INTENT(IN) :: KKB ! near ground physical index
-INTEGER, INTENT(IN) :: KKE ! uppest atmosphere physical index
-INTEGER, INTENT(IN) :: KKU ! uppest atmosphere array index
-INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+TYPE(CST_t), INTENT(IN) :: CST
+TYPE(NEB_t), INTENT(IN) :: NEB
+TYPE(PARAM_MFSHALL_t), INTENT(IN) :: PARAMMF
+TYPE(TURB_t), INTENT(IN) :: TURB
+TYPE(CSTURB_t), INTENT(IN) :: CSTURB
+INTEGER, INTENT(IN) :: KSV
CHARACTER(LEN=1), INTENT(IN) :: HFRAC_ICE ! partition liquid/ice scheme
LOGICAL, INTENT(IN) :: OENTR_DETR! flag to recompute entrainment, detrainment and mass flux
LOGICAL, INTENT(IN) :: OMIXUV ! True if mixing of momentum
LOGICAL, INTENT(IN) :: ONOMIXLG ! False if mixing of lagrangian tracer
INTEGER, INTENT(IN) :: KSV_LGBEG ! first index of lag. tracer
INTEGER, INTENT(IN) :: KSV_LGEND ! last index of lag. tracer
-REAL, DIMENSION(:,:), INTENT(IN) :: PZZ ! Height at the flux point
-REAL, DIMENSION(:,:), INTENT(IN) :: PDZZ ! Metrics coefficient
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(IN) :: PZZ ! Height at the flux point
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(IN) :: PDZZ ! Metrics coefficient
-REAL, DIMENSION(:), INTENT(IN) :: PSFTH,PSFRV
+REAL, DIMENSION(D%NIT), INTENT(IN) :: PSFTH,PSFRV
! normal surface fluxes of theta,rv,(u,v) parallel to the orography
!
-REAL, DIMENSION(:,:), INTENT(IN) :: PPABSM ! Pressure at t-dt
-REAL, DIMENSION(:,:), INTENT(IN) :: PRHODREF ! dry density of the
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(IN) :: PPABSM ! Pressure at t-dt
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(IN) :: PRHODREF ! dry density of the
! reference state
-REAL, DIMENSION(:,:), INTENT(IN) :: PUM ! u mean wind
-REAL, DIMENSION(:,:), INTENT(IN) :: PVM ! v mean wind
-REAL, DIMENSION(:,:), INTENT(IN) :: PTKEM ! TKE at t-dt
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(IN) :: PUM ! u mean wind
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(IN) :: PVM ! v mean wind
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(IN) :: PTKEM ! TKE at t-dt
!
-REAL, DIMENSION(:,:), INTENT(IN) :: PTHM ! liquid pot. temp. at t-dt
-REAL, DIMENSION(:,:), INTENT(IN) :: PRVM ! vapor mixing ratio at t-dt
-REAL, DIMENSION(:,:), INTENT(IN) :: PTHLM,PRTM ! cons. var. at t-dt
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(IN) :: PTHM ! liquid pot. temp. at t-dt
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(IN) :: PRVM ! vapor mixing ratio at t-dt
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(IN) :: PTHLM,PRTM ! cons. var. at t-dt
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSVM ! scalar var. at t-dt
+REAL, DIMENSION(D%NIT,D%NKT,KSV), INTENT(IN) :: PSVM ! scalar var. at t-dt
-REAL, DIMENSION(:,:), INTENT(OUT) :: PTHL_UP,PRT_UP ! updraft properties
-REAL, DIMENSION(:,:), INTENT(OUT) :: PU_UP, PV_UP ! updraft wind components
-REAL, DIMENSION(:,:), INTENT(INOUT):: PRV_UP,PRC_UP, & ! updraft rv, rc
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(OUT) :: PTHL_UP,PRT_UP ! updraft properties
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(OUT) :: PU_UP, PV_UP ! updraft wind components
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(INOUT):: PRV_UP,PRC_UP, & ! updraft rv, rc
PRI_UP,PTHV_UP,& ! updraft ri, THv
PW_UP,PFRAC_UP,& ! updraft w, fraction
PFRAC_ICE_UP,& ! liquid/solid fraction in updraft
PRSAT_UP ! Rsat
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSV_UP ! updraft scalar var.
+REAL, DIMENSION(D%NIT,D%NKT,KSV), INTENT(OUT) :: PSV_UP ! updraft scalar var.
-REAL, DIMENSION(:,:), INTENT(INOUT):: PEMF,PDETR,PENTR ! Mass_flux,
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(INOUT):: PEMF,PDETR,PENTR ! Mass_flux,
! detrainment,entrainment
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PBUO_INTEG ! Integrated Buoyancy
-INTEGER, DIMENSION(:), INTENT(INOUT) :: KKLCL,KKETL,KKCTL! LCL, ETL, CTL
-REAL, DIMENSION(:), INTENT(OUT) :: PDEPTH ! Deepness of cloud
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(INOUT) :: PBUO_INTEG ! Integrated Buoyancy
+INTEGER, DIMENSION(D%NIT), INTENT(INOUT) :: KKLCL,KKETL,KKCTL! LCL, ETL, CTL
+REAL, DIMENSION(D%NIT), INTENT(OUT) :: PDEPTH ! Deepness of cloud
REAL, INTENT(IN) :: PDX, PDY
! 1.2 Declaration of local variables
!
!
! Mean environment variables at t-dt at flux point
-REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: &
+REAL, DIMENSION(D%NIT,D%NKT) :: &
ZTHM_F,ZRVM_F ! Theta,rv of
! updraft environnement
-REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: &
+REAL, DIMENSION(D%NIT,D%NKT) :: &
ZRTM_F, ZTHLM_F, ZTKEM_F,& ! rt, thetal,TKE,pressure,
ZUM_F,ZVM_F,ZRHO_F, & ! density,momentum
ZPRES_F,ZTHVM_F,ZTHVM, & ! interpolated at the flux point
@@ -146,39 +150,38 @@ REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: &
ZBUO_INTEG_DRY, ZBUO_INTEG_CLD,&! Integrated Buoyancy
ZENTR_CLD,ZDETR_CLD ! wet entrainment and detrainment
-REAL, DIMENSION(SIZE(PSVM,1),SIZE(PTHM,2),SIZE(PSVM,3)) :: &
+REAL, DIMENSION(D%NIT,D%NKT,KSV) :: &
ZSVM_F ! scalar variables
-REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: &
+REAL, DIMENSION(D%NIT,D%NKT) :: &
ZTH_UP, & ! updraft THETA
ZRC_MIX, ZRI_MIX ! guess of Rc and Ri for KF mixture
-REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZCOEF ! diminution coefficient for too high clouds
+REAL, DIMENSION(D%NIT,D%NKT) :: ZCOEF ! diminution coefficient for too high clouds
-REAL, DIMENSION(SIZE(PSFTH,1) ) :: ZWTHVSURF ! Surface w'thetav'
+REAL, DIMENSION(D%NIT) :: ZWTHVSURF ! Surface w'thetav'
REAL :: ZRDORV ! RD/RV
REAL :: ZRVORD ! RV/RD
-REAL, DIMENSION(SIZE(PTHM,1)) :: ZMIX1,ZMIX2,ZMIX3_CLD,ZMIX2_CLD
+REAL, DIMENSION(D%NIT) :: ZMIX1,ZMIX2,ZMIX3_CLD,ZMIX2_CLD
-REAL, DIMENSION(SIZE(PTHM,1)) :: ZLUP ! Upward Mixing length from the ground
+REAL, DIMENSION(D%NIT) :: ZLUP ! Upward Mixing length from the ground
-INTEGER :: ISV ! Number of scalar variables
INTEGER :: JK,JI,JSV ! loop counters
-LOGICAL, DIMENSION(SIZE(PTHM,1)) :: GTEST,GTESTLCL,GTESTETL
+LOGICAL, DIMENSION(D%NIT) :: GTEST,GTESTLCL,GTESTETL
! Test if the ascent continue, if LCL or ETL is reached
LOGICAL :: GLMIX
! To choose upward or downward mixing length
-LOGICAL, DIMENSION(SIZE(PTHM,1)) :: GWORK1
-LOGICAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: GWORK2
+LOGICAL, DIMENSION(D%NIT) :: GWORK1
+LOGICAL, DIMENSION(D%NIT,D%NKT) :: GWORK2
-INTEGER :: ITEST, JLOOP
+INTEGER :: ITEST
-REAL, DIMENSION(SIZE(PTHM,1)) :: ZRC_UP, ZRI_UP, ZRV_UP,&
+REAL, DIMENSION(D%NIT) :: ZRC_UP, ZRI_UP, ZRV_UP,&
ZRSATW, ZRSATI,&
ZPART_DRY
@@ -186,9 +189,49 @@ REAL :: ZDEPTH_MAX1, ZDEPTH_MAX2 ! control auto-extinction process
REAL :: ZTMAX,ZRMAX ! control value
-REAL, DIMENSION(SIZE(PTHM,1)) :: ZSURF
-REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZSHEAR,ZDUDZ,ZDVDZ ! vertical wind shear
+REAL, DIMENSION(D%NIT) :: ZSURF
+REAL, DIMENSION(D%NIT,D%NKT) :: ZSHEAR,ZDUDZ,ZDVDZ ! vertical wind shear
+!
+REAL, DIMENSION(D%NIT,D%NKT) :: ZWK
+REAL, DIMENSION(D%NIT,16) :: ZBUF
+!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!
+! 1.3 Declaration of additional local variables for compute_entr_detr
+!
+! Variables for cloudy part
+REAL, DIMENSION(D%NIT) :: ZKIC, ZKIC_F2 ! fraction of env. mass in the muxtures
+REAL, DIMENSION(D%NIT) :: ZEPSI,ZDELTA ! factor entrainment detrainment
+REAL :: ZEPSI_CLOUD ! factor entrainment detrainment
+REAL :: ZCOEFFMF_CLOUD ! factor for compputing entr. detr.
+REAL, DIMENSION(D%NIT) :: ZMIXTHL,ZMIXRT ! Thetal and rt in the mixtures
+REAL, DIMENSION(D%NIT) :: ZTHMIX ! Theta and Thetav of mixtures
+REAL, DIMENSION(D%NIT) :: ZRVMIX,ZRCMIX,ZRIMIX ! mixing ratios in mixtures
+REAL, DIMENSION(D%NIT) :: ZTHVMIX, ZTHVMIX_F2 ! Theta and Thetav of mixtures
+REAL, DIMENSION(D%NIT) :: ZTHV_UP_F2 ! thv_up at flux point kk+kkl
+REAL, DIMENSION(D%NIT) :: ZRSATW_ED, ZRSATI_ED ! working arrays (mixing ratio at saturation)
+REAL, DIMENSION(D%NIT) :: ZTHV ! theta V of environment at the bottom of cloudy part
+REAL :: ZKIC_INIT !Initial value of ZKIC
+REAL :: ZCOTHVU ! Variation of Thvup between bottom and top of cloudy part
+
+! Variables for dry part
+REAL :: ZFOESW, ZFOESI ! saturating vapor pressure
+REAL :: ZDRSATODP ! d.Rsat/dP
+REAL :: ZT ! Temperature
+REAL :: ZWK0D ! Work array
+
+! Variables for dry and cloudy parts
+REAL, DIMENSION(D%NIT) :: ZCOEFF_MINUS_HALF,& ! Variation of Thv between mass points kk-kkl and kk
+ ZCOEFF_PLUS_HALF ! Variation of Thv between mass points kk and kk+kkl
+REAL, DIMENSION(D%NIT) :: ZPRE ! pressure at the bottom of the cloudy part
+REAL, DIMENSION(D%NIT) :: ZG_O_THVREF_ED
+REAL, DIMENSION(D%NIT) :: ZFRAC_ICE ! fraction of ice
+REAL, DIMENSION(D%NIT) :: ZDZ_STOP,& ! Exact Height of the LCL above flux level KK
+ ZTHV_MINUS_HALF,& ! Thv at flux point(kk)
+ ZTHV_PLUS_HALF ! Thv at flux point(kk+kkl)
+REAL :: ZDZ ! Delta Z used in computations
+INTEGER :: JKLIM
+
!
IF (LHOOK) CALL DR_HOOK('COMPUTE_UPDRAFT',0,ZHOOK_HANDLE)
@@ -201,21 +244,19 @@ ZRMAX=1.E-3
! INITIALISATION
! Initialisation of the constants
-ZRDORV = XRD / XRV !=0.622
-ZRVORD = (XRV / XRD)
+ZRDORV = CST%XRD / CST%XRV !=0.622
+ZRVORD = (CST%XRV / CST%XRD)
ZDEPTH_MAX1=3000. ! clouds with depth inferior to this value are keeped untouched
ZDEPTH_MAX2=4000. ! clouds with depth superior to this value are suppressed
! Local variables, internal domain
-!number of scalar variables
-ISV=SIZE(PSVM,3)
IF (OENTR_DETR) THEN
! Initialisation of intersesting Level :LCL,ETL,CTL
- KKLCL(:)=KKE
- KKETL(:)=KKE
- KKCTL(:)=KKE
+ KKLCL(:)=D%NKE
+ KKETL(:)=D%NKE
+ KKCTL(:)=D%NKE
!
! Initialisation
@@ -237,7 +278,9 @@ IF (OENTR_DETR) THEN
PBUO_INTEG=0.
PFRAC_ICE_UP(:,:)=0.
- PRSAT_UP(:,:)=PRVM(:,:) ! should be initialised correctly but is (normaly) not used
+ !$mnh_expand_array(JI=D%NIB:D%NIE,JK=1:D%NKT)
+ PRSAT_UP(D%NIB:D%NIE,:)=PRVM(D%NIB:D%NIE,:) ! should be initialised correctly but is (normaly) not used
+ !$mnh_end_expand_array(JI=D%NIB:D%NIE,JK=1:D%NKT)
!cloud/dry air mixture cloud content
ZRC_MIX = 0.
@@ -247,107 +290,135 @@ END IF
! Initialisation of environment variables at t-dt
! variables at flux level
-ZTHLM_F(:,:) = MZM_MF(PTHLM(:,:), KKA, KKU, KKL)
-ZRTM_F (:,:) = MZM_MF(PRTM(:,:), KKA, KKU, KKL)
-ZUM_F (:,:) = MZM_MF(PUM(:,:), KKA, KKU, KKL)
-ZVM_F (:,:) = MZM_MF(PVM(:,:), KKA, KKU, KKL)
-ZTKEM_F(:,:) = MZM_MF(PTKEM(:,:), KKA, KKU, KKL)
+CALL MZM_MF(D, PTHLM(:,:), ZTHLM_F(:,:))
+CALL MZM_MF(D, PRTM(:,:), ZRTM_F (:,:))
+CALL MZM_MF(D, PUM(:,:), ZUM_F (:,:))
+CALL MZM_MF(D, PVM(:,:), ZVM_F (:,:))
+CALL MZM_MF(D, PTKEM(:,:), ZTKEM_F(:,:))
-DO JSV=1,ISV
+DO JSV=1,KSV
IF (ONOMIXLG .AND. JSV >= KSV_LGBEG .AND. JSV<= KSV_LGEND) CYCLE
- ZSVM_F(:,:,JSV) = MZM_MF(PSVM(:,:,JSV), KKA, KKU, KKL)
+ CALL MZM_MF(D, PSVM(:,:,JSV), ZSVM_F(:,:,JSV))
END DO
!
! Initialisation of updraft characteristics
-PTHL_UP(:,:)=ZTHLM_F(:,:)
-PRT_UP(:,:)=ZRTM_F(:,:)
-PU_UP(:,:)=ZUM_F(:,:)
-PV_UP(:,:)=ZVM_F(:,:)
-PSV_UP(:,:,:)=ZSVM_F(:,:,:)
-
+!$mnh_expand_array(JI=D%NIB:D%NIE,JK=1:D%NKT)
+PTHL_UP(D%NIB:D%NIE,:)=ZTHLM_F(D%NIB:D%NIE,:)
+PRT_UP(D%NIB:D%NIE,:)=ZRTM_F(D%NIB:D%NIE,:)
+PU_UP(D%NIB:D%NIE,:)=ZUM_F(D%NIB:D%NIE,:)
+PV_UP(D%NIB:D%NIE,:)=ZVM_F(D%NIB:D%NIE,:)
+!$mnh_end_expand_array(JI=D%NIB:D%NIE,JK=1:D%NKT)
+!$mnh_expand_array(JI=D%NIB:D%NIE,JK=1:D%NKT,JSV=1:KSV)
+PSV_UP(D%NIB:D%NIE,:,:)=ZSVM_F(D%NIB:D%NIE,:,:)
+!$mnh_end_expand_array(JI=D%NIB:D%NIE,JK=1:D%NKT,JSV=1:KSV)
! Computation or initialisation of updraft characteristics at the KKB level
! thetal_up,rt_up,thetaV_up, w2,Buoyancy term and mass flux (PEMF)
-
-PTHL_UP(:,KKB)= ZTHLM_F(:,KKB)+MAX(0.,MIN(ZTMAX,(PSFTH(:)/SQRT(ZTKEM_F(:,KKB)))*XALP_PERT))
-PRT_UP(:,KKB) = ZRTM_F(:,KKB)+MAX(0.,MIN(ZRMAX,(PSFRV(:)/SQRT(ZTKEM_F(:,KKB)))*XALP_PERT))
-
+!$mnh_expand_array(JI=D%NIB:D%NIE)
+PTHL_UP(D%NIB:D%NIE,D%NKB)= ZTHLM_F(D%NIB:D%NIE,D%NKB)+MAX(0.,MIN(ZTMAX,(PSFTH(D%NIB:D%NIE)/SQRT(ZTKEM_F(D%NIB:D%NIE,D%NKB)))* &
+ &PARAMMF%XALP_PERT))
+PRT_UP(D%NIB:D%NIE,D%NKB) = ZRTM_F(D%NIB:D%NIE,D%NKB)+MAX(0.,MIN(ZRMAX,(PSFRV(D%NIB:D%NIE)/SQRT(ZTKEM_F(D%NIB:D%NIE,D%NKB)))* &
+ &PARAMMF%XALP_PERT))
+!$mnh_end_expand_array(JI=D%NIB:D%NIE)
IF (OENTR_DETR) THEN
- ZTHM_F (:,:) = MZM_MF(PTHM (:,:), KKA, KKU, KKL)
- ZPRES_F(:,:) = MZM_MF(PPABSM(:,:), KKA, KKU, KKL)
- ZRHO_F (:,:) = MZM_MF(PRHODREF(:,:), KKA, KKU, KKL)
- ZRVM_F (:,:) = MZM_MF(PRVM(:,:), KKA, KKU, KKL)
+ CALL MZM_MF(D, PTHM (:,:), ZTHM_F (:,:))
+ CALL MZM_MF(D, PPABSM(:,:), ZPRES_F(:,:))
+ CALL MZM_MF(D, PRHODREF(:,:), ZRHO_F (:,:))
+ CALL MZM_MF(D, PRVM(:,:), ZRVM_F (:,:))
+ !$mnh_expand_array(JI=D%NIB:D%NIE,JK=1:D%NKT)
! thetav at mass and flux levels
- ZTHVM_F(:,:)=ZTHM_F(:,:)*((1.+ZRVORD*ZRVM_F(:,:))/(1.+ZRTM_F(:,:)))
- ZTHVM(:,:)=PTHM(:,:)*((1.+ZRVORD*PRVM(:,:))/(1.+PRTM(:,:)))
+ ZTHVM_F(D%NIB:D%NIE,:)=ZTHM_F(D%NIB:D%NIE,:)* &
+ &((1.+ZRVORD*ZRVM_F(D%NIB:D%NIE,:))/(1.+ZRTM_F(D%NIB:D%NIE,:)))
+ ZTHVM(D%NIB:D%NIE,:)=PTHM(D%NIB:D%NIE,:)* &
+ &((1.+ZRVORD*PRVM(D%NIB:D%NIE,:))/(1.+PRTM(D%NIB:D%NIE,:)))
- PTHV_UP(:,:)=ZTHVM_F(:,:)
+ PTHV_UP(D%NIB:D%NIE,:)=ZTHVM_F(D%NIB:D%NIE,:)
+ !$mnh_end_expand_array(JI=D%NIB:D%NIE,JK=1:D%NKT)
ZW_UP2(:,:)=0.
- ZW_UP2(:,KKB) = MAX(0.0001,(2./3.)*ZTKEM_F(:,KKB))
-
+ !$mnh_expand_array(JI=D%NIB:D%NIE)
+ ZW_UP2(D%NIB:D%NIE,D%NKB) = MAX(0.0001,(2./3.)*ZTKEM_F(D%NIB:D%NIE,D%NKB))
! Computation of non conservative variable for the KKB level of the updraft
! (all or nothing ajustement)
- PRC_UP(:,KKB)=0.
- PRI_UP(:,KKB)=0.
- CALL TH_R_FROM_THL_RT_1D(HFRAC_ICE,PFRAC_ICE_UP(:,KKB),ZPRES_F(:,KKB), &
- PTHL_UP(:,KKB),PRT_UP(:,KKB),ZTH_UP(:,KKB), &
- PRV_UP(:,KKB),PRC_UP(:,KKB),PRI_UP(:,KKB),ZRSATW(:),ZRSATI(:),OOCEAN=.FALSE.)
-
+ PRC_UP(:,D%NKB)=0.
+ PRI_UP(:,D%NKB)=0.
+ !$mnh_end_expand_array(JI=D%NIB:D%NIE)
+ CALL TH_R_FROM_THL_RT(CST, NEB, D%NIT, HFRAC_ICE,PFRAC_ICE_UP(:,D%NKB),ZPRES_F(:,D%NKB), &
+ PTHL_UP(:,D%NKB),PRT_UP(:,D%NKB),ZTH_UP(:,D%NKB), &
+ PRV_UP(:,D%NKB),PRC_UP(:,D%NKB),PRI_UP(:,D%NKB),ZRSATW(:),ZRSATI(:), OOCEAN=.FALSE., &
+ PBUF=ZBUF(:,:), KB=D%NIB, KE=D%NIE)
+
+ !$mnh_expand_array(JI=D%NIB:D%NIE)
! compute updraft thevav and buoyancy term at KKB level
- PTHV_UP(:,KKB) = ZTH_UP(:,KKB)*((1+ZRVORD*PRV_UP(:,KKB))/(1+PRT_UP(:,KKB)))
+ PTHV_UP(D%NIB:D%NIE,D%NKB) = ZTH_UP(D%NIB:D%NIE,D%NKB)*((1+ZRVORD*PRV_UP(D%NIB:D%NIE,D%NKB))/(1+PRT_UP(D%NIB:D%NIE,D%NKB)))
! compute mean rsat in updraft
- PRSAT_UP(:,KKB) = ZRSATW(:)*(1-PFRAC_ICE_UP(:,KKB)) + ZRSATI(:)*PFRAC_ICE_UP(:,KKB)
-
+ PRSAT_UP(D%NIB:D%NIE,D%NKB) = ZRSATW(D%NIB:D%NIE)*(1-PFRAC_ICE_UP(D%NIB:D%NIE,D%NKB)) + &
+ & ZRSATI(D%NIB:D%NIE)*PFRAC_ICE_UP(D%NIB:D%NIE,D%NKB)
+ !$mnh_end_expand_array(JI=D%NIB:D%NIE)
! Closure assumption for mass flux at KKB level
!
- ZG_O_THVREF(:,:)=XG/ZTHVM_F(:,:)
+ !$mnh_expand_array(JI=D%NIB:D%NIE,JK=1:D%NKT)
+ ZG_O_THVREF(D%NIB:D%NIE,:)=CST%XG/ZTHVM_F(D%NIB:D%NIE,:)
+ !$mnh_end_expand_array(JI=D%NIB:D%NIE,JK=1:D%NKT)
! compute L_up
GLMIX=.TRUE.
- ZTKEM_F(:,KKB)=0.
+ !$mnh_expand_array(JI=D%NIB:D%NIE)
+ ZTKEM_F(D%NIB:D%NIE,D%NKB)=0.
+ !$mnh_end_expand_array(JI=D%NIB:D%NIE)
!
- IF(CTURBLEN=='RM17') THEN
- ZDUDZ = MZF_MF(GZ_M_W_MF(PUM,PDZZ, KKA, KKU, KKL), KKA, KKU, KKL)
- ZDVDZ = MZF_MF(GZ_M_W_MF(PVM,PDZZ, KKA, KKU, KKL), KKA, KKU, KKL)
- ZSHEAR = SQRT(ZDUDZ*ZDUDZ + ZDVDZ*ZDVDZ)
+ IF(TURB%CTURBLEN=='RM17') THEN
+ CALL GZ_M_W_MF(D, PUM, PDZZ, ZWK)
+ CALL MZF_MF(D, ZWK, ZDUDZ)
+ CALL GZ_M_W_MF(D, PVM, PDZZ, ZWK)
+ CALL MZF_MF(D, ZWK, ZDVDZ)
+ !$mnh_expand_array(JI=D%NIB:D%NIE,JK=1:D%NKT)
+ ZSHEAR(D%NIB:D%NIE,:) = SQRT(ZDUDZ(D%NIB:D%NIE,:)**2 + ZDVDZ(D%NIB:D%NIE,:)**2)
+ !$mnh_end_expand_array(JI=D%NIB:D%NIE,JK=1:D%NKT)
ELSE
ZSHEAR = 0. !no shear in bl89 mixing length
END IF
!
#ifdef REPRO48
- CALL COMPUTE_BL89_ML(KKA,KKB,KKE,KKU,KKL,PDZZ,ZTKEM_F(:,KKB),ZG_O_THVREF(:,KKB),ZTHVM,KKB,GLMIX,.TRUE.,ZSHEAR,ZLUP)
+ CALL COMPUTE_BL89_ML(D, CST, CSTURB, PDZZ,ZTKEM_F(:,D%NKB),&
+ &ZG_O_THVREF(:,D%NKB),ZTHVM,D%NKB,GLMIX,.TRUE.,ZSHEAR,ZLUP)
#else
- CALL COMPUTE_BL89_ML(KKA,KKB,KKE,KKU,KKL,PDZZ,ZTKEM_F(:,KKB),ZG_O_THVREF(:,KKB),ZTHVM,KKB,GLMIX,.FALSE.,ZSHEAR,ZLUP)
+ CALL COMPUTE_BL89_ML(D, CST, CSTURB, PDZZ,ZTKEM_F(:,D%NKB),&
+ &ZG_O_THVREF(:,D%NKB),ZTHVM,D%NKB,GLMIX,.FALSE.,ZSHEAR,ZLUP)
#endif
- ZLUP(:)=MAX(ZLUP(:),1.E-10)
+ !$mnh_expand_where(JI=D%NIB:D%NIE)
+ ZLUP(D%NIB:D%NIE)=MAX(ZLUP(D%NIB:D%NIE),1.E-10)
! Compute Buoyancy flux at the ground
- ZWTHVSURF(:) = (ZTHVM_F(:,KKB)/ZTHM_F(:,KKB))*PSFTH(:)+ &
- (0.61*ZTHM_F(:,KKB))*PSFRV(:)
+ ZWTHVSURF(D%NIB:D%NIE) = (ZTHVM_F(D%NIB:D%NIE,D%NKB)/ZTHM_F(D%NIB:D%NIE,D%NKB))*PSFTH(D%NIB:D%NIE)+ &
+ (0.61*ZTHM_F(D%NIB:D%NIE,D%NKB))*PSFRV(D%NIB:D%NIE)
! Mass flux at KKB level (updraft triggered if PSFTH>0.)
- IF (LGZ) THEN
- ZSURF(:)=TANH(XGZ*SQRT(PDX*PDY)/ZLUP)
+ IF (PARAMMF%LGZ) THEN
+ ZSURF(D%NIB:D%NIE)=TANH(PARAMMF%XGZ*SQRT(PDX*PDY)/ZLUP(D%NIB:D%NIE))
ELSE
- ZSURF(:)=1.
+ ZSURF(D%NIB:D%NIE)=1.
END IF
- WHERE (ZWTHVSURF(:)>0.)
- PEMF(:,KKB) = XCMF * ZSURF(:) * ZRHO_F(:,KKB) * &
- ((ZG_O_THVREF(:,KKB))*ZWTHVSURF*ZLUP)**(1./3.)
- PFRAC_UP(:,KKB)=MIN(PEMF(:,KKB)/(SQRT(ZW_UP2(:,KKB))*ZRHO_F(:,KKB)),XFRAC_UP_MAX)
- ZW_UP2(:,KKB)=(PEMF(:,KKB)/(PFRAC_UP(:,KKB)*ZRHO_F(:,KKB)))**2
- GTEST(:)=.TRUE.
+ WHERE (ZWTHVSURF(D%NIB:D%NIE)>0.)
+ PEMF(D%NIB:D%NIE,D%NKB) = PARAMMF%XCMF * ZSURF(D%NIB:D%NIE) * ZRHO_F(D%NIB:D%NIE,D%NKB) * &
+ ((ZG_O_THVREF(D%NIB:D%NIE,D%NKB))*ZWTHVSURF(D%NIB:D%NIE)*ZLUP(D%NIB:D%NIE))**(1./3.)
+ PFRAC_UP(D%NIB:D%NIE,D%NKB)=MIN(PEMF(D%NIB:D%NIE,D%NKB)/(SQRT(ZW_UP2(D%NIB:D%NIE,D%NKB))*ZRHO_F(D%NIB:D%NIE,D%NKB)), &
+ &PARAMMF%XFRAC_UP_MAX)
+ ZW_UP2(D%NIB:D%NIE,D%NKB)=(PEMF(D%NIB:D%NIE,D%NKB)/(PFRAC_UP(D%NIB:D%NIE,D%NKB)*ZRHO_F(D%NIB:D%NIE,D%NKB)))**2
+ GTEST(D%NIB:D%NIE)=.TRUE.
ELSEWHERE
- PEMF(:,KKB) =0.
- GTEST(:)=.FALSE.
+ PEMF(D%NIB:D%NIE,D%NKB) =0.
+ GTEST(D%NIB:D%NIE)=.FALSE.
ENDWHERE
+ !$mnh_end_expand_where(JI=D%NIB:D%NIE)
ELSE
- GTEST(:)=PEMF(:,KKB+KKL)>0.
+ !$mnh_expand_array(JI=D%NIB:D%NIE)
+ GTEST(D%NIB:D%NIE)=PEMF(D%NIB:D%NIE,D%NKB+D%NKL)>0.
+ !$mnh_end_expand_array(JI=D%NIB:D%NIE)
END IF
!--------------------------------------------------------------------------
@@ -363,31 +434,34 @@ GTESTETL(:)=.FALSE.
! Loop on vertical level
-DO JK=KKB,KKE-KKL,KKL
+DO JK=D%NKB,D%NKE-D%NKL,D%NKL
-! IF the updraft top is reached for all column, stop the loop on levels
- ITEST=COUNT(GTEST)
+ ! IF the updraft top is reached for all column, stop the loop on levels
+ ITEST=COUNT(GTEST(D%NIB:D%NIE))
IF (ITEST==0) CYCLE
-! Computation of entrainment and detrainment with KF90
-! parameterization in clouds and LR01 in subcloud layer
+ ! Computation of entrainment and detrainment with KF90
+ ! parameterization in clouds and LR01 in subcloud layer
-! to find the LCL (check if JK is LCL or not)
-
- WHERE ((PRC_UP(:,JK)+PRI_UP(:,JK)>0.).AND.(.NOT.(GTESTLCL)))
- KKLCL(:) = JK
- GTESTLCL(:)=.TRUE.
+ ! to find the LCL (check if JK is LCL or not)
+ !$mnh_expand_where(JI=D%NIB:D%NIE)
+ WHERE ((PRC_UP(D%NIB:D%NIE,JK)+PRI_UP(D%NIB:D%NIE,JK)>0.).AND.(.NOT.(GTESTLCL(D%NIB:D%NIE))))
+ KKLCL(D%NIB:D%NIE) = JK
+ GTESTLCL(D%NIB:D%NIE)=.TRUE.
ENDWHERE
+ !$mnh_end_expand_where(JI=D%NIB:D%NIE)
-! COMPUTE PENTR and PDETR at mass level JK
+ ! COMPUTE PENTR and PDETR at mass level JK
IF (OENTR_DETR) THEN
- IF(JK/=KKB) THEN
- ZRC_MIX(:,JK) = ZRC_MIX(:,JK-KKL) ! guess of Rc of mixture
- ZRI_MIX(:,JK) = ZRI_MIX(:,JK-KKL) ! guess of Ri of mixture
+ IF(JK/=D%NKB) THEN
+ !$mnh_expand_array(JI=D%NIB:D%NIE)
+ ZRC_MIX(D%NIB:D%NIE,JK) = ZRC_MIX(D%NIB:D%NIE,JK-D%NKL) ! guess of Rc of mixture
+ ZRI_MIX(D%NIB:D%NIE,JK) = ZRI_MIX(D%NIB:D%NIE,JK-D%NKL) ! guess of Ri of mixture
+ !$mnh_end_expand_array(JI=D%NIB:D%NIE)
ENDIF
- CALL COMPUTE_ENTR_DETR(JK,KKB,KKE,KKL,GTEST,GTESTLCL,HFRAC_ICE,PFRAC_ICE_UP(:,JK),&
- PRHODREF(:,JK),ZPRES_F(:,JK),ZPRES_F(:,JK+KKL),&
+ CALL COMPUTE_ENTR_DETR(D, CST, NEB, PARAMMF, JK,D%NKB,D%NKE,D%NKL,GTEST,GTESTLCL,HFRAC_ICE,PFRAC_ICE_UP(:,JK),&
+ PRHODREF(:,JK),ZPRES_F(:,JK),ZPRES_F(:,JK+D%NKL),&
PZZ(:,:),PDZZ(:,:),ZTHVM(:,:), &
PTHLM(:,:),PRTM(:,:),ZW_UP2(:,:),ZTH_UP(:,JK), &
PTHL_UP(:,JK),PRT_UP(:,JK),ZLUP(:), &
@@ -396,188 +470,635 @@ DO JK=KKB,KKE-KKL,KKL
PENTR(:,JK),PDETR(:,JK),ZENTR_CLD(:,JK),ZDETR_CLD(:,JK),&
ZBUO_INTEG_DRY(:,JK), ZBUO_INTEG_CLD(:,JK), &
ZPART_DRY(:) )
- PBUO_INTEG(:,JK)=ZBUO_INTEG_DRY(:,JK)+ZBUO_INTEG_CLD(:,JK)
+ !$mnh_expand_where(JI=D%NIB:D%NIE)
+ PBUO_INTEG(D%NIB:D%NIE,JK)=ZBUO_INTEG_DRY(D%NIB:D%NIE,JK)+ZBUO_INTEG_CLD(D%NIB:D%NIE,JK)
- IF (JK==KKB) THEN
- PDETR(:,JK)=0.
- ZDETR_CLD(:,JK)=0.
+ IF (JK==D%NKB) THEN
+ PDETR(D%NIB:D%NIE,JK)=0.
+ ZDETR_CLD(D%NIB:D%NIE,JK)=0.
ENDIF
-! Computation of updraft characteristics at level JK+KKL
- WHERE(GTEST)
- ZMIX1(:)=0.5*(PZZ(:,JK+KKL)-PZZ(:,JK))*(PENTR(:,JK)-PDETR(:,JK))
- PEMF(:,JK+KKL)=PEMF(:,JK)*EXP(2*ZMIX1(:))
+ ! Computation of updraft characteristics at level JK+KKL
+ WHERE(GTEST(D%NIB:D%NIE))
+ ZMIX1(D%NIB:D%NIE)=0.5*(PZZ(D%NIB:D%NIE,JK+D%NKL)-PZZ(D%NIB:D%NIE,JK))*(PENTR(D%NIB:D%NIE,JK)-PDETR(D%NIB:D%NIE,JK))
+ PEMF(D%NIB:D%NIE,JK+D%NKL)=PEMF(D%NIB:D%NIE,JK)*EXP(2*ZMIX1(D%NIB:D%NIE))
ENDWHERE
- ELSE
- GTEST(:) = (PEMF(:,JK+KKL)>0.)
- END IF
+ !$mnh_end_expand_where(JI=D%NIB:D%NIE)
+ ELSE !OENTR_DETR
+ !$mnh_expand_array(JI=D%NIB:D%NIE)
+ GTEST(D%NIB:D%NIE) = (PEMF(D%NIB:D%NIE,JK+D%NKL)>0.)
+ !$mnh_end_expand_array(JI=D%NIB:D%NIE)
+ END IF !OENTR_DETR
-
-! stop the updraft if MF becomes negative
- WHERE (GTEST.AND.(PEMF(:,JK+KKL)<=0.))
- PEMF(:,JK+KKL)=0.
- KKCTL(:) = JK+KKL
- GTEST(:)=.FALSE.
- PFRAC_ICE_UP(:,JK+KKL)=PFRAC_ICE_UP(:,JK)
- PRSAT_UP(:,JK+KKL)=PRSAT_UP(:,JK)
+ ! stop the updraft if MF becomes negative
+ !$mnh_expand_where(JI=D%NIB:D%NIE)
+ WHERE (GTEST(D%NIB:D%NIE).AND.(PEMF(D%NIB:D%NIE,JK+D%NKL)<=0.))
+ PEMF(D%NIB:D%NIE,JK+D%NKL)=0.
+ KKCTL(D%NIB:D%NIE) = JK+D%NKL
+ GTEST(D%NIB:D%NIE)=.FALSE.
+ PFRAC_ICE_UP(D%NIB:D%NIE,JK+D%NKL)=PFRAC_ICE_UP(D%NIB:D%NIE,JK)
+ PRSAT_UP(D%NIB:D%NIE,JK+D%NKL)=PRSAT_UP(D%NIB:D%NIE,JK)
ENDWHERE
-
-
-! If the updraft did not stop, compute cons updraft characteritics at jk+KKL
- DO JLOOP=1,SIZE(GTEST)
- IF(GTEST(JLOOP)) THEN
- ZMIX2(JLOOP) = (PZZ(JLOOP,JK+KKL)-PZZ(JLOOP,JK))*PENTR(JLOOP,JK) !&
- ZMIX3_CLD(JLOOP) = (PZZ(JLOOP,JK+KKL)-PZZ(JLOOP,JK))*(1.-ZPART_DRY(JLOOP))*ZDETR_CLD(JLOOP,JK) !&
- ZMIX2_CLD(JLOOP) = (PZZ(JLOOP,JK+KKL)-PZZ(JLOOP,JK))*(1.-ZPART_DRY(JLOOP))*ZENTR_CLD(JLOOP,JK)
+ !$mnh_end_expand_where(JI=D%NIB:D%NIE)
+
+ ! If the updraft did not stop, compute cons updraft characteritics at jk+KKL
+ DO JI=D%NIB,D%NIE
+ IF(GTEST(JI)) THEN
+ ZMIX2(JI) = (PZZ(JI,JK+D%NKL)-PZZ(JI,JK))*PENTR(JI,JK) !&
+ ZMIX3_CLD(JI) = (PZZ(JI,JK+D%NKL)-PZZ(JI,JK))*(1.-ZPART_DRY(JI))*ZDETR_CLD(JI,JK) !&
+ ZMIX2_CLD(JI) = (PZZ(JI,JK+D%NKL)-PZZ(JI,JK))*(1.-ZPART_DRY(JI))*ZENTR_CLD(JI,JK)
#ifdef REPRO48
- PTHL_UP(JLOOP,JK+KKL)=(PTHL_UP(JLOOP,JK)*(1.-0.5*ZMIX2(JLOOP)) + PTHLM(JLOOP,JK)*ZMIX2(JLOOP)) &
- /(1.+0.5*ZMIX2(JLOOP))
- PRT_UP(JLOOP,JK+KKL) =(PRT_UP (JLOOP,JK)*(1.-0.5*ZMIX2(JLOOP)) + PRTM(JLOOP,JK)*ZMIX2(JLOOP)) &
- /(1.+0.5*ZMIX2(JLOOP))
+ PTHL_UP(JI,JK+D%NKL)=(PTHL_UP(JI,JK)*(1.-0.5*ZMIX2(JI)) + PTHLM(JI,JK)*ZMIX2(JI)) &
+ /(1.+0.5*ZMIX2(JI))
+ PRT_UP(JI,JK+D%NKL) =(PRT_UP (JI,JK)*(1.-0.5*ZMIX2(JI)) + PRTM(JI,JK)*ZMIX2(JI)) &
+ /(1.+0.5*ZMIX2(JI))
#else
- PTHL_UP(JLOOP,JK+KKL)=PTHL_UP(JLOOP,JK)*EXP(-ZMIX2(JLOOP)) + PTHLM(JLOOP,JK)*(1-EXP(-ZMIX2(JLOOP)))
- PRT_UP(JLOOP,JK+KKL) =PRT_UP (JLOOP,JK)*EXP(-ZMIX2(JLOOP)) + PRTM(JLOOP,JK)*(1-EXP(-ZMIX2(JLOOP)))
+ PTHL_UP(JI,JK+D%NKL)=PTHL_UP(JI,JK)*EXP(-ZMIX2(JI)) + PTHLM(JI,JK)*(1-EXP(-ZMIX2(JI)))
+ PRT_UP(JI,JK+D%NKL) =PRT_UP (JI,JK)*EXP(-ZMIX2(JI)) + PRTM(JI,JK)*(1-EXP(-ZMIX2(JI)))
#endif
ENDIF
ENDDO
-
IF(OMIXUV) THEN
- IF(JK/=KKB) THEN
- WHERE(GTEST)
- PU_UP(:,JK+KKL) = (PU_UP (:,JK)*(1-0.5*ZMIX2(:)) + PUM(:,JK)*ZMIX2(:)+ &
- 0.5*XPRES_UV*(PZZ(:,JK+KKL)-PZZ(:,JK))*&
- ((PUM(:,JK+KKL)-PUM(:,JK))/PDZZ(:,JK+KKL)+&
- (PUM(:,JK)-PUM(:,JK-KKL))/PDZZ(:,JK)) ) &
- /(1+0.5*ZMIX2(:))
- PV_UP(:,JK+KKL) = (PV_UP (:,JK)*(1-0.5*ZMIX2(:)) + PVM(:,JK)*ZMIX2(:)+ &
- 0.5*XPRES_UV*(PZZ(:,JK+KKL)-PZZ(:,JK))*&
- ((PVM(:,JK+KKL)-PVM(:,JK))/PDZZ(:,JK+KKL)+&
- (PVM(:,JK)-PVM(:,JK-KKL))/PDZZ(:,JK)) ) &
- /(1+0.5*ZMIX2(:))
+ IF(JK/=D%NKB) THEN
+ !$mnh_expand_where(JI=D%NIB:D%NIE)
+ WHERE(GTEST(D%NIB:D%NIE))
+ PU_UP(D%NIB:D%NIE,JK+D%NKL) = (PU_UP(D%NIB:D%NIE,JK)*(1-0.5*ZMIX2(D%NIB:D%NIE)) + PUM(D%NIB:D%NIE,JK)*ZMIX2(D%NIB:D%NIE)+ &
+ 0.5*PARAMMF%XPRES_UV*(PZZ(D%NIB:D%NIE,JK+D%NKL)-PZZ(D%NIB:D%NIE,JK))*&
+ ((PUM(D%NIB:D%NIE,JK+D%NKL)-PUM(D%NIB:D%NIE,JK))/PDZZ(D%NIB:D%NIE,JK+D%NKL)+&
+ (PUM(D%NIB:D%NIE,JK)-PUM(D%NIB:D%NIE,JK-D%NKL))/PDZZ(D%NIB:D%NIE,JK)) ) &
+ /(1+0.5*ZMIX2(D%NIB:D%NIE))
+ PV_UP(D%NIB:D%NIE,JK+D%NKL) = (PV_UP(D%NIB:D%NIE,JK)*(1-0.5*ZMIX2(D%NIB:D%NIE)) + PVM(D%NIB:D%NIE,JK)*ZMIX2(D%NIB:D%NIE)+ &
+ 0.5*PARAMMF%XPRES_UV*(PZZ(D%NIB:D%NIE,JK+D%NKL)-PZZ(D%NIB:D%NIE,JK))*&
+ ((PVM(D%NIB:D%NIE,JK+D%NKL)-PVM(D%NIB:D%NIE,JK))/PDZZ(D%NIB:D%NIE,JK+D%NKL)+&
+ (PVM(D%NIB:D%NIE,JK)-PVM(D%NIB:D%NIE,JK-D%NKL))/PDZZ(D%NIB:D%NIE,JK)) ) &
+ /(1+0.5*ZMIX2(D%NIB:D%NIE))
ENDWHERE
+ !$mnh_end_expand_where(JI=D%NIB:D%NIE)
ELSE
- WHERE(GTEST)
- PU_UP(:,JK+KKL) = (PU_UP (:,JK)*(1-0.5*ZMIX2(:)) + PUM(:,JK)*ZMIX2(:)+ &
- 0.5*XPRES_UV*(PZZ(:,JK+KKL)-PZZ(:,JK))*&
- ((PUM(:,JK+KKL)-PUM(:,JK))/PDZZ(:,JK+KKL)) ) &
- /(1+0.5*ZMIX2(:))
- PV_UP(:,JK+KKL) = (PV_UP (:,JK)*(1-0.5*ZMIX2(:)) + PVM(:,JK)*ZMIX2(:)+ &
- 0.5*XPRES_UV*(PZZ(:,JK+KKL)-PZZ(:,JK))*&
- ((PVM(:,JK+KKL)-PVM(:,JK))/PDZZ(:,JK+KKL)) ) &
- /(1+0.5*ZMIX2(:))
+ !$mnh_expand_where(JI=D%NIB:D%NIE)
+ WHERE(GTEST(D%NIB:D%NIE))
+ PU_UP(D%NIB:D%NIE,JK+D%NKL) = (PU_UP(D%NIB:D%NIE,JK)*(1-0.5*ZMIX2(D%NIB:D%NIE)) + PUM(D%NIB:D%NIE,JK)*ZMIX2(D%NIB:D%NIE)+ &
+ 0.5*PARAMMF%XPRES_UV*(PZZ(D%NIB:D%NIE,JK+D%NKL)-PZZ(D%NIB:D%NIE,JK))*&
+ ((PUM(D%NIB:D%NIE,JK+D%NKL)-PUM(D%NIB:D%NIE,JK))/PDZZ(D%NIB:D%NIE,JK+D%NKL)) ) &
+ /(1+0.5*ZMIX2(D%NIB:D%NIE))
+ PV_UP(D%NIB:D%NIE,JK+D%NKL) = (PV_UP(D%NIB:D%NIE,JK)*(1-0.5*ZMIX2(D%NIB:D%NIE)) + PVM(D%NIB:D%NIE,JK)*ZMIX2(D%NIB:D%NIE)+ &
+ 0.5*PARAMMF%XPRES_UV*(PZZ(D%NIB:D%NIE,JK+D%NKL)-PZZ(D%NIB:D%NIE,JK))*&
+ ((PVM(D%NIB:D%NIE,JK+D%NKL)-PVM(D%NIB:D%NIE,JK))/PDZZ(D%NIB:D%NIE,JK+D%NKL)) ) &
+ /(1+0.5*ZMIX2(D%NIB:D%NIE))
ENDWHERE
-
+ !$mnh_end_expand_where(JI=D%NIB:D%NIE)
ENDIF
- ENDIF
- DO JSV=1,ISV
- IF (ONOMIXLG .AND. JSV >= KSV_LGBEG .AND. JSV<= KSV_LGEND) CYCLE
- WHERE(GTEST)
- PSV_UP(:,JK+KKL,JSV) = (PSV_UP (:,JK,JSV)*(1-0.5*ZMIX2(:)) + &
- PSVM(:,JK,JSV)*ZMIX2(:)) /(1+0.5*ZMIX2(:))
- ENDWHERE
+ ENDIF !OMIXUV
+ DO JSV=1,KSV
+ IF (ONOMIXLG .AND. JSV >= KSV_LGBEG .AND. JSV<= KSV_LGEND) CYCLE
+ !$mnh_expand_where(JI=D%NIB:D%NIE)
+ WHERE(GTEST(D%NIB:D%NIE))
+ PSV_UP(D%NIB:D%NIE,JK+D%NKL,JSV) = (PSV_UP(D%NIB:D%NIE,JK,JSV)*(1-0.5*ZMIX2(D%NIB:D%NIE)) + &
+ PSVM(D%NIB:D%NIE,JK,JSV)*ZMIX2(D%NIB:D%NIE)) /(1+0.5*ZMIX2(D%NIB:D%NIE))
+ ENDWHERE
+ !$mnh_end_expand_where(JI=D%NIB:D%NIE)
END DO
- IF (OENTR_DETR) THEN
-
-! Compute non cons. var. at level JK+KKL
- ZRC_UP(:)=PRC_UP(:,JK) ! guess = level just below
- ZRI_UP(:)=PRI_UP(:,JK) ! guess = level just below
- CALL TH_R_FROM_THL_RT_1D(HFRAC_ICE,PFRAC_ICE_UP(:,JK+KKL),ZPRES_F(:,JK+KKL), &
- PTHL_UP(:,JK+KKL),PRT_UP(:,JK+KKL),ZTH_UP(:,JK+KKL), &
- ZRV_UP(:),ZRC_UP(:),ZRI_UP(:),ZRSATW(:),ZRSATI(:), OOCEAN=.FALSE.)
- WHERE(GTEST)
- PRC_UP(:,JK+KKL)=ZRC_UP(:)
- PRV_UP(:,JK+KKL)=ZRV_UP(:)
- PRI_UP(:,JK+KKL)=ZRI_UP(:)
- PRSAT_UP(:,JK+KKL) = ZRSATW(:)*(1-PFRAC_ICE_UP(:,JK+KKL)) + ZRSATI(:)*PFRAC_ICE_UP(:,JK+KKL)
- ENDWHERE
-
+ IF (OENTR_DETR) THEN
-! Compute the updraft theta_v, buoyancy and w**2 for level JK+KKL
- WHERE(GTEST)
- PTHV_UP(:,JK+KKL) = ZTH_UP(:,JK+KKL)*((1+ZRVORD*PRV_UP(:,JK+KKL))/(1+PRT_UP(:,JK+KKL)))
- WHERE (ZBUO_INTEG_DRY(:,JK)>0.)
- ZW_UP2(:,JK+KKL) = ZW_UP2(:,JK) + 2.*(XABUO-XBENTR*XENTR_DRY)* ZBUO_INTEG_DRY(:,JK)
- ELSEWHERE
- ZW_UP2(:,JK+KKL) = ZW_UP2(:,JK) + 2.*XABUO* ZBUO_INTEG_DRY(:,JK)
+ ! Compute non cons. var. at level JK+KKL
+ !$mnh_expand_array(JI=D%NIB:D%NIE)
+ ZRC_UP(D%NIB:D%NIE)=PRC_UP(D%NIB:D%NIE,JK) ! guess = level just below
+ ZRI_UP(D%NIB:D%NIE)=PRI_UP(D%NIB:D%NIE,JK) ! guess = level just below
+ !$mnh_end_expand_array(JI=D%NIB:D%NIE)
+ CALL TH_R_FROM_THL_RT(CST, NEB, D%NIT, HFRAC_ICE,PFRAC_ICE_UP(:,JK+D%NKL),ZPRES_F(:,JK+D%NKL), &
+ PTHL_UP(:,JK+D%NKL),PRT_UP(:,JK+D%NKL),ZTH_UP(:,JK+D%NKL), &
+ ZRV_UP(:),ZRC_UP(:),ZRI_UP(:),ZRSATW(:),ZRSATI(:), OOCEAN=.FALSE., &
+ PBUF=ZBUF(:,:), KB=D%NIB, KE=D%NIE)
+ !$mnh_expand_where(JI=D%NIB:D%NIE)
+ WHERE(GTEST(D%NIB:D%NIE))
+ PRC_UP(D%NIB:D%NIE,JK+D%NKL)=ZRC_UP(D%NIB:D%NIE)
+ PRV_UP(D%NIB:D%NIE,JK+D%NKL)=ZRV_UP(D%NIB:D%NIE)
+ PRI_UP(D%NIB:D%NIE,JK+D%NKL)=ZRI_UP(D%NIB:D%NIE)
+ PRSAT_UP(D%NIB:D%NIE,JK+D%NKL) = ZRSATW(D%NIB:D%NIE)*(1-PFRAC_ICE_UP(D%NIB:D%NIE,JK+D%NKL)) + &
+ & ZRSATI(D%NIB:D%NIE)*PFRAC_ICE_UP(D%NIB:D%NIE,JK+D%NKL)
ENDWHERE
- ZW_UP2(:,JK+KKL) = ZW_UP2(:,JK+KKL)*(1.-(XBDETR*ZMIX3_CLD(:)+XBENTR*ZMIX2_CLD(:)))&
- /(1.+(XBDETR*ZMIX3_CLD(:)+XBENTR*ZMIX2_CLD(:))) &
- +2.*(XABUO)*ZBUO_INTEG_CLD(:,JK)/(1.+(XBDETR*ZMIX3_CLD(:)+XBENTR*ZMIX2_CLD(:)))
- ENDWHERE
+ ! Compute the updraft theta_v, buoyancy and w**2 for level JK+KKL
+ WHERE(GTEST(D%NIB:D%NIE))
+ PTHV_UP(D%NIB:D%NIE,JK+D%NKL) = ZTH_UP(D%NIB:D%NIE,JK+D%NKL)* &
+ & ((1+ZRVORD*PRV_UP(D%NIB:D%NIE,JK+D%NKL))/(1+PRT_UP(D%NIB:D%NIE,JK+D%NKL)))
+ WHERE (ZBUO_INTEG_DRY(D%NIB:D%NIE,JK)>0.)
+ ZW_UP2(D%NIB:D%NIE,JK+D%NKL) = ZW_UP2(D%NIB:D%NIE,JK) + 2.*(PARAMMF%XABUO-PARAMMF%XBENTR*PARAMMF%XENTR_DRY)* &
+ &ZBUO_INTEG_DRY(D%NIB:D%NIE,JK)
+ ELSEWHERE
+ ZW_UP2(D%NIB:D%NIE,JK+D%NKL) = ZW_UP2(D%NIB:D%NIE,JK) + 2.*PARAMMF%XABUO* ZBUO_INTEG_DRY(D%NIB:D%NIE,JK)
+ ENDWHERE
+ ZW_UP2(D%NIB:D%NIE,JK+D%NKL) = ZW_UP2(D%NIB:D%NIE,JK+D%NKL)*(1.-(PARAMMF%XBDETR*ZMIX3_CLD(D%NIB:D%NIE)+ &
+ &PARAMMF%XBENTR*ZMIX2_CLD(D%NIB:D%NIE)))&
+ /(1.+(PARAMMF%XBDETR*ZMIX3_CLD(D%NIB:D%NIE)+PARAMMF%XBENTR*ZMIX2_CLD(D%NIB:D%NIE))) &
+ +2.*(PARAMMF%XABUO)*ZBUO_INTEG_CLD(D%NIB:D%NIE,JK)/ &
+ &(1.+(PARAMMF%XBDETR*ZMIX3_CLD(D%NIB:D%NIE)+PARAMMF%XBENTR*ZMIX2_CLD(D%NIB:D%NIE)))
+ ENDWHERE
- ! Test if the updraft has reach the ETL
- GTESTETL(:)=.FALSE.
- WHERE (GTEST.AND.(PBUO_INTEG(:,JK)<=0.))
- KKETL(:) = JK+KKL
- GTESTETL(:)=.TRUE.
- ENDWHERE
+ ! Test if the updraft has reach the ETL
+ WHERE (GTEST(D%NIB:D%NIE).AND.(PBUO_INTEG(D%NIB:D%NIE,JK)<=0.))
+ KKETL(D%NIB:D%NIE) = JK+D%NKL
+ GTESTETL(D%NIB:D%NIE)=.TRUE.
+ ELSEWHERE
+ GTESTETL(D%NIB:D%NIE)=.FALSE.
+ ENDWHERE
- ! Test is we have reached the top of the updraft
- WHERE (GTEST.AND.((ZW_UP2(:,JK+KKL)<=0.).OR.(PEMF(:,JK+KKL)<=0.)))
- ZW_UP2(:,JK+KKL)=0.
- PEMF(:,JK+KKL)=0.
- GTEST(:)=.FALSE.
- PTHL_UP(:,JK+KKL)=ZTHLM_F(:,JK+KKL)
- PRT_UP(:,JK+KKL)=ZRTM_F(:,JK+KKL)
- PRC_UP(:,JK+KKL)=0.
- PRI_UP(:,JK+KKL)=0.
- PRV_UP(:,JK+KKL)=0.
- PTHV_UP(:,JK+KKL)=ZTHVM_F(:,JK+KKL)
- PFRAC_UP(:,JK+KKL)=0.
- KKCTL(:)=JK+KKL
- ENDWHERE
+ ! Test is we have reached the top of the updraft
+ WHERE (GTEST(D%NIB:D%NIE).AND.((ZW_UP2(D%NIB:D%NIE,JK+D%NKL)<=0.).OR.(PEMF(D%NIB:D%NIE,JK+D%NKL)<=0.)))
+ ZW_UP2(D%NIB:D%NIE,JK+D%NKL)=0.
+ PEMF(D%NIB:D%NIE,JK+D%NKL)=0.
+ GTEST(D%NIB:D%NIE)=.FALSE.
+ PTHL_UP(D%NIB:D%NIE,JK+D%NKL)=ZTHLM_F(D%NIB:D%NIE,JK+D%NKL)
+ PRT_UP(D%NIB:D%NIE,JK+D%NKL)=ZRTM_F(D%NIB:D%NIE,JK+D%NKL)
+ PRC_UP(D%NIB:D%NIE,JK+D%NKL)=0.
+ PRI_UP(D%NIB:D%NIE,JK+D%NKL)=0.
+ PRV_UP(D%NIB:D%NIE,JK+D%NKL)=0.
+ PTHV_UP(D%NIB:D%NIE,JK+D%NKL)=ZTHVM_F(D%NIB:D%NIE,JK+D%NKL)
+ PFRAC_UP(D%NIB:D%NIE,JK+D%NKL)=0.
+ KKCTL(D%NIB:D%NIE)=JK+D%NKL
+ ENDWHERE
- ! compute frac_up at JK+KKL
- WHERE (GTEST)
- PFRAC_UP(:,JK+KKL)=PEMF(:,JK+KKL)/(SQRT(ZW_UP2(:,JK+KKL))*ZRHO_F(:,JK+KKL))
- ENDWHERE
-
- ! Updraft fraction must be smaller than XFRAC_UP_MAX
- WHERE (GTEST)
- PFRAC_UP(:,JK+KKL)=MIN(XFRAC_UP_MAX,PFRAC_UP(:,JK+KKL))
- ENDWHERE
+ ! compute frac_up at JK+KKL
+ WHERE (GTEST(D%NIB:D%NIE))
+ PFRAC_UP(D%NIB:D%NIE,JK+D%NKL)=PEMF(D%NIB:D%NIE,JK+D%NKL)/(SQRT(ZW_UP2(D%NIB:D%NIE,JK+D%NKL))*ZRHO_F(D%NIB:D%NIE,JK+D%NKL))
+ ENDWHERE
- ! When cloudy and non-buoyant, updraft fraction must decrease
- WHERE ((GTEST.AND.GTESTETL).AND.GTESTLCL)
- PFRAC_UP(:,JK+KKL)=MIN(PFRAC_UP(:,JK+KKL),PFRAC_UP(:,JK))
- ENDWHERE
+ ! Updraft fraction must be smaller than XFRAC_UP_MAX
+ WHERE (GTEST(D%NIB:D%NIE))
+ PFRAC_UP(D%NIB:D%NIE,JK+D%NKL)=MIN(PARAMMF%XFRAC_UP_MAX,PFRAC_UP(D%NIB:D%NIE,JK+D%NKL))
+ ENDWHERE
- ! Mass flux is updated with the new updraft fraction
- IF (OENTR_DETR) PEMF(:,JK+KKL)=PFRAC_UP(:,JK+KKL)*SQRT(ZW_UP2(:,JK+KKL))*ZRHO_F(:,JK+KKL)
+ ! When cloudy and non-buoyant, updraft fraction must decrease
+ WHERE ((GTEST(D%NIB:D%NIE).AND.GTESTETL(D%NIB:D%NIE)).AND.GTESTLCL(D%NIB:D%NIE))
+ PFRAC_UP(D%NIB:D%NIE,JK+D%NKL)=MIN(PFRAC_UP(D%NIB:D%NIE,JK+D%NKL),PFRAC_UP(D%NIB:D%NIE,JK))
+ ENDWHERE
- END IF
+ ! Mass flux is updated with the new updraft fraction
+ IF (OENTR_DETR) PEMF(D%NIB:D%NIE,JK+D%NKL)=PFRAC_UP(D%NIB:D%NIE,JK+D%NKL)*SQRT(ZW_UP2(D%NIB:D%NIE,JK+D%NKL))* &
+ &ZRHO_F(D%NIB:D%NIE,JK+D%NKL)
+ !$mnh_end_expand_where(JI=D%NIB:D%NIE)
+ END IF !OENTR_DETR
ENDDO
IF(OENTR_DETR) THEN
- PW_UP(:,:)=SQRT(ZW_UP2(:,:))
+ !$mnh_expand_array(JI=D%NIB:D%NIE,JK=1:D%NKT)
+ PW_UP(D%NIB:D%NIE,:)=SQRT(ZW_UP2(D%NIB:D%NIE,:))
+ !$mnh_end_expand_array(JI=D%NIB:D%NIE,JK=1:D%NKT)
- PEMF(:,KKB) =0.
+ !$mnh_expand_array(JI=D%NIB:D%NIE)
+ PEMF(D%NIB:D%NIE,D%NKB) =0.
+ !$mnh_end_expand_array(JI=D%NIB:D%NIE)
-! Limits the shallow convection scheme when cloud heigth is higher than 3000m.
-! To do this, mass flux is multiplied by a coefficient decreasing linearly
-! from 1 (for clouds of ZDEPTH_MAX1 m of depth) to 0 (for clouds of ZDEPTH_MAX2 m of depth).
-! This way, all MF fluxes are diminished by this amount.
-! Diagnosed cloud fraction is also multiplied by the same coefficient.
-!
- DO JI=1,SIZE(PTHM,1)
+ ! Limits the shallow convection scheme when cloud heigth is higher than 3000m.
+ ! To do this, mass flux is multiplied by a coefficient decreasing linearly
+ ! from 1 (for clouds of ZDEPTH_MAX1 m of depth) to 0 (for clouds of ZDEPTH_MAX2 m of depth).
+ ! This way, all MF fluxes are diminished by this amount.
+ ! Diagnosed cloud fraction is also multiplied by the same coefficient.
+ !
+ DO JI=D%NIB,D%NIE
PDEPTH(JI) = MAX(0., PZZ(JI,KKCTL(JI)) - PZZ(JI,KKLCL(JI)) )
END DO
- GWORK1(:)= (GTESTLCL(:) .AND. (PDEPTH(:) > ZDEPTH_MAX1) )
- GWORK2(:,:) = SPREAD( GWORK1(:), DIM=2, NCOPIES=MAX(KKU,KKA) )
- ZCOEF(:,:) = SPREAD( (1.-(PDEPTH(:)-ZDEPTH_MAX1)/(ZDEPTH_MAX2-ZDEPTH_MAX1)), DIM=2, NCOPIES=SIZE(ZCOEF,2))
- ZCOEF=MIN(MAX(ZCOEF,0.),1.)
- WHERE (GWORK2)
- PEMF(:,:) = PEMF(:,:) * ZCOEF(:,:)
- PFRAC_UP(:,:) = PFRAC_UP(:,:) * ZCOEF(:,:)
+ !$mnh_expand_array(JI=D%NIB:D%NIE)
+ GWORK1(D%NIB:D%NIE)= (GTESTLCL(D%NIB:D%NIE) .AND. (PDEPTH(D%NIB:D%NIE) > ZDEPTH_MAX1) )
+ !$mnh_end_expand_array(JI=D%NIB:D%NIE)
+ DO JK=1, D%NKT
+ !$mnh_expand_array(JI=D%NIB:D%NIE)
+ GWORK2(D%NIB:D%NIE,JK) = GWORK1(D%NIB:D%NIE)
+ ZCOEF(D%NIB:D%NIE,JK) = (1.-(PDEPTH(D%NIB:D%NIE)-ZDEPTH_MAX1)/(ZDEPTH_MAX2-ZDEPTH_MAX1))
+ ZCOEF(D%NIB:D%NIE,JK)=MIN(MAX(ZCOEF(D%NIB:D%NIE,JK),0.),1.)
+ !$mnh_end_expand_array(JI=D%NIB:D%NIE)
+ ENDDO
+ !$mnh_expand_where(JI=D%NIB:D%NIE,JK=1:D%NKT)
+ WHERE (GWORK2(D%NIB:D%NIE,:))
+ PEMF(D%NIB:D%NIE,:) = PEMF(D%NIB:D%NIE,:) * ZCOEF(D%NIB:D%NIE,:)
+ PFRAC_UP(D%NIB:D%NIE,:) = PFRAC_UP(D%NIB:D%NIE,:) * ZCOEF(D%NIB:D%NIE,:)
ENDWHERE
+ !$mnh_end_expand_where(JI=D%NIB:D%NIE,JK=1:D%NKT)
ENDIF
IF (LHOOK) CALL DR_HOOK('COMPUTE_UPDRAFT',1,ZHOOK_HANDLE)
+CONTAINS
+INCLUDE "th_r_from_thl_rt.func.h"
+INCLUDE "compute_frac_ice.func.h"
+ SUBROUTINE COMPUTE_ENTR_DETR(D, CST, NEB, PARAMMF,&
+ KK,KKB,KKE,KKL,OTEST,OTESTLCL,&
+ HFRAC_ICE,PFRAC_ICE,PRHODREF,&
+ PPRE_MINUS_HALF,&
+ PPRE_PLUS_HALF,PZZ,PDZZ,&
+ PTHVM,PTHLM,PRTM,PW_UP2,PTH_UP,&
+ PTHL_UP,PRT_UP,PLUP,&
+ PRC_UP,PRI_UP,PTHV_UP,&
+ PRSAT_UP,PRC_MIX,PRI_MIX, &
+ PENTR,PDETR,PENTR_CLD,PDETR_CLD,&
+ PBUO_INTEG_DRY,PBUO_INTEG_CLD,&
+ PPART_DRY)
+! #############################################################
+
+!!
+!!***COMPUTE_ENTR_DETR* - calculates caracteristics of the updraft or downdraft
+!! using model of the EDMF scheme
+!!
+!! PURPOSE
+!! -------
+!!**** The purpose of this routine is to compute entrainement and
+!! detrainement at one level of the updraft
+!
+!!** METHOD
+!! ------
+!!
+!! EXTERNAL
+!! --------
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! REFERENCE
+!! ---------
+!! Book 1 of Meso-NH documentation (chapter Convection)
+!!
+!!
+!! AUTHOR
+!! ------
+!! J.Pergaud : 2009
+!!
+!! MODIFICATIONS
+!! -------------
+!! Y.Seity (06/2010) Bug correction
+!! V.Masson (09/2010) Optimization
+!! S. Riette april 2011 : ice added, protection against zero divide by Yves Bouteloup
+!! protection against too big ZPART_DRY, interface modified
+!! S. Riette Jan 2012: support for both order of vertical levels
+!! S. Riette & J. Escobar (11/2013) : remove div by 0 on real*4 case
+!! P.Marguinaud Jun 2012: fix uninitialized variable
+!! P.Marguinaud Nov 2012: fix gfortran bug
+!! S. Riette Apr 2013: bugs correction, rewriting (for optimisation) and
+!! improvement of continuity at the condensation level
+!! S. Riette Nov 2013: protection against zero divide for min value of dry PDETR
+!! R.Honnert Oct 2016 : Update with AROME
+! P. Wautelet 08/02/2019: bugfix: compute ZEPSI_CLOUD only once and only when it is needed
+!! R. El Khatib 29-Apr-2019 portability fix : compiler may get confused by embricked WHERE statements
+!! eventually breaking tests with NaN initializations at compile time.
+!! Replace by IF conditions and traditional DO loops can only improve the performance.
+! P. Wautelet 10/02/2021: bugfix: initialized PPART_DRY everywhere
+!! --------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+USE MODD_CST, ONLY: CST_t
+USE MODD_NEB, ONLY: NEB_t
+USE MODD_PARAM_MFSHALL_n, ONLY: PARAM_MFSHALL_t
+!
+IMPLICIT NONE
+!
+!
+!* 1.1 Declaration of Arguments
+!
+!
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+TYPE(CST_t), INTENT(IN) :: CST
+TYPE(NEB_t), INTENT(IN) :: NEB
+TYPE(PARAM_MFSHALL_t), INTENT(IN) :: PARAMMF
+!
+INTEGER, INTENT(IN) :: KK
+INTEGER, INTENT(IN) :: KKB ! near ground physical index
+INTEGER, INTENT(IN) :: KKE ! uppest atmosphere physical index
+INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+LOGICAL,DIMENSION(D%NIT), INTENT(IN) :: OTEST ! test to see if updraft is running
+LOGICAL,DIMENSION(D%NIT), INTENT(IN) :: OTESTLCL !test of condensation
+CHARACTER(LEN=1), INTENT(IN) :: HFRAC_ICE ! frac_ice can be compute using
+ ! Temperature (T) or prescribed
+ ! (Y)
+REAL, DIMENSION(D%NIT), INTENT(IN) :: PFRAC_ICE ! fraction of ice
+!
+! prognostic variables at t- deltat
+!
+REAL, DIMENSION(D%NIT), INTENT(IN) :: PRHODREF !rhodref
+REAL, DIMENSION(D%NIT), INTENT(IN) :: PPRE_MINUS_HALF ! Pressure at flux level KK
+REAL, DIMENSION(D%NIT), INTENT(IN) :: PPRE_PLUS_HALF ! Pressure at flux level KK+KKL
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(IN) :: PZZ ! Height at the flux point
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(IN) :: PDZZ ! metrics coefficient
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(IN) :: PTHVM ! ThetaV environment
+
+!
+! thermodynamical variables which are transformed in conservative var.
+!
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(IN) :: PTHLM ! Thetal
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(IN) :: PRTM ! total mixing ratio
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(IN) :: PW_UP2 ! Vertical velocity^2
+REAL, DIMENSION(D%NIT), INTENT(IN) :: PTH_UP,PTHL_UP,PRT_UP ! updraft properties
+REAL, DIMENSION(D%NIT), INTENT(IN) :: PLUP ! LUP compute from the ground
+REAL, DIMENSION(D%NIT), INTENT(IN) :: PRC_UP,PRI_UP ! Updraft cloud content
+REAL, DIMENSION(D%NIT), INTENT(IN) :: PTHV_UP ! Thetav of updraft
+REAL, DIMENSION(D%NIT), INTENT(IN) :: PRSAT_UP ! Mixing ratio at saturation in updraft
+REAL, DIMENSION(D%NIT), INTENT(INOUT) :: PRC_MIX, PRI_MIX ! Mixture cloud content
+REAL, DIMENSION(D%NIT), INTENT(OUT) :: PENTR ! Mass flux entrainment of the updraft
+REAL, DIMENSION(D%NIT), INTENT(OUT) :: PDETR ! Mass flux detrainment of the updraft
+REAL, DIMENSION(D%NIT), INTENT(OUT) :: PENTR_CLD ! Mass flux entrainment of the updraft in cloudy part
+REAL, DIMENSION(D%NIT), INTENT(OUT) :: PDETR_CLD ! Mass flux detrainment of the updraft in cloudy part
+REAL, DIMENSION(D%NIT), INTENT(OUT) :: PBUO_INTEG_DRY, PBUO_INTEG_CLD! Integral Buoyancy
+REAL, DIMENSION(D%NIT), INTENT(OUT) :: PPART_DRY ! ratio of dry part at the transition level
+!
+!
+! 1.2 Declaration of local variables
+!
+! Local array declaration must be put in the compute_updraft subroutine
+! For simplicity all local variables (including scalars) are moved in the compute_updraft subroutine
+!
+
+!----------------------------------------------------------------------------------
+
+! 1.3 Initialisation
+! ------------------
+
+ZCOEFFMF_CLOUD=PARAMMF%XENTR_MF * CST%XG / PARAMMF%XCRAD_MF
+!$mnh_expand_array(JI=D%NIB:D%NIE)
+ZG_O_THVREF_ED(D%NIB:D%NIE)=CST%XG/PTHVM(D%NIB:D%NIE,KK)
+
+ZFRAC_ICE(D%NIB:D%NIE)=PFRAC_ICE(D%NIB:D%NIE) ! to not modify fraction of ice
+
+ZPRE(D%NIB:D%NIE)=PPRE_MINUS_HALF(D%NIB:D%NIE)
+!$mnh_end_expand_array(JI=D%NIB:D%NIE)
+
+! 1.4 Estimation of PPART_DRY
+DO JI=D%NIB,D%NIE
+ IF(OTEST(JI) .AND. OTESTLCL(JI)) THEN
+ !No dry part when condensation level is reached
+ PPART_DRY(JI)=0.
+ ZDZ_STOP(JI)=0.
+ ZPRE(JI)=PPRE_MINUS_HALF(JI)
+ ELSE IF (OTEST(JI) .AND. .NOT. OTESTLCL(JI)) THEN
+ !Temperature at flux level KK
+ ZT=PTH_UP(JI)*(PPRE_MINUS_HALF(JI)/CST%XP00) ** (CST%XRD/CST%XCPD)
+ !Saturating vapor pressure at flux level KK
+ ZFOESW = MIN(EXP( CST%XALPW - CST%XBETAW/ZT - CST%XGAMW*LOG(ZT) ), 0.99*PPRE_MINUS_HALF(JI))
+ ZFOESI = MIN(EXP( CST%XALPI - CST%XBETAI/ZT - CST%XGAMI*LOG(ZT) ), 0.99*PPRE_MINUS_HALF(JI))
+ !Computation of d.Rsat / dP (partial derivations with respect to P and T
+ !and use of T=Theta*(P/P0)**(R/Cp) to transform dT into dP with theta_up
+ !constant at the vertical)
+ ZDRSATODP=(CST%XBETAW/ZT-CST%XGAMW)*(1-ZFRAC_ICE(JI))+(CST%XBETAI/ZT-CST%XGAMI)*ZFRAC_ICE(JI)
+ ZDRSATODP=((CST%XRD/CST%XCPD)*ZDRSATODP-1.)*PRSAT_UP(JI)/ &
+ &(PPRE_MINUS_HALF(JI)-(ZFOESW*(1-ZFRAC_ICE(JI)) + ZFOESI*ZFRAC_ICE(JI)))
+ !Use of d.Rsat / dP and pressure at flux level KK to find pressure (ZPRE)
+ !where Rsat is equal to PRT_UP
+ ZPRE(JI)=PPRE_MINUS_HALF(JI)+(PRT_UP(JI)-PRSAT_UP(JI))/ZDRSATODP
+ !Fraction of dry part (computed with pressure and used with heights, no
+ !impact found when using log function here and for pressure on flux levels
+ !computation)
+ PPART_DRY(JI)=MAX(0., MIN(1., (PPRE_MINUS_HALF(JI)-ZPRE(JI))/(PPRE_MINUS_HALF(JI)-PPRE_PLUS_HALF(JI))))
+ !Height above flux level KK of the cloudy part
+ ZDZ_STOP(JI) = (PZZ(JI,KK+KKL)-PZZ(JI,KK))*PPART_DRY(JI)
+ ELSE
+ PPART_DRY(JI)=0. ! value does not matter, here
+ END IF
+END DO
+
+! 1.5 Gradient and flux values of thetav
+!$mnh_expand_array(JI=D%NIB:D%NIE)
+IF(KK/=KKB)THEN
+ ZCOEFF_MINUS_HALF(D%NIB:D%NIE)=((PTHVM(D%NIB:D%NIE,KK)-PTHVM(D%NIB:D%NIE,KK-KKL))/PDZZ(D%NIB:D%NIE,KK))
+ ZTHV_MINUS_HALF(D%NIB:D%NIE) = PTHVM(D%NIB:D%NIE,KK) - &
+ & ZCOEFF_MINUS_HALF(D%NIB:D%NIE)*0.5*(PZZ(D%NIB:D%NIE,KK+KKL)-PZZ(D%NIB:D%NIE,KK))
+ELSE
+ ZCOEFF_MINUS_HALF(D%NIB:D%NIE)=0.
+ ZTHV_MINUS_HALF(D%NIB:D%NIE) = PTHVM(D%NIB:D%NIE,KK)
+ENDIF
+ZCOEFF_PLUS_HALF(D%NIB:D%NIE) = ((PTHVM(D%NIB:D%NIE,KK+KKL)-PTHVM(D%NIB:D%NIE,KK))/PDZZ(D%NIB:D%NIE,KK+KKL))
+ZTHV_PLUS_HALF(D%NIB:D%NIE) = PTHVM(D%NIB:D%NIE,KK) + &
+ & ZCOEFF_PLUS_HALF(D%NIB:D%NIE)*0.5*(PZZ(D%NIB:D%NIE,KK+KKL)-PZZ(D%NIB:D%NIE,KK))
+!$mnh_end_expand_array(JI=D%NIB:D%NIE)
+
+! 2 Dry part computation:
+! Integral buoyancy and computation of PENTR and PDETR for dry part
+! --------------------------------------------------------------------
+
+DO JI=D%NIB,D%NIE
+ IF (OTEST(JI) .AND. PPART_DRY(JI)>0.) THEN
+ !Buoyancy computation in two parts to use change of gradient of theta v of environment
+ !Between flux level KK and min(mass level, bottom of cloudy part)
+ ZDZ=MIN(ZDZ_STOP(JI),(PZZ(JI,KK+KKL)-PZZ(JI,KK))*0.5)
+ PBUO_INTEG_DRY(JI) = ZG_O_THVREF_ED(JI)*ZDZ*&
+ (0.5 * ( - ZCOEFF_MINUS_HALF(JI))*ZDZ &
+ - ZTHV_MINUS_HALF(JI) + PTHV_UP(JI) )
+
+ !Between mass flux KK and bottom of cloudy part (if above mass flux)
+ ZDZ=MAX(0., ZDZ_STOP(JI)-(PZZ(JI,KK+KKL)-PZZ(JI,KK))*0.5)
+ PBUO_INTEG_DRY(JI) = PBUO_INTEG_DRY(JI) + ZG_O_THVREF_ED(JI)*ZDZ*&
+ (0.5 * ( - ZCOEFF_PLUS_HALF(JI))*ZDZ &
+ - PTHVM(JI,KK) + PTHV_UP(JI) )
+
+ !Entr//Detr. computation
+ IF (PBUO_INTEG_DRY(JI)>=0.) THEN
+ PENTR(JI) = 0.5/(PARAMMF%XABUO-PARAMMF%XBENTR*PARAMMF%XENTR_DRY)*&
+ LOG(1.+ (2.*(PARAMMF%XABUO-PARAMMF%XBENTR*PARAMMF%XENTR_DRY)/PW_UP2(JI,KK))* &
+ PBUO_INTEG_DRY(JI))
+ PDETR(JI) = 0.
+ ELSE
+ PENTR(JI) = 0.
+ PDETR(JI) = 0.5/(PARAMMF%XABUO)*&
+ LOG(1.+ (2.*(PARAMMF%XABUO)/PW_UP2(JI,KK))* &
+ (-PBUO_INTEG_DRY(JI)))
+ ENDIF
+ PENTR(JI) = PARAMMF%XENTR_DRY*PENTR(JI)/(PZZ(JI,KK+KKL)-PZZ(JI,KK))
+ PDETR(JI) = PARAMMF%XDETR_DRY*PDETR(JI)/(PZZ(JI,KK+KKL)-PZZ(JI,KK))
+ !Minimum value of detrainment
+ ZWK0D=PLUP(JI)-0.5*(PZZ(JI,KK)+PZZ(JI,KK+KKL))
+ ZWK0D=SIGN(MAX(1., ABS(ZWK0D)), ZWK0D) ! ZWK0D must not be zero
+ PDETR(JI) = MAX(PPART_DRY(JI)*PARAMMF%XDETR_LUP/ZWK0D, PDETR(JI))
+ ELSE
+ !No dry part, condensation reached (OTESTLCL)
+ PBUO_INTEG_DRY(JI) = 0.
+ PENTR(JI)=0.
+ PDETR(JI)=0.
+ ENDIF
+ENDDO
+
+! 3 Wet part computation
+! -----------------------
+
+! 3.1 Integral buoyancy for cloudy part
+
+! Compute theta_v of updraft at flux level KK+KKL
+!MIX variables are used to avoid declaring new variables
+!but we are dealing with updraft and not mixture
+!$mnh_expand_array(JI=D%NIB:D%NIE)
+ZRCMIX(D%NIB:D%NIE)=PRC_UP(D%NIB:D%NIE)
+ZRIMIX(D%NIB:D%NIE)=PRI_UP(D%NIB:D%NIE)
+!$mnh_end_expand_array(JI=D%NIB:D%NIE)
+CALL TH_R_FROM_THL_RT(CST,NEB,D%NIT,HFRAC_ICE,ZFRAC_ICE,&
+ PPRE_PLUS_HALF,PTHL_UP,PRT_UP,&
+ ZTHMIX,ZRVMIX,ZRCMIX,ZRIMIX,&
+ ZRSATW_ED, ZRSATI_ED,OOCEAN=.FALSE.,&
+ PBUF=ZBUF, KB=D%NIB, KE=D%NIE)
+!$mnh_expand_array(JI=D%NIB:D%NIE)
+ZTHV_UP_F2(D%NIB:D%NIE) = ZTHMIX(D%NIB:D%NIE)*(1.+ZRVORD*ZRVMIX(D%NIB:D%NIE))/(1.+PRT_UP(D%NIB:D%NIE))
+!$mnh_end_expand_array(JI=D%NIB:D%NIE)
+
+! Integral buoyancy for cloudy part
+DO JI=D%NIB,D%NIE
+ IF(OTEST(JI) .AND. PPART_DRY(JI)<1.) THEN
+ !Gradient of Theta V updraft over the cloudy part, assuming that thetaV updraft don't change
+ !between flux level KK and bottom of cloudy part
+ ZCOTHVU=(ZTHV_UP_F2(JI)-PTHV_UP(JI))/((PZZ(JI,KK+KKL)-PZZ(JI,KK))*(1-PPART_DRY(JI)))
+
+ !Computation in two parts to use change of gradient of theta v of environment
+ !Between bottom of cloudy part (if under mass level) and mass level KK
+ ZDZ=MAX(0., 0.5*(PZZ(JI,KK+KKL)-PZZ(JI,KK))-ZDZ_STOP(JI))
+ PBUO_INTEG_CLD(JI) = ZG_O_THVREF_ED(JI)*ZDZ*&
+ (0.5*( ZCOTHVU - ZCOEFF_MINUS_HALF(JI))*ZDZ &
+ - (PTHVM(JI,KK)-ZDZ*ZCOEFF_MINUS_HALF(JI)) + PTHV_UP(JI) )
+
+ !Between max(mass level, bottom of cloudy part) and flux level KK+KKL
+ ZDZ=(PZZ(JI,KK+KKL)-PZZ(JI,KK))-MAX(ZDZ_STOP(JI),0.5*(PZZ(JI,KK+KKL)-PZZ(JI,KK)))
+ PBUO_INTEG_CLD(JI) = PBUO_INTEG_CLD(JI)+ZG_O_THVREF_ED(JI)*ZDZ*&
+ (0.5*( ZCOTHVU - ZCOEFF_PLUS_HALF(JI))*ZDZ&
+ - (PTHVM(JI,KK)+(0.5*((PZZ(JI,KK+KKL)-PZZ(JI,KK)))-ZDZ)*ZCOEFF_PLUS_HALF(JI)) +&
+ PTHV_UP(JI) )
+
+ ELSE
+ !No cloudy part
+ PBUO_INTEG_CLD(JI)=0.
+ END IF
+END DO
+
+! 3.2 Critical mixed fraction for KK+KKL flux level (ZKIC_F2) and
+! for bottom of cloudy part (ZKIC), then a mean for the cloudy part
+! (put also in ZKIC)
+!
+! computation by estimating unknown
+! T^mix r_c^mix and r_i^mix from enthalpy^mix and r_w^mix
+! We determine the zero crossing of the linear curve
+! evaluating the derivative using ZMIXF=0.1
+
+ZKIC_INIT=0.1 ! starting value for critical mixed fraction for CLoudy Part
+
+! Compute thetaV of environment at the bottom of cloudy part
+! and cons then non cons. var. of mixture at the bottom of cloudy part
+
+! JKLIM computed to avoid KKL(KK-KKL) being < KKL*KKB
+JKLIM=KKL*MAX(KKL*(KK-KKL),KKL*KKB)
+DO JI=D%NIB,D%NIE
+ IF(OTEST(JI) .AND. PPART_DRY(JI)>0.5) THEN
+ ZDZ=ZDZ_STOP(JI)-0.5*(PZZ(JI,KK+KKL)-PZZ(JI,KK))
+ ZTHV(JI)= PTHVM(JI,KK)+ZCOEFF_PLUS_HALF(JI)*ZDZ
+ ZMIXTHL(JI) = ZKIC_INIT * &
+ (PTHLM(JI,KK)+ZDZ*(PTHLM(JI,KK+KKL)-PTHLM(JI,KK))/PDZZ(JI,KK+KKL)) + &
+ (1. - ZKIC_INIT)*PTHL_UP(JI)
+ ZMIXRT(JI) = ZKIC_INIT * &
+ (PRTM(JI,KK)+ZDZ*(PRTM(JI,KK+KKL)-PRTM(JI,KK))/PDZZ(JI,KK+KKL)) + &
+ (1. - ZKIC_INIT)*PRT_UP(JI)
+ ELSEIF(OTEST(JI)) THEN
+ ZDZ=0.5*(PZZ(JI,KK+KKL)-PZZ(JI,KK))-ZDZ_STOP(JI)
+ ZTHV(JI)= PTHVM(JI,KK)-ZCOEFF_MINUS_HALF(JI)*ZDZ
+ ZMIXTHL(JI) = ZKIC_INIT * &
+ (PTHLM(JI,KK)-ZDZ*(PTHLM(JI,KK)-PTHLM(JI,JKLIM))/PDZZ(JI,KK)) + &
+ (1. - ZKIC_INIT)*PTHL_UP(JI)
+ ZMIXRT(JI) = ZKIC_INIT * &
+ (PRTM(JI,KK)-ZDZ*(PRTM(JI,KK)-PRTM(JI,JKLIM))/PDZZ(JI,KK)) + &
+ (1. - ZKIC_INIT)*PRT_UP(JI)
+ ELSE
+#ifdef REPRO55
+ ZMIXTHL(JI) = 0.1
+#else
+ ZMIXTHL(JI) = 300.
+#endif
+ ZMIXRT(JI) = 0.1
+ ENDIF
+ENDDO
+CALL TH_R_FROM_THL_RT(CST,NEB,D%NIT,HFRAC_ICE,ZFRAC_ICE,&
+ ZPRE,ZMIXTHL,ZMIXRT,&
+ ZTHMIX,ZRVMIX,PRC_MIX,PRI_MIX,&
+ ZRSATW_ED, ZRSATI_ED,OOCEAN=.FALSE.,&
+ PBUF=ZBUF, KB=D%NIB, KE=D%NIE)
+!$mnh_expand_array(JI=D%NIB:D%NIE)
+ZTHVMIX(D%NIB:D%NIE) = ZTHMIX(D%NIB:D%NIE)*(1.+ZRVORD*ZRVMIX(D%NIB:D%NIE))/(1.+ZMIXRT(D%NIB:D%NIE))
+
+! Compute cons then non cons. var. of mixture at the flux level KK+KKL with initial ZKIC
+ZMIXTHL(D%NIB:D%NIE) = ZKIC_INIT * 0.5*(PTHLM(D%NIB:D%NIE,KK)+PTHLM(D%NIB:D%NIE,KK+KKL))+(1. - ZKIC_INIT)*PTHL_UP(D%NIB:D%NIE)
+ZMIXRT(D%NIB:D%NIE) = ZKIC_INIT * 0.5*(PRTM(D%NIB:D%NIE,KK)+PRTM(D%NIB:D%NIE,KK+KKL))+(1. - ZKIC_INIT)*PRT_UP(D%NIB:D%NIE)
+!$mnh_end_expand_array(JI=D%NIB:D%NIE)
+CALL TH_R_FROM_THL_RT(CST,NEB,D%NIT,HFRAC_ICE,ZFRAC_ICE,&
+ PPRE_PLUS_HALF,ZMIXTHL,ZMIXRT,&
+ ZTHMIX,ZRVMIX,PRC_MIX,PRI_MIX,&
+ ZRSATW_ED, ZRSATI_ED,OOCEAN=.FALSE.,&
+ PBUF=ZBUF, KB=D%NIB, KE=D%NIE)
+!$mnh_expand_array(JI=D%NIB:D%NIE)
+ZTHVMIX_F2(D%NIB:D%NIE) = ZTHMIX(D%NIB:D%NIE)*(1.+ZRVORD*ZRVMIX(D%NIB:D%NIE))/(1.+ZMIXRT(D%NIB:D%NIE))
+!$mnh_end_expand_array(JI=D%NIB:D%NIE)
+
+!Computation of mean ZKIC over the cloudy part
+DO JI=D%NIB,D%NIE
+ IF (OTEST(JI)) THEN
+ ! Compute ZKIC at the bottom of cloudy part
+ ! Thetav_up at bottom is equal to Thetav_up at flux level KK
+ IF (ABS(PTHV_UP(JI)-ZTHVMIX(JI))<1.E-10) THEN
+ ZKIC(JI)=1.
+ ELSE
+ ZKIC(JI) = MAX(0.,PTHV_UP(JI)-ZTHV(JI))*ZKIC_INIT / &
+ (PTHV_UP(JI)-ZTHVMIX(JI))
+ END IF
+ ! Compute ZKIC_F2 at flux level KK+KKL
+ IF (ABS(ZTHV_UP_F2(JI)-ZTHVMIX_F2(JI))<1.E-10) THEN
+ ZKIC_F2(JI)=1.
+ ELSE
+ ZKIC_F2(JI) = MAX(0.,ZTHV_UP_F2(JI)-ZTHV_PLUS_HALF(JI))*ZKIC_INIT / &
+ (ZTHV_UP_F2(JI)-ZTHVMIX_F2(JI))
+ END IF
+ !Mean ZKIC over the cloudy part
+ ZKIC(JI)=MAX(MIN(0.5*(ZKIC(JI)+ZKIC_F2(JI)),1.),0.)
+ END IF
+END DO
+
+! 3.3 Integration of PDF
+! According to Kain and Fritsch (1990), we replace delta Mt
+! in eq. (7) and (8) using eq. (5). Here we compute the ratio
+! of integrals without computing delta Me
+
+!Constant PDF
+!For this PDF, eq. (5) is delta Me=0.5*delta Mt
+DO JI=D%NIB,D%NIE
+ IF(OTEST(JI)) THEN
+ ZEPSI(JI) = ZKIC(JI)**2. !integration multiplied by 2
+ ZDELTA(JI) = (1.-ZKIC(JI))**2. !idem
+ ENDIF
+ENDDO
+
+!Triangular PDF
+!Calculus must be verified before activating this part, but in this state,
+!results on ARM case are almost identical
+!For this PDF, eq. (5) is also delta Me=0.5*delta Mt
+!WHERE(OTEST(D%NIB:D%NIE))
+! !Integration multiplied by 2
+! WHERE(ZKIC<0.5)
+! ZEPSI(D%NIB:D%NIE)=8.*ZKIC(D%NIB:D%NIE)**3/3.
+! ZDELTA(D%NIB:D%NIE)=1.-4.*ZKIC(D%NIB:D%NIE)**2+8.*ZKIC(D%NIB:D%NIE)**3/3.
+! ELSEWHERE
+! ZEPSI(D%NIB:D%NIE)=5./3.-4*ZKIC(D%NIB:D%NIE)**2+8.*ZKIC(D%NIB:D%NIE)**3/3.
+! ZDELTA(D%NIB:D%NIE)=8.*(1.-ZKIC(D%NIB:D%NIE))**3/3.
+! ENDWHERE
+!ENDWHERE
+
+! 3.4 Computation of PENTR and PDETR
+DO JI=D%NIB,D%NIE
+ IF(OTEST(JI)) THEN
+ ZEPSI_CLOUD=MIN(ZDELTA(JI), ZEPSI(JI))
+ PENTR_CLD(JI) = (1.-PPART_DRY(JI))*ZCOEFFMF_CLOUD*PRHODREF(JI)*ZEPSI_CLOUD
+ PDETR_CLD(JI) = (1.-PPART_DRY(JI))*ZCOEFFMF_CLOUD*PRHODREF(JI)*ZDELTA(JI)
+ PENTR(JI) = PENTR(JI)+PENTR_CLD(JI)
+ PDETR(JI) = PDETR(JI)+PDETR_CLD(JI)
+ ELSE
+ PENTR_CLD(JI) = 0.
+ PDETR_CLD(JI) = 0.
+ ENDIF
+ENDDO
+
+END SUBROUTINE COMPUTE_ENTR_DETR
END SUBROUTINE COMPUTE_UPDRAFT
END MODULE MODE_COMPUTE_UPDRAFT
+
diff --git a/src/common/turb/mode_compute_updraft_raha.F90 b/src/common/turb/mode_compute_updraft_raha.F90
index 41414ea157c7fd1d5772da28eca198bb52ce4991..bb1dc222569a9a1e3d2c3154c15ee5f00c17ea88 100644
--- a/src/common/turb/mode_compute_updraft_raha.F90
+++ b/src/common/turb/mode_compute_updraft_raha.F90
@@ -9,8 +9,8 @@
!
IMPLICIT NONE
CONTAINS
- SUBROUTINE COMPUTE_UPDRAFT_RAHA(KKA,KKB,KKE,KKU,KKL,HFRAC_ICE, &
- OENTR_DETR,OMIXUV, &
+ SUBROUTINE COMPUTE_UPDRAFT_RAHA(D, CST, NEB, PARAMMF, &
+ KSV, HFRAC_ICE, OENTR_DETR, OMIXUV, &
ONOMIXLG,KSV_LGBEG,KSV_LGEND, &
PZZ,PDZZ, &
PSFTH,PSFRV, &
@@ -58,11 +58,11 @@ CONTAINS
!
!* 0. DECLARATIONS
! ------------
-
-USE MODD_CST
-USE MODD_PARAM_MFSHALL_n
-
-USE MODE_TH_R_FROM_THL_RT_1D, ONLY: TH_R_FROM_THL_RT_1D
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+USE MODD_CST, ONLY: CST_t
+USE MODD_NEB, ONLY: NEB_t
+USE MODD_PARAM_MFSHALL_n, ONLY: PARAM_MFSHALL_t
+!
USE MODI_SHUMAN_MF, ONLY: MZM_MF
!
USE PARKIND1, ONLY : JPRB
@@ -74,120 +74,119 @@ IMPLICIT NONE
!
!
!
-INTEGER, INTENT(IN) :: KKA ! near ground array index
-INTEGER, INTENT(IN) :: KKB ! near ground physical index
-INTEGER, INTENT(IN) :: KKE ! uppest atmosphere physical index
-INTEGER, INTENT(IN) :: KKU ! uppest atmosphere array index
-INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+TYPE(CST_t), INTENT(IN) :: CST
+TYPE(NEB_t), INTENT(IN) :: NEB
+TYPE(PARAM_MFSHALL_t), INTENT(IN) :: PARAMMF
+INTEGER, INTENT(IN) :: KSV
CHARACTER(LEN=1), INTENT(IN) :: HFRAC_ICE ! partition liquid/ice scheme
LOGICAL, INTENT(IN) :: OENTR_DETR! flag to recompute entrainment, detrainment and mass flux
LOGICAL, INTENT(IN) :: OMIXUV ! True if mixing of momentum
LOGICAL, INTENT(IN) :: ONOMIXLG ! False if mixing of lagrangian tracer
INTEGER, INTENT(IN) :: KSV_LGBEG ! first index of lag. tracer
INTEGER, INTENT(IN) :: KSV_LGEND ! last index of lag. tracer
-REAL, DIMENSION(:,:), INTENT(IN) :: PZZ ! Height at the flux point
-REAL, DIMENSION(:,:), INTENT(IN) :: PDZZ ! Metrics coefficient
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(IN) :: PZZ ! Height at the flux point
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(IN) :: PDZZ ! Metrics coefficient
-REAL, DIMENSION(:), INTENT(IN) :: PSFTH,PSFRV
+REAL, DIMENSION(D%NIT), INTENT(IN) :: PSFTH,PSFRV
! normal surface fluxes of theta,rv,(u,v) parallel to the orography
!
-REAL, DIMENSION(:,:), INTENT(IN) :: PPABSM ! Pressure at t-dt
-REAL, DIMENSION(:,:), INTENT(IN) :: PRHODREF ! dry density of the
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(IN) :: PPABSM ! Pressure at t-dt
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(IN) :: PRHODREF ! dry density of the
! reference state
-REAL, DIMENSION(:,:), INTENT(IN) :: PUM ! u mean wind
-REAL, DIMENSION(:,:), INTENT(IN) :: PVM ! v mean wind
-REAL, DIMENSION(:,:), INTENT(IN) :: PTKEM ! TKE at t-dt
-
-REAL, DIMENSION(:,:), INTENT(IN) :: PEXNM ! Exner function at t-dt
-REAL, DIMENSION(:,:), INTENT(IN) :: PTHM ! liquid pot. temp. at t-dt
-REAL, DIMENSION(:,:), INTENT(IN) :: PRVM ! vapor mixing ratio at t-dt
-REAL, DIMENSION(:,:), INTENT(IN) :: PTHLM,PRTM ! cons. var. at t-dt
-
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSVM ! scalar var. at t-dt
-
-REAL, DIMENSION(:,:), INTENT(OUT) :: PTHL_UP,PRT_UP ! updraft properties
-REAL, DIMENSION(:,:), INTENT(OUT) :: PU_UP, PV_UP ! updraft wind components
-REAL, DIMENSION(:,:), INTENT(INOUT):: PRV_UP,PRC_UP ! updraft rv, rc
-REAL, DIMENSION(:,:), INTENT(INOUT):: PRI_UP,PTHV_UP ! updraft ri, THv
-REAL, DIMENSION(:,:), INTENT(INOUT):: PW_UP,PFRAC_UP ! updraft w, fraction
-REAL, DIMENSION(:,:), INTENT(INOUT):: PFRAC_ICE_UP ! liquid/solid fraction in updraft
-REAL, DIMENSION(:,:), INTENT(INOUT):: PRSAT_UP ! Rsat
-
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSV_UP ! updraft scalar var.
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(IN) :: PUM ! u mean wind
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(IN) :: PVM ! v mean wind
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(IN) :: PTKEM ! TKE at t-dt
+
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(IN) :: PEXNM ! Exner function at t-dt
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(IN) :: PTHM ! liquid pot. temp. at t-dt
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(IN) :: PRVM ! vapor mixing ratio at t-dt
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(IN) :: PTHLM,PRTM ! cons. var. at t-dt
+
+REAL, DIMENSION(D%NIT,D%NKT,KSV), INTENT(IN) :: PSVM ! scalar var. at t-dt
+
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(OUT) :: PTHL_UP,PRT_UP ! updraft properties
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(OUT) :: PU_UP, PV_UP ! updraft wind components
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(INOUT):: PRV_UP,PRC_UP ! updraft rv, rc
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(INOUT):: PRI_UP,PTHV_UP ! updraft ri, THv
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(INOUT):: PW_UP,PFRAC_UP ! updraft w, fraction
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(INOUT):: PFRAC_ICE_UP ! liquid/solid fraction in updraft
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(INOUT):: PRSAT_UP ! Rsat
+
+REAL, DIMENSION(D%NIT,D%NKT,KSV), INTENT(OUT) :: PSV_UP ! updraft scalar var.
-REAL, DIMENSION(:,:), INTENT(INOUT):: PEMF,PDETR,PENTR ! Mass_flux,
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(INOUT):: PEMF,PDETR,PENTR ! Mass_flux,
! detrainment,entrainment
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PBUO_INTEG ! Integrated Buoyancy
-INTEGER, DIMENSION(:), INTENT(INOUT):: KKLCL,KKETL,KKCTL! LCL, ETL, CTL
-REAL, DIMENSION(:), INTENT(OUT) :: PDEPTH ! Deepness of cloud
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(INOUT) :: PBUO_INTEG ! Integrated Buoyancy
+INTEGER, DIMENSION(D%NIT), INTENT(INOUT):: KKLCL,KKETL,KKCTL! LCL, ETL, CTL
+REAL, DIMENSION(D%NIT), INTENT(OUT) :: PDEPTH ! Deepness of cloud
! 1.2 Declaration of local variables
!
!
! Mean environment variables at t-dt at flux point
-REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZTHM_F,ZRVM_F,ZRCM_F ! Theta,rv of
+REAL, DIMENSION(D%NIT,D%NKT) :: ZTHM_F,ZRVM_F,ZRCM_F ! Theta,rv of
! updraft environnement
-REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZRTM_F, ZTHLM_F, ZTKEM_F ! rt, thetal,TKE,pressure,
-REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZUM_F,ZVM_F,ZRHO_F ! density,momentum
-REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZPRES_F,ZTHVM_F,ZTHVM ! interpolated at the flux point
-REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZG_O_THVREF ! g*ThetaV ref
-REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZW_UP2 ! w**2 of the updraft
+REAL, DIMENSION(D%NIT,D%NKT) :: ZRTM_F, ZTHLM_F, ZTKEM_F ! rt, thetal,TKE,pressure,
+REAL, DIMENSION(D%NIT,D%NKT) :: ZUM_F,ZVM_F,ZRHO_F ! density,momentum
+REAL, DIMENSION(D%NIT,D%NKT) :: ZPRES_F,ZTHVM_F,ZTHVM ! interpolated at the flux point
+REAL, DIMENSION(D%NIT,D%NKT) :: ZG_O_THVREF ! g*ThetaV ref
+REAL, DIMENSION(D%NIT,D%NKT) :: ZW_UP2 ! w**2 of the updraft
-REAL, DIMENSION(SIZE(PSVM,1),SIZE(PTHM,2),SIZE(PSVM,3)) :: ZSVM_F ! scalar variables
+REAL, DIMENSION(D%NIT,D%NKT,KSV) :: ZSVM_F ! scalar variables
-REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZTH_UP ! updraft THETA
-REAL, DIMENSION(SIZE(PTHM,1)) :: ZT_UP ! updraft T
-REAL, DIMENSION(SIZE(PTHM,1)) :: ZLVOCPEXN ! updraft L
-REAL, DIMENSION(SIZE(PTHM,1)) :: ZCP ! updraft cp
-REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZBUO ! Buoyancy
-REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZTHS_UP,ZTHSM
-
-REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZCOEF ! diminution coefficient for too high clouds
+REAL, DIMENSION(D%NIT,D%NKT) :: ZTH_UP ! updraft THETA
+REAL, DIMENSION(D%NIT) :: ZT_UP ! updraft T
+REAL, DIMENSION(D%NIT) :: ZLVOCPEXN ! updraft L
+REAL, DIMENSION(D%NIT) :: ZCP ! updraft cp
+REAL, DIMENSION(D%NIT,D%NKT) :: ZBUO ! Buoyancy
+REAL, DIMENSION(D%NIT,D%NKT) :: ZTHS_UP,ZTHSM
+
+REAL, DIMENSION(D%NIT,D%NKT) :: ZCOEF ! diminution coefficient for too high clouds
-REAL, DIMENSION(SIZE(PSFTH,1) ) :: ZWTHVSURF ! Surface w'thetav'
+REAL, DIMENSION(D%NIT) :: ZWTHVSURF ! Surface w'thetav'
REAL :: ZRDORV ! RD/RV
REAL :: ZRVORD ! RV/RD
-REAL, DIMENSION(SIZE(PTHM,1)) :: ZMIX1,ZMIX2,ZMIX3
+REAL, DIMENSION(D%NIT) :: ZMIX1,ZMIX2,ZMIX3
-REAL, DIMENSION(SIZE(PTHM,1)) :: ZLUP ! Upward Mixing length from the ground
+REAL, DIMENSION(D%NIT) :: ZLUP ! Upward Mixing length from the ground
-REAL, DIMENSION(SIZE(PTHM,1)) :: ZDEPTH ! Deepness limit for cloud
+REAL, DIMENSION(D%NIT) :: ZDEPTH ! Deepness limit for cloud
-INTEGER :: ISV ! Number of scalar variables
-INTEGER :: IKU,IIJU ! array size in k
INTEGER :: JK,JI,JJ,JSV ! loop counters
-LOGICAL, DIMENSION(SIZE(PTHM,1)) :: GTEST,GTESTLCL,GTESTETL
+LOGICAL, DIMENSION(D%NIT) :: GTEST,GTESTLCL,GTESTETL
! Test if the ascent continue, if LCL or ETL is reached
LOGICAL :: GLMIX
! To choose upward or downward mixing length
-LOGICAL, DIMENSION(SIZE(PTHM,1)) :: GWORK1
-LOGICAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: GWORK2
+LOGICAL, DIMENSION(D%NIT) :: GWORK1
+LOGICAL, DIMENSION(D%NIT,D%NKT) :: GWORK2
INTEGER :: ITEST
-REAL, DIMENSION(SIZE(PTHM,1)) :: ZRC_UP, ZRI_UP, ZRV_UP, ZWP2, ZRSATW, ZRSATI
+REAL, DIMENSION(D%NIT) :: ZRC_UP, ZRI_UP, ZRV_UP, ZWP2, ZRSATW, ZRSATI
-LOGICAL, DIMENSION(SIZE(PTHM,1)) :: GTEST_FER
-REAL, DIMENSION(SIZE(PTHM,1)) :: ZPHI,ZALIM_STAR_TOT
-REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZDTHETASDZ,ZALIM_STAR,ZZDZ,ZZZ
-INTEGER, DIMENSION(SIZE(PTHM,1)) :: IALIM
+LOGICAL, DIMENSION(D%NIT) :: GTEST_FER
+REAL, DIMENSION(D%NIT) :: ZPHI,ZALIM_STAR_TOT
+REAL, DIMENSION(D%NIT,D%NKT) :: ZDTHETASDZ,ZALIM_STAR,ZZDZ,ZZZ
+INTEGER, DIMENSION(D%NIT) :: IALIM
-REAL, DIMENSION(SIZE(PTHM,1)) :: ZTEST,ZDZ,ZWUP_MEAN !
-REAL, DIMENSION(SIZE(PTHM,1)) :: ZCOE,ZWCOE,ZBUCOE
-REAL, DIMENSION(SIZE(PTHM,1)) :: ZDETR_BUO, ZDETR_RT
-REAL, DIMENSION(SIZE(PTHM,1)) :: ZW_MAX ! w**2 max of the updraft
-REAL, DIMENSION(SIZE(PTHM,1)) :: ZZTOP ! Top of the updraft
-REAL, DIMENSION(SIZE(PTHM,1)) :: ZA,ZB,ZQTM,ZQT_UP
+REAL, DIMENSION(D%NIT) :: ZTEST,ZDZ,ZWUP_MEAN !
+REAL, DIMENSION(D%NIT) :: ZCOE,ZWCOE,ZBUCOE
+REAL, DIMENSION(D%NIT) :: ZDETR_BUO, ZDETR_RT
+REAL, DIMENSION(D%NIT) :: ZW_MAX ! w**2 max of the updraft
+REAL, DIMENSION(D%NIT) :: ZZTOP ! Top of the updraft
+REAL, DIMENSION(D%NIT) :: ZA,ZB,ZQTM,ZQT_UP
REAL :: ZDEPTH_MAX1, ZDEPTH_MAX2 ! control auto-extinction process
REAL :: ZTMAX,ZRMAX, ZEPS ! control value
+REAL, DIMENSION(D%NIT,16) :: ZBUF
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('COMPUTE_UPDRAF_RAHA',0,ZHOOK_HANDLE)
@@ -202,24 +201,17 @@ ZEPS=1.E-15
! INITIALISATION
! Initialisation of the constants
-ZRDORV = XRD / XRV !=0.622
-ZRVORD = (XRV / XRD)
+ZRDORV = CST%XRD / CST%XRV !=0.622
+ZRVORD = (CST%XRV / CST%XRD)
ZDEPTH_MAX1=4500. ! clouds with depth infeRIOr to this value are keeped untouched
ZDEPTH_MAX2=5000. ! clouds with depth superior to this value are suppressed
! Local variables, internal domain
-! Internal Domain
-
-IKU=SIZE(PTHM,2)
-IIJU =SIZE(PTHM,1)
-!number of scalar variables
-ISV=SIZE(PSVM,3)
-
! Initialisation of intersesting Level :LCL,ETL,CTL
-KKLCL(:)=KKE
-KKETL(:)=KKE
-KKCTL(:)=KKE
+KKLCL(:)=D%NKE
+KKETL(:)=D%NKE
+KKCTL(:)=D%NKE
!
! Initialisation
@@ -238,107 +230,129 @@ ZTH_UP(:,:)=0.
PFRAC_UP(:,:)=0.
PTHV_UP(:,:)=0.
-PBUO_INTEG=0.
-ZBUO =0.
+PBUO_INTEG(:,:)=0.
+ZBUO(:,:) =0.
!no ice cloud coded yet
PRI_UP(:,:)=0.
PFRAC_ICE_UP(:,:)=0.
-PRSAT_UP(:,:)=PRVM(:,:) ! should be initialised correctly but is (normaly) not used
+!$mnh_expand_array(JI=D%NIB:D%NIE,JK=1:D%NKT)
+PRSAT_UP(D%NIB:D%NIE,:)=PRVM(D%NIB:D%NIE,:) ! should be initialised correctly but is (normaly) not used
+!$mnh_end_expand_array(JI=D%NIB:D%NIE,JK=1:D%NKT)
! Initialisation of environment variables at t-dt
! variables at flux level
-ZTHLM_F(:,:) = MZM_MF(PTHLM(:,:), KKA, KKU, KKL)
-ZRTM_F (:,:) = MZM_MF(PRTM(:,:), KKA, KKU, KKL)
-ZUM_F (:,:) = MZM_MF(PUM(:,:), KKA, KKU, KKL)
-ZVM_F (:,:) = MZM_MF(PVM(:,:), KKA, KKU, KKL)
-ZTKEM_F(:,:) = MZM_MF(PTKEM(:,:), KKA, KKU, KKL)
+CALL MZM_MF(D, PTHLM(:,:), ZTHLM_F(:,:))
+CALL MZM_MF(D, PRTM(:,:), ZRTM_F(:,:))
+CALL MZM_MF(D, PUM(:,:), ZUM_F(:,:))
+CALL MZM_MF(D, PVM(:,:), ZVM_F(:,:))
+CALL MZM_MF(D, PTKEM(:,:), ZTKEM_F(:,:))
!DO JSV=1,ISV
! IF (ONOMIXLG .AND. JSV >= KSV_LGBEG .AND. JSV<= KSV_LGEND) CYCLE
-! ZSVM_F(:,KKB:IKU,JSV) = 0.5*(PSVM(:,KKB:IKU,JSV)+PSVM(:,1:IKU-1,JSV))
-! ZSVM_F(:,1,JSV) = ZSVM_F(:,KKB,JSV)
+! ZSVM_F(D%NIB:D%NIE,KKB:IKU,JSV) = 0.5*(PSVM(D%NIB:D%NIE,KKB:IKU,JSV)+PSVM(D%NIB:D%NIE,1:IKU-1,JSV))
+! ZSVM_F(D%NIB:D%NIE,1,JSV) = ZSVM_F(D%NIB:D%NIE,KKB,JSV)
!END DO
! Initialisation of updraft characteristics
-PTHL_UP(:,:)=ZTHLM_F(:,:)
-PRT_UP(:,:)=ZRTM_F(:,:)
-PU_UP(:,:)=ZUM_F(:,:)
-PV_UP(:,:)=ZVM_F(:,:)
+!$mnh_expand_array(JI=D%NIB:D%NIE,JK=1:D%NKT)
+PTHL_UP(D%NIB:D%NIE,:)=ZTHLM_F(D%NIB:D%NIE,:)
+PRT_UP(D%NIB:D%NIE,:)=ZRTM_F(D%NIB:D%NIE,:)
+PU_UP(D%NIB:D%NIE,:)=ZUM_F(D%NIB:D%NIE,:)
+PV_UP(D%NIB:D%NIE,:)=ZVM_F(D%NIB:D%NIE,:)
+!$mnh_end_expand_array(JI=D%NIB:D%NIE,JK=1:D%NKT)
PSV_UP(:,:,:)=0.
!IF (ONOMIXLG .AND. JSV >= KSV_LGBEG .AND. JSV<= KSV_LGEND) then
-! PSV_UP(:,:,:)=ZSVM_F(:,:,:)
+! PSV_UP(D%NIB:D%NIE,:,:)=ZSVM_F(D%NIB:D%NIE,:,:)
!ENDIF
! Computation or initialisation of updraft characteristics at the KKB level
! thetal_up,rt_up,thetaV_up, w�,Buoyancy term and mass flux (PEMF)
-PTHL_UP(:,KKB)= ZTHLM_F(:,KKB)+MAX(0.,MIN(ZTMAX,(PSFTH(:)/SQRT(ZTKEM_F(:,KKB)))*XALP_PERT))
-PRT_UP(:,KKB) = ZRTM_F(:,KKB)+MAX(0.,MIN(ZRMAX,(PSFRV(:)/SQRT(ZTKEM_F(:,KKB)))*XALP_PERT))
+!$mnh_expand_array(JI=D%NIB:D%NIE)
+PTHL_UP(D%NIB:D%NIE,D%NKB)= ZTHLM_F(D%NIB:D%NIE,D%NKB)+ &
+ & MAX(0.,MIN(ZTMAX,(PSFTH(D%NIB:D%NIE)/SQRT(ZTKEM_F(D%NIB:D%NIE,D%NKB)))*PARAMMF%XALP_PERT))
+PRT_UP(D%NIB:D%NIE,D%NKB) = ZRTM_F(D%NIB:D%NIE,D%NKB)+ &
+ & MAX(0.,MIN(ZRMAX,(PSFRV(D%NIB:D%NIE)/SQRT(ZTKEM_F(D%NIB:D%NIE,D%NKB)))*PARAMMF%XALP_PERT))
-ZQT_UP(:) = PRT_UP(:,KKB)/(1.+PRT_UP(:,KKB))
-ZTHS_UP(:,KKB)=PTHL_UP(:,KKB)*(1.+XLAMBDA_MF*ZQT_UP(:))
+ZQT_UP(D%NIB:D%NIE) = PRT_UP(D%NIB:D%NIE,D%NKB)/(1.+PRT_UP(D%NIB:D%NIE,D%NKB))
+ZTHS_UP(D%NIB:D%NIE,D%NKB)=PTHL_UP(D%NIB:D%NIE,D%NKB)*(1.+PARAMMF%XLAMBDA_MF*ZQT_UP(D%NIB:D%NIE))
+!$mnh_end_expand_array(JI=D%NIB:D%NIE)
-ZTHM_F (:,:) = MZM_MF(PTHM (:,:), KKA, KKU, KKL)
-ZPRES_F(:,:) = MZM_MF(PPABSM(:,:), KKA, KKU, KKL)
-ZRHO_F (:,:) = MZM_MF(PRHODREF(:,:), KKA, KKU, KKL)
-ZRVM_F (:,:) = MZM_MF(PRVM(:,:), KKA, KKU, KKL)
+CALL MZM_MF(D, PTHM (:,:), ZTHM_F(:,:))
+CALL MZM_MF(D, PPABSM(:,:), ZPRES_F(:,:))
+CALL MZM_MF(D, PRHODREF(:,:), ZRHO_F(:,:))
+CALL MZM_MF(D, PRVM(:,:), ZRVM_F(:,:))
+!$mnh_expand_array(JI=D%NIB:D%NIE,JK=1:D%NKT)
! thetav at mass and flux levels
-ZTHVM_F(:,:)=ZTHM_F(:,:)*((1.+ZRVORD*ZRVM_F(:,:))/(1.+ZRTM_F(:,:)))
-ZTHVM(:,:)=PTHM(:,:)*((1.+ZRVORD*PRVM(:,:))/(1.+PRTM(:,:)))
+ZTHVM_F(D%NIB:D%NIE,:)=ZTHM_F(D%NIB:D%NIE,:)*((1.+ZRVORD*ZRVM_F(D%NIB:D%NIE,:))/(1.+ZRTM_F(D%NIB:D%NIE,:)))
+ZTHVM(D%NIB:D%NIE,:)=PTHM(D%NIB:D%NIE,:)*((1.+ZRVORD*PRVM(D%NIB:D%NIE,:))/(1.+PRTM(D%NIB:D%NIE,:)))
-PTHV_UP(:,:)= ZTHVM_F(:,:)
-PRV_UP (:,:)= ZRVM_F (:,:)
+PTHV_UP(D%NIB:D%NIE,:)= ZTHVM_F(D%NIB:D%NIE,:)
+PRV_UP(D%NIB:D%NIE,:) = ZRVM_F(D%NIB:D%NIE,:)
+!$mnh_end_expand_array(JI=D%NIB:D%NIE,JK=1:D%NKT)
ZW_UP2(:,:)=ZEPS
-ZW_UP2(:,KKB) = MAX(0.0001,(1./6.)*ZTKEM_F(:,KKB))
-GTEST = (ZW_UP2(:,KKB) > ZEPS)
+!$mnh_expand_array(JI=D%NIB:D%NIE)
+ZW_UP2(D%NIB:D%NIE,D%NKB) = MAX(0.0001,(1./6.)*ZTKEM_F(D%NIB:D%NIE,D%NKB))
+GTEST(D%NIB:D%NIE) = (ZW_UP2(D%NIB:D%NIE,D%NKB) > ZEPS)
+!$mnh_end_expand_array(JI=D%NIB:D%NIE)
! Computation of non conservative variable for the KKB level of the updraft
! (all or nothing ajustement)
-PRC_UP(:,KKB)=0.
-PRI_UP(:,KKB)=0.
+!$mnh_expand_array(JI=D%NIB:D%NIE)
+PRC_UP(D%NIB:D%NIE,D%NKB)=0.
+PRI_UP(D%NIB:D%NIE,D%NKB)=0.
+!$mnh_end_expand_array(JI=D%NIB:D%NIE)
-CALL TH_R_FROM_THL_RT_1D(HFRAC_ICE,PFRAC_ICE_UP(:,KKB),ZPRES_F(:,KKB), &
- PTHL_UP(:,KKB),PRT_UP(:,KKB),ZTH_UP(:,KKB), &
- PRV_UP(:,KKB),PRC_UP(:,KKB),PRI_UP(:,KKB),ZRSATW(:),ZRSATI(:),OOCEAN=.FALSE.)
+CALL TH_R_FROM_THL_RT(CST, NEB, D%NIT, HFRAC_ICE,PFRAC_ICE_UP(:,D%NKB),ZPRES_F(:,D%NKB), &
+ PTHL_UP(:,D%NKB),PRT_UP(:,D%NKB),ZTH_UP(:,D%NKB), &
+ PRV_UP(:,D%NKB),PRC_UP(:,D%NKB),PRI_UP(:,D%NKB),ZRSATW(:),ZRSATI(:),OOCEAN=.FALSE.,&
+ PBUF=ZBUF, KB=D%NIB, KE=D%NIE)
+!$mnh_expand_array(JI=D%NIB:D%NIE)
! compute updraft thevav and buoyancy term at KKB level
-PTHV_UP(:,KKB) = ZTH_UP(:,KKB)*((1+ZRVORD*PRV_UP(:,KKB))/(1+PRT_UP(:,KKB)))
+PTHV_UP(D%NIB:D%NIE,D%NKB) = ZTH_UP(D%NIB:D%NIE,D%NKB)*((1+ZRVORD*PRV_UP(D%NIB:D%NIE,D%NKB))/(1+PRT_UP(D%NIB:D%NIE,D%NKB)))
! compute mean rsat in updraft
-PRSAT_UP(:,KKB) = ZRSATW(:)*(1-PFRAC_ICE_UP(:,KKB)) + ZRSATI(:)*PFRAC_ICE_UP(:,KKB)
+PRSAT_UP(D%NIB:D%NIE,D%NKB) = ZRSATW(D%NIB:D%NIE)*(1-PFRAC_ICE_UP(D%NIB:D%NIE,D%NKB)) + &
+ & ZRSATI(D%NIB:D%NIE)*PFRAC_ICE_UP(D%NIB:D%NIE,D%NKB)
+!$mnh_end_expand_array(JI=D%NIB:D%NIE)
!Tout est commente pour tester dans un premier temps la s�paration en deux de la
! boucle verticale, une pour w et une pour PEMF
-
-ZG_O_THVREF=XG/ZTHVM_F
-
+!$mnh_expand_array(JI=D%NIB:D%NIE,JK=1:D%NKT)
+ZG_O_THVREF(D%NIB:D%NIE,:)=CST%XG/ZTHVM_F(D%NIB:D%NIE,:)
+!$mnh_end_expand_array(JI=D%NIB:D%NIE,JK=1:D%NKT)
! Definition de l'alimentation au sens de la fermeture de Hourdin et al
ZALIM_STAR(:,:) = 0.
ZALIM_STAR_TOT(:) = 0. ! <== Normalization of ZALIM_STAR
-IALIM(:) = KKB ! <== Top level of the alimentation layer
+IALIM(:) = D%NKB ! <== Top level of the alimentation layer
-DO JK=KKB,KKE-KKL,KKL ! Vertical loop
- ZZDZ(:,JK) = MAX(ZEPS,PZZ(:,JK+KKL)-PZZ(:,JK)) ! <== Delta Z between two flux level
- ZZZ(:,JK) = MAX(0.,0.5*(PZZ(:,JK+KKL)+PZZ(:,JK)) ) ! <== Hight of mass levels
- ZDTHETASDZ(:,JK) = (ZTHVM_F(:,JK)-ZTHVM_F(:,JK+KKL)) ! <== Delta theta_v
+DO JK=D%NKB,D%NKE-D%NKL,D%NKL ! Vertical loop
+ !$mnh_expand_where(JI=D%NIB:D%NIE)
+ ZZDZ(D%NIB:D%NIE,JK) = MAX(ZEPS,PZZ(D%NIB:D%NIE,JK+D%NKL)-PZZ(D%NIB:D%NIE,JK)) ! <== Delta Z between two flux level
+ ZZZ(D%NIB:D%NIE,JK) = MAX(0.,0.5*(PZZ(D%NIB:D%NIE,JK+D%NKL)+PZZ(D%NIB:D%NIE,JK)) ) ! <== Hight of mass levels
+ ZDTHETASDZ(D%NIB:D%NIE,JK) = (ZTHVM_F(D%NIB:D%NIE,JK)-ZTHVM_F(D%NIB:D%NIE,JK+D%NKL)) ! <== Delta theta_v
- WHERE ((ZTHVM_F(:,JK+KKL)<ZTHVM_F(:,JK)) .AND. (ZTHVM_F(:,KKB)>=ZTHVM_F(:,JK)))
- ZALIM_STAR(:,JK) = SQRT(ZZZ(:,JK))*ZDTHETASDZ(:,JK)/ZZDZ(:,JK)
- ZALIM_STAR_TOT(:) = ZALIM_STAR_TOT(:)+ZALIM_STAR(:,JK)*ZZDZ(:,JK)
- IALIM(:) = JK
+ WHERE ((ZTHVM_F(D%NIB:D%NIE,JK+D%NKL)<ZTHVM_F(D%NIB:D%NIE,JK)) .AND. (ZTHVM_F(D%NIB:D%NIE,D%NKB)>=ZTHVM_F(D%NIB:D%NIE,JK)))
+ ZALIM_STAR(D%NIB:D%NIE,JK) = SQRT(ZZZ(D%NIB:D%NIE,JK))*ZDTHETASDZ(D%NIB:D%NIE,JK)/ZZDZ(D%NIB:D%NIE,JK)
+ ZALIM_STAR_TOT(D%NIB:D%NIE) = ZALIM_STAR_TOT(D%NIB:D%NIE)+ZALIM_STAR(D%NIB:D%NIE,JK)*ZZDZ(D%NIB:D%NIE,JK)
+ IALIM(D%NIB:D%NIE) = JK
ENDWHERE
+ !$mnh_end_expand_where(JI=D%NIB:D%NIE)
ENDDO
! Normalization of ZALIM_STAR
-DO JK=KKB,KKE-KKL,KKL ! Vertical loop
- WHERE (ZALIM_STAR_TOT > ZEPS)
- ZALIM_STAR(:,JK) = ZALIM_STAR(:,JK)/ZALIM_STAR_TOT(:)
+DO JK=D%NKB,D%NKE-D%NKL,D%NKL ! Vertical loop
+ !$mnh_expand_where(JI=D%NIB:D%NIE)
+ WHERE (ZALIM_STAR_TOT(D%NIB:D%NIE) > ZEPS)
+ ZALIM_STAR(D%NIB:D%NIE,JK) = ZALIM_STAR(D%NIB:D%NIE,JK)/ZALIM_STAR_TOT(D%NIB:D%NIE)
ENDWHERE
+ !$mnh_end_expand_where(JI=D%NIB:D%NIE)
ENDDO
ZALIM_STAR_TOT(:) = 0.
@@ -364,214 +378,236 @@ ZZTOP(:) = 0.
ZPHI(:) = 0.
-DO JK=KKB,KKE-KKL,KKL
-
-! IF the updraft top is reached for all column, stop the loop on levels
+DO JK=D%NKB,D%NKE-D%NKL,D%NKL
+ !$mnh_expand_where(JI=D%NIB:D%NIE)
+ ! IF the updraft top is reached for all column, stop the loop on levels
-! ITEST=COUNT(GTEST)
-! IF (ITEST==0) CYCLE
+ !ITEST=COUNT(GTEST(D%NIB:D%NIE))
+ !IF (ITEST==0) CYCLE
-! Computation of entrainment and detrainment with KF90
-! parameterization in clouds and LR01 in subcloud layer
+ ! Computation of entrainment and detrainment with KF90
+ ! parameterization in clouds and LR01 in subcloud layer
-
-! to find the LCL (check if JK is LCL or not)
-
- WHERE ((PRC_UP(:,JK)+PRI_UP(:,JK)>0.).AND.(.NOT.(GTESTLCL)))
- KKLCL(:) = JK
- GTESTLCL(:)=.TRUE.
+ ! to find the LCL (check if JK is LCL or not)
+ WHERE ((PRC_UP(D%NIB:D%NIE,JK)+PRI_UP(D%NIB:D%NIE,JK)>0.).AND.(.NOT.(GTESTLCL(D%NIB:D%NIE))))
+ KKLCL(D%NIB:D%NIE) = JK
+ GTESTLCL(D%NIB:D%NIE)=.TRUE.
ENDWHERE
-
-! COMPUTE PENTR and PDETR at mass level JK
+ ! COMPUTE PENTR and PDETR at mass level JK
-! Buoyancy is computed on "flux" levels where updraft variables are known
+ ! Buoyancy is computed on "flux" levels where updraft variables are known
! Compute theta_v of updraft at flux level JK
- ZRC_UP(:) = PRC_UP(:,JK)
- ZRI_UP(:) = PRI_UP(:,JK) ! guess
- ZRV_UP(:) = PRV_UP(:,JK)
- ZBUO (:,JK) = ZG_O_THVREF(:,JK)*(PTHV_UP(:,JK) - ZTHVM_F(:,JK))
- PBUO_INTEG(:,JK) = ZBUO(:,JK)*(PZZ(:,JK+KKL)-PZZ(:,JK))
-
- ZDZ(:) = MAX(ZEPS,PZZ(:,JK+KKL)-PZZ(:,JK))
- ZTEST(:) = XA1*ZBUO(:,JK) - XB*ZW_UP2(:,JK)
+ ZRC_UP(D%NIB:D%NIE) = PRC_UP(D%NIB:D%NIE,JK)
+ ZRI_UP(D%NIB:D%NIE) = PRI_UP(D%NIB:D%NIE,JK) ! guess
+ ZRV_UP(D%NIB:D%NIE) = PRV_UP(D%NIB:D%NIE,JK)
+ ZBUO(D%NIB:D%NIE,JK) = ZG_O_THVREF(D%NIB:D%NIE,JK)*(PTHV_UP(D%NIB:D%NIE,JK) - ZTHVM_F(D%NIB:D%NIE,JK))
+ PBUO_INTEG(D%NIB:D%NIE,JK) = ZBUO(D%NIB:D%NIE,JK)*(PZZ(D%NIB:D%NIE,JK+D%NKL)-PZZ(D%NIB:D%NIE,JK))
+
+ ZDZ(D%NIB:D%NIE) = MAX(ZEPS,PZZ(D%NIB:D%NIE,JK+D%NKL)-PZZ(D%NIB:D%NIE,JK))
+ ZTEST(D%NIB:D%NIE) = PARAMMF%XA1*ZBUO(D%NIB:D%NIE,JK) - PARAMMF%XB*ZW_UP2(D%NIB:D%NIE,JK)
- ZCOE(:) = ZDZ(:)
- WHERE (ZTEST(:)>0.)
- ZCOE(:) = ZDZ(:)/(1.+ XBETA1)
- ENDWHERE
+ ZCOE(D%NIB:D%NIE) = ZDZ(D%NIB:D%NIE)
+ WHERE (ZTEST(D%NIB:D%NIE)>0.)
+ ZCOE(D%NIB:D%NIE) = ZDZ(D%NIB:D%NIE)/(1.+ PARAMMF%XBETA1)
+ ENDWHERE
-! Calcul de la vitesse
+ ! Calcul de la vitesse
- ZWCOE(:) = (1.-XB*ZCOE(:))/(1.+XB*ZCOE(:))
- ZBUCOE(:) = 2.*ZCOE(:)/(1.+XB*ZCOE(:))
-
- ZW_UP2(:,JK+KKL) = MAX(ZEPS,ZW_UP2(:,JK)*ZWCOE(:) + XA1*ZBUO(:,JK)*ZBUCOE(:) )
- ZW_MAX(:) = MAX(ZW_MAX(:), SQRT(ZW_UP2(:,JK+KKL)))
- ZWUP_MEAN(:) = MAX(ZEPS,0.5*(ZW_UP2(:,JK+KKL)+ZW_UP2(:,JK)))
-
-! Entrainement et detrainement
+ ZWCOE(D%NIB:D%NIE) = (1.-PARAMMF%XB*ZCOE(D%NIB:D%NIE))/(1.+PARAMMF%XB*ZCOE(D%NIB:D%NIE))
+ ZBUCOE(D%NIB:D%NIE) = 2.*ZCOE(D%NIB:D%NIE)/(1.+PARAMMF%XB*ZCOE(D%NIB:D%NIE))
- PENTR(:,JK) = MAX(0.,(XBETA1/(1.+XBETA1))*(XA1*ZBUO(:,JK)/ZWUP_MEAN(:)-XB))
-
- ZDETR_BUO(:) = MAX(0., -(XBETA1/(1.+XBETA1))*XA1*ZBUO(:,JK)/ZWUP_MEAN(:))
- ZDETR_RT(:) = XC*SQRT(MAX(0.,(PRT_UP(:,JK) - ZRTM_F(:,JK))) / MAX(ZEPS,ZRTM_F(:,JK)) / ZWUP_MEAN(:))
- PDETR(:,JK) = ZDETR_RT(:)+ZDETR_BUO(:)
+ ZW_UP2(D%NIB:D%NIE,JK+D%NKL) = MAX(ZEPS,ZW_UP2(D%NIB:D%NIE,JK)*ZWCOE(D%NIB:D%NIE) + &
+ &PARAMMF%XA1*ZBUO(D%NIB:D%NIE,JK)*ZBUCOE(D%NIB:D%NIE))
+ ZW_MAX(D%NIB:D%NIE) = MAX(ZW_MAX(D%NIB:D%NIE), SQRT(ZW_UP2(D%NIB:D%NIE,JK+D%NKL)))
+ ZWUP_MEAN(D%NIB:D%NIE) = MAX(ZEPS,0.5*(ZW_UP2(D%NIB:D%NIE,JK+D%NKL)+ZW_UP2(D%NIB:D%NIE,JK)))
+
+ ! Entrainement et detrainement
+
+ PENTR(D%NIB:D%NIE,JK) = MAX(0.,(PARAMMF%XBETA1/(1.+PARAMMF%XBETA1))* &
+ &(PARAMMF%XA1*ZBUO(D%NIB:D%NIE,JK)/ZWUP_MEAN(D%NIB:D%NIE)-PARAMMF%XB))
+
+ ZDETR_BUO(D%NIB:D%NIE) = MAX(0., -(PARAMMF%XBETA1/(1.+PARAMMF%XBETA1))*PARAMMF%XA1*ZBUO(D%NIB:D%NIE,JK)/ &
+ &ZWUP_MEAN(D%NIB:D%NIE))
+ ZDETR_RT(D%NIB:D%NIE) = PARAMMF%XC*SQRT(MAX(0.,(PRT_UP(D%NIB:D%NIE,JK) - ZRTM_F(D%NIB:D%NIE,JK))) / &
+ &MAX(ZEPS,ZRTM_F(D%NIB:D%NIE,JK)) / ZWUP_MEAN(D%NIB:D%NIE))
+ PDETR(D%NIB:D%NIE,JK) = ZDETR_RT(D%NIB:D%NIE)+ZDETR_BUO(D%NIB:D%NIE)
-! If the updraft did not stop, compute cons updraft characteritics at jk+1
- WHERE(GTEST)
- ZZTOP(:) = MAX(ZZTOP(:),PZZ(:,JK+KKL))
- ZMIX2(:) = (PZZ(:,JK+KKL)-PZZ(:,JK))*PENTR(:,JK) !&
- ZMIX3(:) = (PZZ(:,JK+KKL)-PZZ(:,JK))*PDETR(:,JK) !&
+ ! If the updraft did not stop, compute cons updraft characteritics at jk+1
+ WHERE(GTEST(D%NIB:D%NIE))
+ ZZTOP(D%NIB:D%NIE) = MAX(ZZTOP(D%NIB:D%NIE),PZZ(D%NIB:D%NIE,JK+D%NKL))
+ ZMIX2(D%NIB:D%NIE) = (PZZ(D%NIB:D%NIE,JK+D%NKL)-PZZ(D%NIB:D%NIE,JK))*PENTR(D%NIB:D%NIE,JK) !&
+ ZMIX3(D%NIB:D%NIE) = (PZZ(D%NIB:D%NIE,JK+D%NKL)-PZZ(D%NIB:D%NIE,JK))*PDETR(D%NIB:D%NIE,JK) !&
- ZQTM(:) = PRTM(:,JK)/(1.+PRTM(:,JK))
- ZTHSM(:,JK) = PTHLM(:,JK)*(1.+XLAMBDA_MF*ZQTM(:))
- ZTHS_UP(:,JK+KKL)=(ZTHS_UP(:,JK)*(1.-0.5*ZMIX2(:)) + ZTHSM(:,JK)*ZMIX2(:)) &
- /(1.+0.5*ZMIX2(:))
- PRT_UP(:,JK+KKL)=(PRT_UP (:,JK)*(1.-0.5*ZMIX2(:)) + PRTM(:,JK)*ZMIX2(:)) &
- /(1.+0.5*ZMIX2(:))
- ZQT_UP(:) = PRT_UP(:,JK+KKL)/(1.+PRT_UP(:,JK+KKL))
- PTHL_UP(:,JK+KKL)=ZTHS_UP(:,JK+KKL)/(1.+XLAMBDA_MF*ZQT_UP(:))
+ ZQTM(D%NIB:D%NIE) = PRTM(D%NIB:D%NIE,JK)/(1.+PRTM(D%NIB:D%NIE,JK))
+ ZTHSM(D%NIB:D%NIE,JK) = PTHLM(D%NIB:D%NIE,JK)*(1.+PARAMMF%XLAMBDA_MF*ZQTM(D%NIB:D%NIE))
+ ZTHS_UP(D%NIB:D%NIE,JK+D%NKL)=(ZTHS_UP(D%NIB:D%NIE,JK)*(1.-0.5*ZMIX2(D%NIB:D%NIE)) + ZTHSM(D%NIB:D%NIE,JK)*ZMIX2(D%NIB:D%NIE))&
+ /(1.+0.5*ZMIX2(D%NIB:D%NIE))
+ PRT_UP(D%NIB:D%NIE,JK+D%NKL)=(PRT_UP(D%NIB:D%NIE,JK)*(1.-0.5*ZMIX2(D%NIB:D%NIE)) + PRTM(D%NIB:D%NIE,JK)*ZMIX2(D%NIB:D%NIE)) &
+ /(1.+0.5*ZMIX2(D%NIB:D%NIE))
+ ZQT_UP(D%NIB:D%NIE) = PRT_UP(D%NIB:D%NIE,JK+D%NKL)/(1.+PRT_UP(D%NIB:D%NIE,JK+D%NKL))
+ PTHL_UP(D%NIB:D%NIE,JK+D%NKL)=ZTHS_UP(D%NIB:D%NIE,JK+D%NKL)/(1.+PARAMMF%XLAMBDA_MF*ZQT_UP(D%NIB:D%NIE))
ENDWHERE
IF(OMIXUV) THEN
- IF(JK/=KKB) THEN
- WHERE(GTEST)
- PU_UP(:,JK+KKL) = (PU_UP (:,JK)*(1-0.5*ZMIX2(:)) + PUM(:,JK)*ZMIX2(:)+ &
- 0.5*XPRES_UV*(PZZ(:,JK+KKL)-PZZ(:,JK))*&
- ((PUM(:,JK+KKL)-PUM(:,JK))/PDZZ(:,JK+KKL)+&
- (PUM(:,JK)-PUM(:,JK-KKL))/PDZZ(:,JK)) ) &
- /(1+0.5*ZMIX2(:))
- PV_UP(:,JK+KKL) = (PV_UP (:,JK)*(1-0.5*ZMIX2(:)) + PVM(:,JK)*ZMIX2(:)+ &
- 0.5*XPRES_UV*(PZZ(:,JK+KKL)-PZZ(:,JK))*&
- ((PVM(:,JK+KKL)-PVM(:,JK))/PDZZ(:,JK+KKL)+&
- (PVM(:,JK)-PVM(:,JK-KKL))/PDZZ(:,JK)) ) &
- /(1+0.5*ZMIX2(:))
+ IF(JK/=D%NKB) THEN
+ WHERE(GTEST(D%NIB:D%NIE))
+ PU_UP(D%NIB:D%NIE,JK+D%NKL) = (PU_UP(D%NIB:D%NIE,JK)*(1-0.5*ZMIX2(D%NIB:D%NIE)) + PUM(D%NIB:D%NIE,JK)*ZMIX2(D%NIB:D%NIE)+ &
+ 0.5*PARAMMF%XPRES_UV*(PZZ(D%NIB:D%NIE,JK+D%NKL)-PZZ(D%NIB:D%NIE,JK))*&
+ ((PUM(D%NIB:D%NIE,JK+D%NKL)-PUM(D%NIB:D%NIE,JK))/PDZZ(D%NIB:D%NIE,JK+D%NKL)+&
+ (PUM(D%NIB:D%NIE,JK)-PUM(D%NIB:D%NIE,JK-D%NKL))/PDZZ(D%NIB:D%NIE,JK)) ) &
+ /(1+0.5*ZMIX2(D%NIB:D%NIE))
+ PV_UP(D%NIB:D%NIE,JK+D%NKL) = (PV_UP(D%NIB:D%NIE,JK)*(1-0.5*ZMIX2(D%NIB:D%NIE)) + PVM(D%NIB:D%NIE,JK)*ZMIX2(D%NIB:D%NIE)+ &
+ 0.5*PARAMMF%XPRES_UV*(PZZ(D%NIB:D%NIE,JK+D%NKL)-PZZ(D%NIB:D%NIE,JK))*&
+ ((PVM(D%NIB:D%NIE,JK+D%NKL)-PVM(D%NIB:D%NIE,JK))/PDZZ(D%NIB:D%NIE,JK+D%NKL)+&
+ (PVM(D%NIB:D%NIE,JK)-PVM(D%NIB:D%NIE,JK-D%NKL))/PDZZ(D%NIB:D%NIE,JK)) ) &
+ /(1+0.5*ZMIX2(D%NIB:D%NIE))
ENDWHERE
ELSE
- WHERE(GTEST)
- PU_UP(:,JK+KKL) = (PU_UP (:,JK)*(1-0.5*ZMIX2(:)) + PUM(:,JK)*ZMIX2(:)+ &
- 0.5*XPRES_UV*(PZZ(:,JK+KKL)-PZZ(:,JK))*&
- ((PUM(:,JK+KKL)-PUM(:,JK))/PDZZ(:,JK+KKL)) ) &
- /(1+0.5*ZMIX2(:))
- PV_UP(:,JK+KKL) = (PV_UP (:,JK)*(1-0.5*ZMIX2(:)) + PVM(:,JK)*ZMIX2(:)+ &
- 0.5*XPRES_UV*(PZZ(:,JK+KKL)-PZZ(:,JK))*&
- ((PVM(:,JK+KKL)-PVM(:,JK))/PDZZ(:,JK+KKL)) ) &
- /(1+0.5*ZMIX2(:))
+ WHERE(GTEST(D%NIB:D%NIE))
+ PU_UP(D%NIB:D%NIE,JK+D%NKL) = (PU_UP(D%NIB:D%NIE,JK)*(1-0.5*ZMIX2(D%NIB:D%NIE)) + PUM(D%NIB:D%NIE,JK)*ZMIX2(D%NIB:D%NIE)+ &
+ 0.5*PARAMMF%XPRES_UV*(PZZ(D%NIB:D%NIE,JK+D%NKL)-PZZ(D%NIB:D%NIE,JK))*&
+ ((PUM(D%NIB:D%NIE,JK+D%NKL)-PUM(D%NIB:D%NIE,JK))/PDZZ(D%NIB:D%NIE,JK+D%NKL)) ) &
+ /(1+0.5*ZMIX2(D%NIB:D%NIE))
+ PV_UP(D%NIB:D%NIE,JK+D%NKL) = (PV_UP(D%NIB:D%NIE,JK)*(1-0.5*ZMIX2(D%NIB:D%NIE)) + PVM(D%NIB:D%NIE,JK)*ZMIX2(D%NIB:D%NIE)+ &
+ 0.5*PARAMMF%XPRES_UV*(PZZ(D%NIB:D%NIE,JK+D%NKL)-PZZ(D%NIB:D%NIE,JK))*&
+ ((PVM(D%NIB:D%NIE,JK+D%NKL)-PVM(D%NIB:D%NIE,JK))/PDZZ(D%NIB:D%NIE,JK+D%NKL)) ) &
+ /(1+0.5*ZMIX2(D%NIB:D%NIE))
ENDWHERE
ENDIF
ENDIF
-! DO JSV=1,ISV
-! IF (ONOMIXLG .AND. JSV >= KSV_LGBEG .AND. JSV<= KSV_LGEND) CYCLE
-! WHERE(GTEST)
-! PSV_UP(:,JK+KKL,JSV) = (PSV_UP (:,JK,JSV)*(1-0.5*ZMIX2(:)) + &
-! PSVM(:,JK,JSV)*ZMIX2(:)) /(1+0.5*ZMIX2(:))
-! ENDWHERE
-! ENDDO
+ !DO JSV=1,ISV
+ ! IF (ONOMIXLG .AND. JSV >= KSV_LGBEG .AND. JSV<= KSV_LGEND) CYCLE
+ ! WHERE(GTEST(D%NIB:D%NIE))
+ ! PSV_UP(D%NIB:D%NIE,JK+KKL,JSV) = (PSV_UP(D%NIB:D%NIE,JK,JSV)*(1-0.5*ZMIX2(D%NIB:D%NIE)) + &
+ ! PSVM(D%NIB:D%NIE,JK,JSV)*ZMIX2(D%NIB:D%NIE)) /(1+0.5*ZMIX2(D%NIB:D%NIE))
+ ! ENDWHERE
+ !ENDDO
-! Compute non cons. var. at level JK+KKL
- ZRC_UP(:)=PRC_UP(:,JK) ! guess = level just below
- ZRI_UP(:)=PRI_UP(:,JK) ! guess = level just below
- ZRV_UP(:)=PRV_UP(:,JK)
- CALL TH_R_FROM_THL_RT_1D(HFRAC_ICE,PFRAC_ICE_UP(:,JK+KKL),ZPRES_F(:,JK+KKL), &
- PTHL_UP(:,JK+KKL),PRT_UP(:,JK+KKL),ZTH_UP(:,JK+KKL), &
- ZRV_UP(:),ZRC_UP(:),ZRI_UP(:),ZRSATW(:),ZRSATI(:),OOCEAN=.FALSE.)
- WHERE(GTEST)
- ZT_UP(:) = ZTH_UP(:,JK+KKL)*PEXNM(:,JK+KKL)
- ZCP(:) = XCPD + XCL * ZRC_UP(:)
- ZLVOCPEXN(:)=(XLVTT + (XCPV-XCL) * (ZT_UP(:)-XTT) ) / ZCP(:) / PEXNM(:,JK+KKL)
- PRC_UP(:,JK+KKL)=MIN(0.5E-3,ZRC_UP(:)) ! On ne peut depasser 0.5 g/kg (autoconversion donc elimination !)
- PTHL_UP(:,JK+KKL) = PTHL_UP(:,JK+KKL)+ZLVOCPEXN(:)*(ZRC_UP(:)-PRC_UP(:,JK+KKL))
- PRV_UP(:,JK+KKL)=ZRV_UP(:)
- PRI_UP(:,JK+KKL)=ZRI_UP(:)
- PRT_UP(:,JK+KKL) = PRC_UP(:,JK+KKL) + PRV_UP(:,JK+KKL)
- PRSAT_UP(:,JK+KKL) = ZRSATW(:)*(1-PFRAC_ICE_UP(:,JK+KKL)) + ZRSATI(:)*PFRAC_ICE_UP(:,JK+KKL)
+ ! Compute non cons. var. at level JK+KKL
+ ZRC_UP(D%NIB:D%NIE)=PRC_UP(D%NIB:D%NIE,JK) ! guess = level just below
+ ZRI_UP(D%NIB:D%NIE)=PRI_UP(D%NIB:D%NIE,JK) ! guess = level just below
+ ZRV_UP(D%NIB:D%NIE)=PRV_UP(D%NIB:D%NIE,JK)
+ !$mnh_end_expand_where(JI=D%NIB:D%NIE)
+ CALL TH_R_FROM_THL_RT(CST,NEB, D%NIT, HFRAC_ICE,PFRAC_ICE_UP(:,JK+D%NKL),ZPRES_F(:,JK+D%NKL), &
+ PTHL_UP(:,JK+D%NKL),PRT_UP(:,JK+D%NKL),ZTH_UP(:,JK+D%NKL), &
+ ZRV_UP(:),ZRC_UP(:),ZRI_UP(:),ZRSATW(:),ZRSATI(:),OOCEAN=.FALSE.,&
+ PBUF=ZBUF, KB=D%NIB, KE=D%NIE)
+ !$mnh_expand_where(JI=D%NIB:D%NIE)
+ WHERE(GTEST(D%NIB:D%NIE))
+ ZT_UP(D%NIB:D%NIE) = ZTH_UP(D%NIB:D%NIE,JK+D%NKL)*PEXNM(D%NIB:D%NIE,JK+D%NKL)
+ ZCP(D%NIB:D%NIE) = CST%XCPD + CST%XCL * ZRC_UP(D%NIB:D%NIE)
+ ZLVOCPEXN(D%NIB:D%NIE)=(CST%XLVTT + (CST%XCPV-CST%XCL) * (ZT_UP(D%NIB:D%NIE)-CST%XTT) ) / &
+ &ZCP(D%NIB:D%NIE) / PEXNM(D%NIB:D%NIE,JK+D%NKL)
+ PRC_UP(D%NIB:D%NIE,JK+D%NKL)=MIN(0.5E-3,ZRC_UP(D%NIB:D%NIE)) ! On ne peut depasser 0.5 g/kg (autoconversion donc elimination !)
+ PTHL_UP(D%NIB:D%NIE,JK+D%NKL) = PTHL_UP(D%NIB:D%NIE,JK+D%NKL)+ &
+ & ZLVOCPEXN(D%NIB:D%NIE)*(ZRC_UP(D%NIB:D%NIE)-PRC_UP(D%NIB:D%NIE,JK+D%NKL))
+ PRV_UP(D%NIB:D%NIE,JK+D%NKL)=ZRV_UP(D%NIB:D%NIE)
+ PRI_UP(D%NIB:D%NIE,JK+D%NKL)=ZRI_UP(D%NIB:D%NIE)
+ PRT_UP(D%NIB:D%NIE,JK+D%NKL) = PRC_UP(D%NIB:D%NIE,JK+D%NKL) + PRV_UP(D%NIB:D%NIE,JK+D%NKL)
+ PRSAT_UP(D%NIB:D%NIE,JK+D%NKL) = ZRSATW(D%NIB:D%NIE)*(1-PFRAC_ICE_UP(D%NIB:D%NIE,JK+D%NKL)) + &
+ & ZRSATI(D%NIB:D%NIE)*PFRAC_ICE_UP(D%NIB:D%NIE,JK+D%NKL)
ENDWHERE
-! Compute the updraft theta_v, buoyancy and w**2 for level JK+1
- WHERE(GTEST)
-! PTHV_UP(:,JK+KKL) = ZTH_UP(:,JK+KKL)*((1+ZRVORD*PRV_UP(:,JK+KKL))/(1+PRT_UP(:,JK+KKL)))
- PTHV_UP(:,JK+KKL) = ZTH_UP(:,JK+KKL)*(1.+0.608*PRV_UP(:,JK+KKL) - PRC_UP(:,JK+KKL))
- ENDWHERE
+ ! Compute the updraft theta_v, buoyancy and w**2 for level JK+1
+ WHERE(GTEST(D%NIB:D%NIE))
+ !PTHV_UP(D%NIB:D%NIE,JK+KKL) = ZTH_UP(D%NIB:D%NIE,JK+KKL)*((1+ZRVORD*PRV_UP(D%NIB:D%NIE,JK+KKL))/(1+PRT_UP(D%NIB:D%NIE,JK+KKL)))
+ PTHV_UP(D%NIB:D%NIE,JK+D%NKL) = ZTH_UP(D%NIB:D%NIE,JK+D%NKL)* &
+ & (1.+0.608*PRV_UP(D%NIB:D%NIE,JK+D%NKL) - PRC_UP(D%NIB:D%NIE,JK+D%NKL))
+ ENDWHERE
-! Test if the updraft has reach the ETL
- GTESTETL(:)=.FALSE.
- WHERE (GTEST.AND.(PBUO_INTEG(:,JK)<=0.))
- KKETL(:) = JK+KKL
- GTESTETL(:)=.TRUE.
+ ! Test if the updraft has reach the ETL
+ GTESTETL(D%NIB:D%NIE)=.FALSE.
+ WHERE (GTEST(D%NIB:D%NIE).AND.(PBUO_INTEG(D%NIB:D%NIE,JK)<=0.))
+ KKETL(D%NIB:D%NIE) = JK+D%NKL
+ GTESTETL(D%NIB:D%NIE)=.TRUE.
ENDWHERE
-! Test is we have reached the top of the updraft
-
- WHERE (GTEST.AND.((ZW_UP2(:,JK+KKL)<=ZEPS)))
- ZW_UP2(:,JK+KKL)=ZEPS
- GTEST(:)=.FALSE.
- PTHL_UP(:,JK+KKL)=ZTHLM_F(:,JK+KKL)
- PRT_UP(:,JK+KKL)=ZRTM_F(:,JK+KKL)
- PRC_UP(:,JK+KKL)=0.
- PRI_UP(:,JK+KKL)=0.
- PRV_UP(:,JK+KKL)=0.
- PTHV_UP(:,JK+KKL)=ZTHVM_F(:,JK+KKL)
- PFRAC_UP(:,JK+KKL)=0.
- KKCTL(:)=JK+KKL
+ ! Test is we have reached the top of the updraft
+ WHERE (GTEST(D%NIB:D%NIE).AND.((ZW_UP2(D%NIB:D%NIE,JK+D%NKL)<=ZEPS)))
+ ZW_UP2(D%NIB:D%NIE,JK+D%NKL)=ZEPS
+ GTEST(D%NIB:D%NIE)=.FALSE.
+ PTHL_UP(D%NIB:D%NIE,JK+D%NKL)=ZTHLM_F(D%NIB:D%NIE,JK+D%NKL)
+ PRT_UP(D%NIB:D%NIE,JK+D%NKL)=ZRTM_F(D%NIB:D%NIE,JK+D%NKL)
+ PRC_UP(D%NIB:D%NIE,JK+D%NKL)=0.
+ PRI_UP(D%NIB:D%NIE,JK+D%NKL)=0.
+ PRV_UP(D%NIB:D%NIE,JK+D%NKL)=0.
+ PTHV_UP(D%NIB:D%NIE,JK+D%NKL)=ZTHVM_F(D%NIB:D%NIE,JK+D%NKL)
+ PFRAC_UP(D%NIB:D%NIE,JK+D%NKL)=0.
+ KKCTL(D%NIB:D%NIE)=JK+D%NKL
ENDWHERE
-
+ !$mnh_end_expand_where(JI=D%NIB:D%NIE)
ENDDO
! Closure assumption for mass flux at KKB+1 level (Mass flux is supposed to be 0 at KKB level !)
! Hourdin et al 2002 formulation
-ZZTOP(:) = MAX(ZZTOP(:),ZEPS)
+!$mnh_expand_array(JI=D%NIB:D%NIE)
+ZZTOP(D%NIB:D%NIE) = MAX(ZZTOP(D%NIB:D%NIE),ZEPS)
+!$mnh_end_expand_array(JI=D%NIB:D%NIE)
-DO JK=KKB+KKL,KKE-KKL,KKL ! Vertical loop
- WHERE(JK<=IALIM)
- ZALIM_STAR_TOT(:) = ZALIM_STAR_TOT(:) + ZALIM_STAR(:,JK)*ZALIM_STAR(:,JK)*ZZDZ(:,JK)/PRHODREF(:,JK)
- ENDWHERE
+DO JK=D%NKB+D%NKL,D%NKE-D%NKL,D%NKL ! Vertical loop
+ !$mnh_expand_where(JI=D%NIB:D%NIE)
+ WHERE(JK<=IALIM(D%NIB:D%NIE))
+ ZALIM_STAR_TOT(D%NIB:D%NIE) = ZALIM_STAR_TOT(D%NIB:D%NIE) + ZALIM_STAR(D%NIB:D%NIE,JK)**2* &
+ & ZZDZ(D%NIB:D%NIE,JK)/PRHODREF(D%NIB:D%NIE,JK)
+ ENDWHERE
+ !$mnh_end_expand_where(JI=D%NIB:D%NIE)
ENDDO
-WHERE (ZALIM_STAR_TOT*ZZTOP > ZEPS)
- ZPHI(:) = ZW_MAX(:)/(XR*ZZTOP(:)*ZALIM_STAR_TOT(:))
-ENDWHERE
+!$mnh_expand_where(JI=D%NIB:D%NIE)
+WHERE (ZALIM_STAR_TOT(D%NIB:D%NIE)*ZZTOP(D%NIB:D%NIE) > ZEPS)
+ ZPHI(D%NIB:D%NIE) = ZW_MAX(D%NIB:D%NIE)/(PARAMMF%XR*ZZTOP(D%NIB:D%NIE)*ZALIM_STAR_TOT(D%NIB:D%NIE))
+ENDWHERE
-GTEST(:) = .TRUE.
-PEMF(:,KKB+KKL) = ZPHI(:)*ZZDZ(:,KKB)*ZALIM_STAR(:,KKB)
+GTEST(D%NIB:D%NIE) = .TRUE.
+PEMF(D%NIB:D%NIE,D%NKB+D%NKL) = ZPHI(D%NIB:D%NIE)*ZZDZ(D%NIB:D%NIE,D%NKB)*ZALIM_STAR(D%NIB:D%NIE,D%NKB)
! Updraft fraction must be smaller than XFRAC_UP_MAX
-PFRAC_UP(:,KKB+KKL)=PEMF(:,KKB+KKL)/(SQRT(ZW_UP2(:,KKB+KKL))*ZRHO_F(:,KKB+KKL))
-PFRAC_UP(:,KKB+KKL)=MIN(XFRAC_UP_MAX,PFRAC_UP(:,KKB+KKL))
-PEMF(:,KKB+KKL) = ZRHO_F(:,KKB+KKL)*PFRAC_UP(:,KKB+KKL)*SQRT(ZW_UP2(:,KKB+KKL))
-
-DO JK=KKB+KKL,KKE-KKL,KKL ! Vertical loop
+PFRAC_UP(D%NIB:D%NIE,D%NKB+D%NKL)=PEMF(D%NIB:D%NIE,D%NKB+D%NKL)/ &
+ &(SQRT(ZW_UP2(D%NIB:D%NIE,D%NKB+D%NKL))*ZRHO_F(D%NIB:D%NIE,D%NKB+D%NKL))
+PFRAC_UP(D%NIB:D%NIE,D%NKB+D%NKL)=MIN(PARAMMF%XFRAC_UP_MAX,PFRAC_UP(D%NIB:D%NIE,D%NKB+D%NKL))
+PEMF(D%NIB:D%NIE,D%NKB+D%NKL) = ZRHO_F(D%NIB:D%NIE,D%NKB+D%NKL)*PFRAC_UP(D%NIB:D%NIE,D%NKB+D%NKL)* &
+ & SQRT(ZW_UP2(D%NIB:D%NIE,D%NKB+D%NKL))
+!$mnh_end_expand_where(JI=D%NIB:D%NIE)
+
+DO JK=D%NKB+D%NKL,D%NKE-D%NKL,D%NKL ! Vertical loop
+ !$mnh_expand_where(JI=D%NIB:D%NIE)
- GTEST = (ZW_UP2(:,JK) > ZEPS)
+ GTEST(D%NIB:D%NIE) = (ZW_UP2(D%NIB:D%NIE,JK) > ZEPS)
- WHERE (GTEST)
- WHERE(JK<IALIM)
- PEMF(:,JK+KKL) = MAX(0.,PEMF(:,JK) + ZPHI(:)*ZZDZ(:,JK)*(PENTR(:,JK) - PDETR(:,JK)))
+ WHERE (GTEST(D%NIB:D%NIE))
+ WHERE(JK<IALIM(D%NIB:D%NIE))
+ PEMF(D%NIB:D%NIE,JK+D%NKL) = MAX(0.,PEMF(D%NIB:D%NIE,JK) + ZPHI(D%NIB:D%NIE)*ZZDZ(D%NIB:D%NIE,JK)* &
+ & (PENTR(D%NIB:D%NIE,JK) - PDETR(D%NIB:D%NIE,JK)))
ELSEWHERE
- ZMIX1(:)=ZZDZ(:,JK)*(PENTR(:,JK)-PDETR(:,JK))
- PEMF(:,JK+KKL)=PEMF(:,JK)*EXP(ZMIX1(:))
+ ZMIX1(D%NIB:D%NIE)=ZZDZ(D%NIB:D%NIE,JK)*(PENTR(D%NIB:D%NIE,JK)-PDETR(D%NIB:D%NIE,JK))
+ PEMF(D%NIB:D%NIE,JK+D%NKL)=PEMF(D%NIB:D%NIE,JK)*EXP(ZMIX1(D%NIB:D%NIE))
ENDWHERE
! Updraft fraction must be smaller than XFRAC_UP_MAX
- PFRAC_UP(:,JK+KKL)=PEMF(:,JK+KKL)/(SQRT(ZW_UP2(:,JK+KKL))*ZRHO_F(:,JK+KKL))
- PFRAC_UP(:,JK+KKL)=MIN(XFRAC_UP_MAX,PFRAC_UP(:,JK+KKL))
- PEMF(:,JK+KKL) = ZRHO_F(:,JK+KKL)*PFRAC_UP(:,JK+KKL)*SQRT(ZW_UP2(:,JK+KKL))
+ PFRAC_UP(D%NIB:D%NIE,JK+D%NKL)=PEMF(D%NIB:D%NIE,JK+D%NKL)/(SQRT(ZW_UP2(D%NIB:D%NIE,JK+D%NKL))*ZRHO_F(D%NIB:D%NIE,JK+D%NKL))
+ PFRAC_UP(D%NIB:D%NIE,JK+D%NKL)=MIN(PARAMMF%XFRAC_UP_MAX,PFRAC_UP(D%NIB:D%NIE,JK+D%NKL))
+ PEMF(D%NIB:D%NIE,JK+D%NKL) = ZRHO_F(D%NIB:D%NIE,JK+D%NKL)*PFRAC_UP(D%NIB:D%NIE,JK+D%NKL)*SQRT(ZW_UP2(D%NIB:D%NIE,JK+D%NKL))
ENDWHERE
-
+ !$mnh_end_expand_where(JI=D%NIB:D%NIE)
ENDDO
-PW_UP(:,:)=SQRT(ZW_UP2(:,:))
-PEMF(:,KKB) =0.
+!$mnh_expand_array(JI=D%NIB:D%NIE,JK=1:D%NKT)
+PW_UP(D%NIB:D%NIE,:)=SQRT(ZW_UP2(D%NIB:D%NIE,:))
+!$mnh_end_expand_array(JI=D%NIB:D%NIE,JK=1:D%NKT)
+!$mnh_expand_array(JI=D%NIB:D%NIE)
+PEMF(D%NIB:D%NIE,D%NKB) =0.
+!$mnh_end_expand_array(JI=D%NIB:D%NIE)
! Limits the shallow convection scheme when cloud heigth is higher than 3000m.
! To do this, mass flux is multiplied by a coefficient decreasing linearly
@@ -579,20 +615,32 @@ PEMF(:,KKB) =0.
! This way, all MF fluxes are diminished by this amount.
! Diagnosed cloud fraction is also multiplied by the same coefficient.
!
-DO JI=1,SIZE(PTHM,1)
- PDEPTH(JI) = MAX(0., PZZ(JI,KKCTL(JI)) - PZZ(JI,KKLCL(JI)) )
+DO JI=D%NIB,D%NIE
+ PDEPTH(JI) = MAX(0., PZZ(JI,KKCTL(JI)) - PZZ(JI,KKLCL(JI)) )
END DO
-GWORK1(:)= (GTESTLCL(:) .AND. (PDEPTH(:) > ZDEPTH_MAX1) )
-GWORK2(:,:) = SPREAD( GWORK1(:), DIM=2, NCOPIES=IKU )
-ZCOEF(:,:) = SPREAD( (1.-(PDEPTH(:)-ZDEPTH_MAX1)/(ZDEPTH_MAX2-ZDEPTH_MAX1)), DIM=2, NCOPIES=IKU)
-ZCOEF=MIN(MAX(ZCOEF,0.),1.)
-WHERE (GWORK2)
- PEMF(:,:) = PEMF(:,:) * ZCOEF(:,:)
- PFRAC_UP(:,:) = PFRAC_UP(:,:) * ZCOEF(:,:)
+!$mnh_expand_array(JI=D%NIB:D%NIE)
+GWORK1(D%NIB:D%NIE)= (GTESTLCL(D%NIB:D%NIE) .AND. (PDEPTH(D%NIB:D%NIE) > ZDEPTH_MAX1) )
+!$mnh_end_expand_array(JI=D%NIB:D%NIE)
+DO JK=1,D%NKT
+ !$mnh_expand_array(JI=D%NIB:D%NIE)
+ GWORK2(D%NIB:D%NIE,JK) = GWORK1(D%NIB:D%NIE)
+ ZCOEF(D%NIB:D%NIE,JK) = (1.-(PDEPTH(D%NIB:D%NIE)-ZDEPTH_MAX1)/(ZDEPTH_MAX2-ZDEPTH_MAX1))
+ ZCOEF(D%NIB:D%NIE,JK)=MIN(MAX(ZCOEF(D%NIB:D%NIE,JK),0.),1.)
+ !$mnh_end_expand_array(JI=D%NIB:D%NIE)
+ENDDO
+!$mnh_expand_where(JI=D%NIB:D%NIE,JK=1:D%NKT)
+WHERE (GWORK2(D%NIB:D%NIE,:))
+ PEMF(D%NIB:D%NIE,:) = PEMF(D%NIB:D%NIE,:) * ZCOEF(D%NIB:D%NIE,:)
+ PFRAC_UP(D%NIB:D%NIE,:) = PFRAC_UP(D%NIB:D%NIE,:) * ZCOEF(D%NIB:D%NIE,:)
ENDWHERE
+!$mnh_end_expand_where(JI=D%NIB:D%NIE,JK=1:D%NKT)
IF (LHOOK) CALL DR_HOOK('COMPUTE_UPDRAF_RAHA',1,ZHOOK_HANDLE)
-
+!
+CONTAINS
+INCLUDE "th_r_from_thl_rt.func.h"
+INCLUDE "compute_frac_ice.func.h"
+!
END SUBROUTINE COMPUTE_UPDRAFT_RAHA
END MODULE MODE_COMPUTE_UPDRAFT_RAHA
diff --git a/src/common/turb/mode_compute_updraft_rhcj10.F90 b/src/common/turb/mode_compute_updraft_rhcj10.F90
index 0392012db244776f3720593fba148057f7a72a29..c3fcc7fc5a5ae05b519be3ec2b443de64c3c28ab 100644
--- a/src/common/turb/mode_compute_updraft_rhcj10.F90
+++ b/src/common/turb/mode_compute_updraft_rhcj10.F90
@@ -10,7 +10,8 @@
IMPLICIT NONE
CONTAINS
!
-SUBROUTINE COMPUTE_UPDRAFT_RHCJ10(KKA,KKB,KKE,KKU,KKL,HFRAC_ICE, &
+SUBROUTINE COMPUTE_UPDRAFT_RHCJ10(D, CST, NEB, PARAMMF, TURB, CSTURB, &
+ KSV, HFRAC_ICE, &
OENTR_DETR,OMIXUV, &
ONOMIXLG,KSV_LGBEG,KSV_LGEND, &
PZZ,PDZZ, &
@@ -60,10 +61,13 @@ SUBROUTINE COMPUTE_UPDRAFT_RHCJ10(KKA,KKB,KKE,KKU,KKL,HFRAC_ICE, &
!* 0. DECLARATIONS
! ------------
!
-USE MODD_CST
-USE MODD_PARAM_MFSHALL_n
-USE MODD_TURB_n, ONLY : CTURBLEN
-USE MODE_TH_R_FROM_THL_RT_1D, ONLY: TH_R_FROM_THL_RT_1D
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+USE MODD_CST, ONLY: CST_t
+USE MODD_NEB, ONLY: NEB_t
+USE MODD_PARAM_MFSHALL_n, ONLY: PARAM_MFSHALL_t
+USE MODD_TURB_n, ONLY: TURB_t
+USE MODD_CTURB, ONLY: CSTURB_t
+!
USE MODI_SHUMAN_MF, ONLY: MZF_MF, MZM_MF, GZ_M_W_MF
USE MODE_COMPUTE_BL89_ML, ONLY: COMPUTE_BL89_ML
@@ -76,115 +80,119 @@ IMPLICIT NONE
!* 1.1 Declaration of Arguments
!
!
-INTEGER, INTENT(IN) :: KKA ! near ground array index
-INTEGER, INTENT(IN) :: KKB ! near ground physical index
-INTEGER, INTENT(IN) :: KKE ! uppest atmosphere physical index
-INTEGER, INTENT(IN) :: KKU ! uppest atmosphere array index
-INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+TYPE(CST_t), INTENT(IN) :: CST
+TYPE(NEB_t), INTENT(IN) :: NEB
+TYPE(PARAM_MFSHALL_t), INTENT(IN) :: PARAMMF
+TYPE(TURB_t), INTENT(IN) :: TURB
+TYPE(CSTURB_t), INTENT(IN) :: CSTURB
+INTEGER, INTENT(IN) :: KSV
CHARACTER(LEN=1), INTENT(IN) :: HFRAC_ICE ! partition liquid/ice scheme
LOGICAL, INTENT(IN) :: OENTR_DETR! flag to recompute entrainment, detrainment and mass flux
LOGICAL, INTENT(IN) :: OMIXUV ! True if mixing of momentum
LOGICAL, INTENT(IN) :: ONOMIXLG ! False if mixing of lagrangian tracer
INTEGER, INTENT(IN) :: KSV_LGBEG ! first index of lag. tracer
INTEGER, INTENT(IN) :: KSV_LGEND ! last index of lag. tracer
-REAL, DIMENSION(:,:), INTENT(IN) :: PZZ ! Height at the flux point
-REAL, DIMENSION(:,:), INTENT(IN) :: PDZZ ! Metrics coefficient
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(IN) :: PZZ ! Height at the flux point
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(IN) :: PDZZ ! Metrics coefficient
-REAL, DIMENSION(:), INTENT(IN) :: PSFTH,PSFRV
+REAL, DIMENSION(D%NIT), INTENT(IN) :: PSFTH,PSFRV
! normal surface fluxes of theta,rv,(u,v) parallel to the orography
-REAL, DIMENSION(:,:), INTENT(IN) :: PPABSM ! Pressure at t-dt
-REAL, DIMENSION(:,:), INTENT(IN) :: PRHODREF ! dry density of the
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(IN) :: PPABSM ! Pressure at t-dt
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(IN) :: PRHODREF ! dry density of the
! reference state
-REAL, DIMENSION(:,:), INTENT(IN) :: PUM ! u mean wind
-REAL, DIMENSION(:,:), INTENT(IN) :: PVM ! v mean wind
-REAL, DIMENSION(:,:), INTENT(IN) :: PTKEM ! TKE at t-dt
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(IN) :: PUM ! u mean wind
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(IN) :: PVM ! v mean wind
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(IN) :: PTKEM ! TKE at t-dt
!
!REAL, DIMENSION(:,:), INTENT(IN) :: PEXNM ! Exner function at t-dt
-REAL, DIMENSION(:,:), INTENT(IN) :: PTHM ! pot. temp. at t-dt
-REAL, DIMENSION(:,:), INTENT(IN) :: PRVM ! vapor mixing ratio at t-dt
-REAL, DIMENSION(:,:), INTENT(IN) :: PTHLM,PRTM ! cons. var. at t-dt
-
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSVM ! scalar var. at t-dt
-
-REAL, DIMENSION(:,:), INTENT(OUT) :: PTHL_UP,PRT_UP ! updraft properties
-REAL, DIMENSION(:,:), INTENT(OUT) :: PU_UP, PV_UP ! updraft wind components
-REAL, DIMENSION(:,:), INTENT(INOUT):: PRV_UP,PRC_UP ! updraft rv, rc
-REAL, DIMENSION(:,:), INTENT(INOUT):: PRI_UP ! updraft ri
-REAL, DIMENSION(:,:), INTENT(INOUT):: PTHV_UP ! updraft THv
-REAL, DIMENSION(:,:), INTENT(INOUT):: PW_UP,PFRAC_UP ! updraft w, fraction
-REAL, DIMENSION(:,:), INTENT(INOUT):: PFRAC_ICE_UP ! liquid/solid fraction in updraft
-REAL, DIMENSION(:,:), INTENT(INOUT):: PRSAT_UP ! Rsat
-
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSV_UP ! updraft scalar var.
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(IN) :: PTHM ! pot. temp. at t-dt
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(IN) :: PRVM ! vapor mixing ratio at t-dt
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(IN) :: PTHLM,PRTM ! cons. var. at t-dt
+
+REAL, DIMENSION(D%NIT,D%NKT,KSV), INTENT(IN) :: PSVM ! scalar var. at t-dt
+
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(OUT) :: PTHL_UP,PRT_UP ! updraft properties
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(OUT) :: PU_UP, PV_UP ! updraft wind components
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(INOUT):: PRV_UP,PRC_UP ! updraft rv, rc
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(INOUT):: PRI_UP ! updraft ri
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(INOUT):: PTHV_UP ! updraft THv
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(INOUT):: PW_UP,PFRAC_UP ! updraft w, fraction
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(INOUT):: PFRAC_ICE_UP ! liquid/solid fraction in updraft
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(INOUT):: PRSAT_UP ! Rsat
+
+REAL, DIMENSION(D%NIT,D%NKT,KSV), INTENT(OUT) :: PSV_UP ! updraft scalar var.
-REAL, DIMENSION(:,:), INTENT(INOUT):: PEMF,PDETR,PENTR ! Mass_flux,
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(INOUT):: PEMF,PDETR,PENTR ! Mass_flux,
! detrainment,entrainment
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PBUO_INTEG ! Integrated Buoyancy
-INTEGER, DIMENSION(:), INTENT(INOUT):: KKLCL,KKETL,KKCTL! LCL, ETL, CTL
-REAL, DIMENSION(:), INTENT(OUT) :: PDEPTH ! Deepness of cloud
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(INOUT) :: PBUO_INTEG ! Integrated Buoyancy
+INTEGER, DIMENSION(D%NIT), INTENT(INOUT):: KKLCL,KKETL,KKCTL! LCL, ETL, CTL
+REAL, DIMENSION(D%NIT), INTENT(OUT) :: PDEPTH ! Deepness of cloud
! 1.2 Declaration of local variables
!
! Mean environment variables at t-dt at flux point
-REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZTHM_F,ZRVM_F ! Theta,rv of
+REAL, DIMENSION(D%NIT,D%NKT) :: ZTHM_F,ZRVM_F ! Theta,rv of
! updraft environnement
-REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZRTM_F, ZTHLM_F, ZTKEM_F ! rt, thetal,TKE,pressure,
-REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZUM_F,ZVM_F,ZRHO_F ! density,momentum
-REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZPRES_F,ZTHVM_F ! interpolated at the flux point
-REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZG_O_THVREF ! g*ThetaV ref
-REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZW_UP2 ! w**2 of the updraft
+REAL, DIMENSION(D%NIT,D%NKT) :: ZRTM_F, ZTHLM_F, ZTKEM_F ! rt, thetal,TKE,pressure,
+REAL, DIMENSION(D%NIT,D%NKT) :: ZUM_F,ZVM_F,ZRHO_F ! density,momentum
+REAL, DIMENSION(D%NIT,D%NKT) :: ZPRES_F,ZTHVM_F ! interpolated at the flux point
+REAL, DIMENSION(D%NIT,D%NKT) :: ZG_O_THVREF ! g*ThetaV ref
+REAL, DIMENSION(D%NIT,D%NKT) :: ZW_UP2 ! w**2 of the updraft
-REAL, DIMENSION(SIZE(PSVM,1),SIZE(PTHM,2),SIZE(PSVM,3)) :: ZSVM_F ! scalar variables
+REAL, DIMENSION(D%NIT,D%NKT,KSV) :: ZSVM_F ! scalar variables
-REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZTH_UP ! updraft THETA
+REAL, DIMENSION(D%NIT,D%NKT) :: ZTH_UP ! updraft THETA
!REAL, DIMENSION(SIZE(PTHM,1)) :: ZT_UP ! updraft T
!REAL, DIMENSION(SIZE(PTHM,1)) :: ZLVOCPEXN ! updraft L
!REAL, DIMENSION(SIZE(PTHM,1)) :: ZCP ! updraft cp
-REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZBUO ! Buoyancy
+REAL, DIMENSION(D%NIT,D%NKT) :: ZBUO ! Buoyancy
!REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZTHS_UP,ZTHSM
-REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZCOEF ! diminution coefficient for too high clouds
+REAL, DIMENSION(D%NIT,D%NKT) :: ZCOEF ! diminution coefficient for too high clouds
REAL :: ZWTHVSURF ! Surface w'thetav'
REAL :: ZRVORD ! RV/RD
-REAL, DIMENSION(SIZE(PTHM,1)) :: ZMIX1,ZMIX2
+REAL, DIMENSION(D%NIT) :: ZMIX1,ZMIX2
-REAL, DIMENSION(SIZE(PTHM,1)) :: ZLUP ! Upward Mixing length from the ground
+REAL, DIMENSION(D%NIT) :: ZLUP ! Upward Mixing length from the ground
-INTEGER :: ISV ! Number of scalar variables
-INTEGER :: IKU,IIJU ! array size in k
INTEGER :: JK,JI,JSV ! loop counters
-LOGICAL, DIMENSION(SIZE(PTHM,1)) :: GTEST,GTESTLCL
+LOGICAL, DIMENSION(D%NIT) :: GTEST,GTESTLCL
! Test if the ascent continue, if LCL or ETL is reached
LOGICAL :: GLMIX
! To choose upward or downward mixing length
-LOGICAL, DIMENSION(SIZE(PTHM,1)) :: GWORK1
-LOGICAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: GWORK2
+LOGICAL, DIMENSION(D%NIT) :: GWORK1
+LOGICAL, DIMENSION(D%NIT,D%NKT) :: GWORK2
INTEGER :: ITEST
-REAL, DIMENSION(SIZE(PTHM,1)) :: ZRC_UP, ZRI_UP, ZRV_UP, ZRSATW, ZRSATI
+REAL, DIMENSION(D%NIT) :: ZRC_UP, ZRI_UP, ZRV_UP, ZRSATW, ZRSATI
-REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZZDZ
+REAL, DIMENSION(D%NIT,D%NKT) :: ZZDZ
-REAL, DIMENSION(SIZE(PTHM,1)) :: ZTEST,ZDZ,ZWUP_MEAN !
-REAL, DIMENSION(SIZE(PTHM,1)) :: ZCOE,ZWCOE,ZBUCOE
-REAL, DIMENSION(SIZE(PTHM,1)) :: ZDETR_BUO, ZDETR_RT
-REAL, DIMENSION(SIZE(PTHM,1)) :: ZW_MAX ! w**2 max of the updraft
-REAL, DIMENSION(SIZE(PTHM,1)) :: ZZTOP ! Top of the updraft
+REAL, DIMENSION(D%NIT) :: ZTEST,ZDZ,ZWUP_MEAN !
+REAL, DIMENSION(D%NIT) :: ZCOE,ZWCOE,ZBUCOE
+REAL, DIMENSION(D%NIT) :: ZDETR_BUO, ZDETR_RT
+REAL, DIMENSION(D%NIT) :: ZW_MAX ! w**2 max of the updraft
+REAL, DIMENSION(D%NIT) :: ZZTOP ! Top of the updraft
!REAL, DIMENSION(SIZE(PTHM,1)) :: ZQTM,ZQT_UP
REAL :: ZDEPTH_MAX1, ZDEPTH_MAX2 ! control auto-extinction process
REAL :: ZTMAX,ZRMAX, ZEPS ! control value
-REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZSHEAR,ZDUDZ,ZDVDZ ! vertical wind shear
+REAL, DIMENSION(D%NIT,D%NKT) :: ZSHEAR,ZDUDZ,ZDVDZ ! vertical wind shear
+!
+REAL, DIMENSION(D%NIT,D%NKT) :: ZWK
+REAL, DIMENSION(D%NIT,16) :: ZBUF
+!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('COMPUTE_UPDRAFT_RHCJ10',0,ZHOOK_HANDLE)
@@ -198,7 +206,7 @@ ZEPS=1.E-15
! INITIALISATION
! Initialisation of the constants
-ZRVORD = (XRV / XRD)
+ZRVORD = (CST%XRV / CST%XRD)
! depth are different in compute_updraft (3000. and 4000.) ==> impact is small
ZDEPTH_MAX1=4500. ! clouds with depth infeRIOr to this value are keeped untouched
@@ -206,17 +214,11 @@ ZDEPTH_MAX2=5000. ! clouds with depth superior to this value are suppressed
! Local variables, internal domain
-! Internal Domain
-
-IKU=SIZE(PTHM,2)
-IIJU =SIZE(PTHM,1)
-!number of scalar variables
-ISV=SIZE(PSVM,3)
! Initialisation of intersesting Level :LCL,ETL,CTL
-KKLCL(:)=KKE
-KKETL(:)=KKE
-KKCTL(:)=KKE
+KKLCL(:)=D%NKE
+KKETL(:)=D%NKE
+KKCTL(:)=D%NKE
!
! Initialisation
@@ -240,128 +242,149 @@ ZBUO =0.
!no ice cloud coded yet
PRI_UP(:,:)=0.
PFRAC_ICE_UP(:,:)=0.
-PRSAT_UP(:,:)=PRVM(:,:) ! should be initialised correctly but is (normaly) not used
+!$mnh_expand_array(JI=D%NIB:D%NIE,JK=1:D%NKT)
+PRSAT_UP(D%NIB:D%NIE,:)=PRVM(D%NIB:D%NIE,:) ! should be initialised correctly but is (normaly) not used
+!$mnh_end_expand_array(JI=D%NIB:D%NIE,JK=1:D%NKT)
! Initialisation of environment variables at t-dt
! variables at flux level
-ZTHLM_F(:,:) = MZM_MF(PTHLM(:,:), KKA, KKU, KKL)
-ZRTM_F (:,:) = MZM_MF(PRTM(:,:), KKA, KKU, KKL)
-ZUM_F (:,:) = MZM_MF(PUM(:,:), KKA, KKU, KKL)
-ZVM_F (:,:) = MZM_MF(PVM(:,:), KKA, KKU, KKL)
-ZTKEM_F(:,:) = MZM_MF(PTKEM(:,:), KKA, KKU, KKL)
+CALL MZM_MF(D, PTHLM(:,:), ZTHLM_F(:,:))
+CALL MZM_MF(D, PRTM(:,:), ZRTM_F(:,:))
+CALL MZM_MF(D, PUM(:,:), ZUM_F(:,:))
+CALL MZM_MF(D, PVM(:,:), ZVM_F(:,:))
+CALL MZM_MF(D, PTKEM(:,:), ZTKEM_F(:,:))
! This updraft is not yet ready to use scalar variables
!DO JSV=1,ISV
! IF (ONOMIXLG .AND. JSV >= KSV_LGBEG .AND. JSV<= KSV_LGEND) CYCLE
! *** SR merge AROME/Meso-nh: following two lines come from the AROME version
-! ZSVM_F(:,KKB:IKU,JSV) = 0.5*(PSVM(:,KKB:IKU,JSV)+PSVM(:,1:IKU-1,JSV))
-! ZSVM_F(:,1,JSV) = ZSVM_F(:,KKB,JSV)
+! ZSVM_F(D%NIB:D%NIE,KKB:IKU,JSV) = 0.5*(PSVM(D%NIB:D%NIE,KKB:IKU,JSV)+PSVM(D%NIB:D%NIE,1:IKU-1,JSV))
+! ZSVM_F(D%NIB:D%NIE,1,JSV) = ZSVM_F(D%NIB:D%NIE,KKB,JSV)
! *** the following single line comes from the Meso-NH version
-! ZSVM_F(:,:,JSV) = MZM_MF(KKA,KKU,KKL,PSVM(:,:,JSV))
+! ZSVM_F(D%NIB:D%NIE,:,JSV) = MZM_MF(KKA,KKU,KKL,PSVM(D%NIB:D%NIE,:,JSV))
!END DO
! Initialisation of updraft characteristics
-PTHL_UP(:,:)=ZTHLM_F(:,:)
-PRT_UP(:,:)=ZRTM_F(:,:)
-PU_UP(:,:)=ZUM_F(:,:)
-PV_UP(:,:)=ZVM_F(:,:)
-PSV_UP(:,:,:)=0.
+!$mnh_expand_array(JI=D%NIB:D%NIE,JK=1:D%NKT)
+PTHL_UP(D%NIB:D%NIE,:)=ZTHLM_F(D%NIB:D%NIE,:)
+PRT_UP(D%NIB:D%NIE,:)=ZRTM_F(D%NIB:D%NIE,:)
+PU_UP(D%NIB:D%NIE,:)=ZUM_F(D%NIB:D%NIE,:)
+PV_UP(D%NIB:D%NIE,:)=ZVM_F(D%NIB:D%NIE,:)
+!$mnh_end_expand_array(JI=D%NIB:D%NIE,JK=1:D%NKT)
+PSV_UP(D%NIB:D%NIE,:,:)=0.
! This updraft is not yet ready to use scalar variables
!IF (ONOMIXLG .AND. JSV >= KSV_LGBEG .AND. JSV<= KSV_LGEND) then
-! PSV_UP(:,:,:)=ZSVM_F(:,:,:)
+! PSV_UP(D%NIB:D%NIE,:,:)=ZSVM_F(D%NIB:D%NIE,:,:)
!ENDIF
! Computation or initialisation of updraft characteristics at the KKB level
! thetal_up,rt_up,thetaV_up, w,Buoyancy term and mass flux (PEMF)
-DO JI=1,IIJU
+DO JI=D%NIB,D%NIE
!PTHL_UP(JI,KKB)= ZTHLM_F(JI,KKB)+MAX(0.,MIN(ZTMAX,(PSFTH(JI)/SQRT(ZTKEM_F(JI,KKB)))*XALP_PERT))
!PRT_UP(JI,KKB) = ZRTM_F(JI,KKB)+MAX(0.,MIN(ZRMAX,(PSFRV(JI)/SQRT(ZTKEM_F(JI,KKB)))*XALP_PERT))
- PTHL_UP(JI,KKB)= ZTHLM_F(JI,KKB)
- PRT_UP(JI,KKB) = ZRTM_F(JI,KKB)
+ PTHL_UP(JI,D%NKB)= ZTHLM_F(JI,D%NKB)
+ PRT_UP(JI,D%NKB) = ZRTM_F(JI,D%NKB)
!ZQT_UP(JI) = PRT_UP(JI,KKB)/(1.+PRT_UP(JI,KKB))
!ZTHS_UP(JI,KKB)=PTHL_UP(JI,KKB)*(1.+XLAMBDA_MF*ZQT_UP(JI))
ENDDO
-ZTHM_F (:,:) = MZM_MF(PTHM (:,:), KKA, KKU, KKL)
-ZPRES_F(:,:) = MZM_MF(PPABSM(:,:), KKA, KKU, KKL)
-ZRHO_F (:,:) = MZM_MF(PRHODREF(:,:), KKA, KKU, KKL)
-ZRVM_F (:,:) = MZM_MF(PRVM(:,:), KKA, KKU, KKL)
+CALL MZM_MF(D, PTHM (:,:), ZTHM_F(:,:))
+CALL MZM_MF(D, PPABSM(:,:), ZPRES_F(:,:))
+CALL MZM_MF(D, PRHODREF(:,:), ZRHO_F(:,:))
+CALL MZM_MF(D, PRVM(:,:), ZRVM_F(:,:))
! thetav at mass and flux levels
-DO JK=1,IKU
- DO JI=1,IIJU
+DO JK=1,D%NKT
+ DO JI=d%NIB,D%NIE
ZTHVM_F(JI,JK)=ZTHM_F(JI,JK)*((1.+ZRVORD*ZRVM_F(JI,JK))/(1.+ZRTM_F(JI,JK)))
ENDDO
ENDDO
-PTHV_UP(:,:)= ZTHVM_F(:,:)
-PRV_UP (:,:)= ZRVM_F (:,:)
+!$mnh_expand_array(JI=D%NIB:D%NIE,JK=1:D%NKT)
+PTHV_UP(D%NIB:D%NIE,:)= ZTHVM_F(D%NIB:D%NIE,:)
+PRV_UP(D%NIB:D%NIE,:)= ZRVM_F(D%NIB:D%NIE,:)
+!$mnh_end_expand_array(JI=D%NIB:D%NIE,JK=1:D%NKT)
ZW_UP2(:,:)=ZEPS
-!ZW_UP2(:,KKB) = MAX(0.0001,(3./6.)*ZTKEM_F(:,KKB))
-ZW_UP2(:,KKB) = MAX(0.0001,(2./3.)*ZTKEM_F(:,KKB))
+!$mnh_expand_array(JI=D%NIB:D%NIE)
+!ZW_UP2(D%NIB:D%NIE,KKB) = MAX(0.0001,(3./6.)*ZTKEM_F(D%NIB:D%NIE,KKB))
+ZW_UP2(D%NIB:D%NIE,D%NKB) = MAX(0.0001,(2./3.)*ZTKEM_F(D%NIB:D%NIE,D%NKB))
+!$mnh_end_expand_array(JI=D%NIB:D%NIE)
! Computation of non conservative variable for the KKB level of the updraft
! (all or nothing ajustement)
-PRC_UP(:,KKB)=0.
-PRI_UP(:,KKB)=0.
-CALL TH_R_FROM_THL_RT_1D(HFRAC_ICE,PFRAC_ICE_UP(:,KKB),ZPRES_F(:,KKB), &
- PTHL_UP(:,KKB),PRT_UP(:,KKB),ZTH_UP(:,KKB), &
- PRV_UP(:,KKB),PRC_UP(:,KKB),PRI_UP(:,KKB),ZRSATW(:),ZRSATI(:),OOCEAN=.FALSE.)
+!$mnh_expand_array(JI=D%NIB:D%NIE)
+PRC_UP(D%NIB:D%NIE,D%NKB)=0.
+PRI_UP(D%NIB:D%NIE,D%NKB)=0.
+!$mnh_end_expand_array(JI=D%NIB:D%NIE)
+CALL TH_R_FROM_THL_RT(CST,NEB,D%NIT,HFRAC_ICE,PFRAC_ICE_UP(:,D%NKB),ZPRES_F(:,D%NKB), &
+ PTHL_UP(:,D%NKB),PRT_UP(:,D%NKB),ZTH_UP(:,D%NKB), &
+ PRV_UP(:,D%NKB),PRC_UP(:,D%NKB),PRI_UP(:,D%NKB),ZRSATW(:),ZRSATI(:),OOCEAN=.FALSE.,&
+ PBUF=ZBUF, KB=D%NIB, KE=D%NIE)
-DO JI=1,IIJU
+DO JI=D%NIB,D%NIE
! compute updraft thevav and buoyancy term at KKB level
- PTHV_UP(JI,KKB) = ZTH_UP(JI,KKB)*((1+ZRVORD*PRV_UP(JI,KKB))/(1+PRT_UP(JI,KKB)))
+ PTHV_UP(JI,D%NKB) = ZTH_UP(JI,D%NKB)*((1+ZRVORD*PRV_UP(JI,D%NKB))/(1+PRT_UP(JI,D%NKB)))
! compute mean rsat in updraft
- PRSAT_UP(JI,KKB) = ZRSATW(JI)*(1-PFRAC_ICE_UP(JI,KKB)) + ZRSATI(JI)*PFRAC_ICE_UP(JI,KKB)
+ PRSAT_UP(JI,D%NKB) = ZRSATW(JI)*(1-PFRAC_ICE_UP(JI,D%NKB)) + ZRSATI(JI)*PFRAC_ICE_UP(JI,D%NKB)
ENDDO
!Tout est commente pour tester dans un premier temps la separation en deux de la
! boucle verticale, une pour w et une pour PEMF
-ZG_O_THVREF=XG/ZTHVM_F
+!$mnh_expand_array(JI=D%NIB:D%NIE,JK=1:D%NKT)
+ZG_O_THVREF(D%NIB:D%NIE,:)=CST%XG/ZTHVM_F(D%NIB:D%NIE,:)
+!$mnh_end_expand_array(JI=D%NIB:D%NIE,JK=1:D%NKT)
! Calcul de la fermeture de Julien Pergaut comme limite max de PHY
-DO JK=KKB,KKE-KKL,KKL ! Vertical loop
- DO JI=1,IIJU
- ZZDZ(JI,JK) = MAX(ZEPS,PZZ(JI,JK+KKL)-PZZ(JI,JK)) ! <== Delta Z between two flux level
+DO JK=D%NKB,D%NKE-D%NKL,D%NKL ! Vertical loop
+ DO JI=D%NIB,D%NIE
+ ZZDZ(JI,JK) = MAX(ZEPS,PZZ(JI,JK+D%NKL)-PZZ(JI,JK)) ! <== Delta Z between two flux level
ENDDO
ENDDO
! compute L_up
GLMIX=.TRUE.
-ZTKEM_F(:,KKB)=0.
+!$mnh_expand_array(JI=D%NIB:D%NIE)
+ZTKEM_F(D%NIB:D%NIE,D%NKB)=0.
+!$mnh_end_expand_array(JI=D%NIB:D%NIE)
!
-IF(CTURBLEN=='RM17') THEN
- ZDUDZ = MZF_MF(GZ_M_W_MF(PUM,PDZZ, KKA, KKU, KKL), KKA, KKU, KKL)
- ZDVDZ = MZF_MF(GZ_M_W_MF(PVM,PDZZ, KKA, KKU, KKL), KKA, KKU, KKL)
- ZSHEAR = SQRT(ZDUDZ*ZDUDZ + ZDVDZ*ZDVDZ)
+IF(TURB%CTURBLEN=='RM17') THEN
+ CALL GZ_M_W_MF(D, PUM, PDZZ, ZWK)
+ CALL MZF_MF(D, ZWK, ZDUDZ)
+ CALL GZ_M_W_MF(D, PVM, PDZZ, ZWK)
+ CALL MZF_MF(D, ZWK, ZDVDZ)
+ !$mnh_expand_array(JI=D%NIB:D%NIE,JK=1:D%NKT)
+ ZSHEAR(D%NIB:D%NIE,:) = SQRT(ZDUDZ(D%NIB:D%NIE,:)**2 + ZDVDZ(D%NIB:D%NIE,:)**2)
+ !$mnh_end_expand_array(JI=D%NIB:D%NIE,JK=1:D%NKT)
ELSE
- ZSHEAR = 0. !no shear in bl89 mixing length
+ ZSHEAR(D%NIB:D%NIE,:) = 0. !no shear in bl89 mixing length
END IF
!
-CALL COMPUTE_BL89_ML(KKA,KKB,KKE,KKU,KKL,PDZZ,ZTKEM_F(:,KKB),ZG_O_THVREF(:,KKB), &
- ZTHVM_F,KKB,GLMIX,.TRUE.,ZSHEAR,ZLUP)
-ZLUP(:)=MAX(ZLUP(:),1.E-10)
+CALL COMPUTE_BL89_ML(D, CST, CSTURB, PDZZ,ZTKEM_F(:,D%NKB),ZG_O_THVREF(:,D%NKB), &
+ ZTHVM_F,D%NKB,GLMIX,.TRUE.,ZSHEAR,ZLUP)
+!$mnh_expand_array(JI=D%NIB:D%NIE)
+ZLUP(D%NIB:D%NIE)=MAX(ZLUP(D%NIB:D%NIE),1.E-10)
+!$mnh_end_expand_array(JI=D%NIB:D%NIE)
-DO JI=1,IIJU
+DO JI=D%NIB,D%NIE
! Compute Buoyancy flux at the ground
- ZWTHVSURF = (ZTHVM_F(JI,KKB)/ZTHM_F(JI,KKB))*PSFTH(JI)+ &
- (0.61*ZTHM_F(JI,KKB))*PSFRV(JI)
+ ZWTHVSURF = (ZTHVM_F(JI,D%NKB)/ZTHM_F(JI,D%NKB))*PSFTH(JI)+ &
+ (0.61*ZTHM_F(JI,D%NKB))*PSFRV(JI)
! Mass flux at KKB level (updraft triggered if PSFTH>0.)
IF (ZWTHVSURF>0.010) THEN ! <== Not 0 Important to have stratocumulus !!!!!
- PEMF(JI,KKB) = XCMF * ZRHO_F(JI,KKB) * ((ZG_O_THVREF(JI,KKB))*ZWTHVSURF*ZLUP(JI))**(1./3.)
- PFRAC_UP(JI,KKB)=MIN(PEMF(JI,KKB)/(SQRT(ZW_UP2(JI,KKB))*ZRHO_F(JI,KKB)),XFRAC_UP_MAX)
+ PEMF(JI,D%NKB) = PARAMMF%XCMF * ZRHO_F(JI,D%NKB) * ((ZG_O_THVREF(JI,D%NKB))*ZWTHVSURF*ZLUP(JI))**(1./3.)
+ PFRAC_UP(JI,D%NKB)=MIN(PEMF(JI,D%NKB)/(SQRT(ZW_UP2(JI,D%NKB))*ZRHO_F(JI,D%NKB)),PARAMMF%XFRAC_UP_MAX)
!PEMF(JI,KKB) = ZRHO_F(JI,KKB)*PFRAC_UP(JI,KKB)*SQRT(ZW_UP2(JI,KKB))
- ZW_UP2(JI,KKB)=(PEMF(JI,KKB)/(PFRAC_UP(JI,KKB)*ZRHO_F(JI,KKB)))**2
+ ZW_UP2(JI,D%NKB)=(PEMF(JI,D%NKB)/(PFRAC_UP(JI,D%NKB)*ZRHO_F(JI,D%NKB)))**2
GTEST(JI)=.TRUE.
ELSE
- PEMF(JI,KKB) =0.
+ PEMF(JI,D%NKB) =0.
GTEST(JI)=.FALSE.
ENDIF
ENDDO
@@ -383,7 +406,7 @@ GTESTLCL(:)=.FALSE.
ZW_MAX(:) = 0.
ZZTOP(:) = 0.
-DO JK=KKB,KKE-KKL,KKL
+DO JK=D%NKB,D%NKE-D%NKL,D%NKL
! IF the updraft top is reached for all column, stop the loop on levels
@@ -396,7 +419,7 @@ DO JK=KKB,KKE-KKL,KKL
! to find the LCL (check if JK is LCL or not)
- DO JI=1,IIJU
+ DO JI=D%NIB,D%NIE
IF ((PRC_UP(JI,JK)+PRI_UP(JI,JK)>0.).AND.(.NOT.(GTESTLCL(JI)))) THEN
KKLCL(JI) = JK
GTESTLCL(JI)=.TRUE.
@@ -411,89 +434,92 @@ DO JK=KKB,KKE-KKL,KKL
! Compute theta_v of updraft at flux level JK
- ZRC_UP(:) =PRC_UP(:,JK) ! guess
- ZRI_UP(:) =PRI_UP(:,JK) ! guess
- ZRV_UP(:) =PRV_UP(:,JK)
- CALL TH_R_FROM_THL_RT_1D(HFRAC_ICE,PFRAC_ICE_UP(:,JK),&
+ !$mnh_expand_array(JI=D%NIB:D%NIE)
+ ZRC_UP(D%NIB:D%NIE) =PRC_UP(D%NIB:D%NIE,JK) ! guess
+ ZRI_UP(D%NIB:D%NIE) =PRI_UP(D%NIB:D%NIE,JK) ! guess
+ ZRV_UP(D%NIB:D%NIE) =PRV_UP(D%NIB:D%NIE,JK)
+ !$mnh_end_expand_array(JI=D%NIB:D%NIE)
+ CALL TH_R_FROM_THL_RT(CST,NEB, D%NIT, HFRAC_ICE,PFRAC_ICE_UP(:,JK),&
PPABSM(:,JK),PTHL_UP(:,JK),PRT_UP(:,JK),&
- ZTH_UP(:,JK),ZRV_UP,ZRC_UP,ZRI_UP,ZRSATW(:),ZRSATI(:),OOCEAN=.FALSE.)
+ ZTH_UP(:,JK),ZRV_UP,ZRC_UP,ZRI_UP,ZRSATW(:),ZRSATI(:),OOCEAN=.FALSE.,&
+ PBUF=ZBUF, KB=D%NIB, KE=D%NIE)
- DO JI=1,IIJU
+ DO JI=D%NIB,D%NIE
IF (GTEST(JI)) THEN
- PTHV_UP (JI,JK) = ZTH_UP(JI,JK)*(1.+ZRVORD*ZRV_UP(JI))/(1.+PRT_UP(JI,JK))
- ZBUO (JI,JK) = ZG_O_THVREF(JI,JK)*(PTHV_UP(JI,JK) - ZTHVM_F(JI,JK))
- PBUO_INTEG(JI,JK) = ZBUO(JI,JK)*(PZZ(JI,JK+KKL)-PZZ(JI,JK))
+ PTHV_UP(JI,JK) = ZTH_UP(JI,JK)*(1.+ZRVORD*ZRV_UP(JI))/(1.+PRT_UP(JI,JK))
+ ZBUO(JI,JK) = ZG_O_THVREF(JI,JK)*(PTHV_UP(JI,JK) - ZTHVM_F(JI,JK))
+ PBUO_INTEG(JI,JK) = ZBUO(JI,JK)*(PZZ(JI,JK+D%NKL)-PZZ(JI,JK))
- ZDZ(JI) = MAX(ZEPS,PZZ(JI,JK+KKL)-PZZ(JI,JK))
- ZTEST(JI) = XA1*ZBUO(JI,JK) - XB*ZW_UP2(JI,JK)
+ ZDZ(JI) = MAX(ZEPS,PZZ(JI,JK+D%NKL)-PZZ(JI,JK))
+ ZTEST(JI) = PARAMMF%XA1*ZBUO(JI,JK) - PARAMMF%XB*ZW_UP2(JI,JK)
! Ancien calcul de la vitesse
ZCOE(JI) = ZDZ(JI)
IF (ZTEST(JI)>0.) THEN
- ZCOE(JI) = ZDZ(JI)/(1.+ XBETA1)
+ ZCOE(JI) = ZDZ(JI)/(1.+ PARAMMF%XBETA1)
ENDIF
! Convective Vertical speed computation
- ZWCOE(JI) = (1.-XB*ZCOE(JI))/(1.+XB*ZCOE(JI))
- ZBUCOE(JI) = 2.*ZCOE(JI)/(1.+XB*ZCOE(JI))
+ ZWCOE(JI) = (1.-PARAMMF%XB*ZCOE(JI))/(1.+PARAMMF%XB*ZCOE(JI))
+ ZBUCOE(JI) = 2.*ZCOE(JI)/(1.+PARAMMF%XB*ZCOE(JI))
! Second Rachel bug correction (XA1 has been forgotten)
- ZW_UP2(JI,JK+KKL) = MAX(ZEPS,ZW_UP2(JI,JK)*ZWCOE(JI) + XA1*ZBUO(JI,JK)*ZBUCOE(JI) )
- ZW_MAX(JI) = MAX(ZW_MAX(JI), SQRT(ZW_UP2(JI,JK+KKL)))
- ZWUP_MEAN(JI) = MAX(ZEPS,0.5*(ZW_UP2(JI,JK+KKL)+ZW_UP2(JI,JK)))
+ ZW_UP2(JI,JK+D%NKL) = MAX(ZEPS,ZW_UP2(JI,JK)*ZWCOE(JI) + PARAMMF%XA1*ZBUO(JI,JK)*ZBUCOE(JI) )
+ ZW_MAX(JI) = MAX(ZW_MAX(JI), SQRT(ZW_UP2(JI,JK+D%NKL)))
+ ZWUP_MEAN(JI) = MAX(ZEPS,0.5*(ZW_UP2(JI,JK+D%NKL)+ZW_UP2(JI,JK)))
! Entrainement and detrainement
! First Rachel bug correction (Parenthesis around 1+beta1 ==> impact is small)
- PENTR(JI,JK) = MAX(0.,(XBETA1/(1.+XBETA1))*(XA1*ZBUO(JI,JK)/ZWUP_MEAN(JI)-XB))
- ZDETR_BUO(JI) = MAX(0., -(XBETA1/(1.+XBETA1))*XA1*ZBUO(JI,JK)/ZWUP_MEAN(JI))
- ZDETR_RT(JI) = XC*SQRT(MAX(0.,(PRT_UP(JI,JK) - ZRTM_F(JI,JK))) / MAX(ZEPS,ZRTM_F(JI,JK)) / ZWUP_MEAN(JI))
+ PENTR(JI,JK) = MAX(0.,(PARAMMF%XBETA1/(1.+PARAMMF%XBETA1))*(PARAMMF%XA1*ZBUO(JI,JK)/ZWUP_MEAN(JI)-PARAMMF%XB))
+ ZDETR_BUO(JI) = MAX(0., -(PARAMMF%XBETA1/(1.+PARAMMF%XBETA1))*PARAMMF%XA1*ZBUO(JI,JK)/ZWUP_MEAN(JI))
+ ZDETR_RT(JI) = PARAMMF%XC*SQRT(MAX(0.,(PRT_UP(JI,JK) - ZRTM_F(JI,JK))) / MAX(ZEPS,ZRTM_F(JI,JK)) / ZWUP_MEAN(JI))
PDETR(JI,JK) = ZDETR_RT(JI)+ZDETR_BUO(JI)
! If the updraft did not stop, compute cons updraft characteritics at jk+1
- ZZTOP(JI) = MAX(ZZTOP(JI),PZZ(JI,JK+KKL))
- ZMIX2(JI) = (PZZ(JI,JK+KKL)-PZZ(JI,JK))*PENTR(JI,JK) !&
+ ZZTOP(JI) = MAX(ZZTOP(JI),PZZ(JI,JK+D%NKL))
+ ZMIX2(JI) = (PZZ(JI,JK+D%NKL)-PZZ(JI,JK))*PENTR(JI,JK) !&
!ZQTM(JI) = PRTM(JI,JK)/(1.+PRTM(JI,JK))
!ZTHSM(JI,JK) = PTHLM(JI,JK)*(1.+XLAMBDA_MF*ZQTM(JI))
!ZTHS_UP(JI,JK+KKL)=(ZTHS_UP(JI,JK)*(1.-0.5*ZMIX2(JI)) + ZTHSM(JI,JK)*ZMIX2(JI)) &
! /(1.+0.5*ZMIX2(JI))
- PRT_UP(JI,JK+KKL) =(PRT_UP (JI,JK)*(1.-0.5*ZMIX2(JI)) + PRTM(JI,JK)*ZMIX2(JI)) &
+ PRT_UP(JI,JK+D%NKL) =(PRT_UP (JI,JK)*(1.-0.5*ZMIX2(JI)) + PRTM(JI,JK)*ZMIX2(JI)) &
/(1.+0.5*ZMIX2(JI))
!ZQT_UP(JI) = PRT_UP(JI,JK+KKL)/(1.+PRT_UP(JI,JK+KKL))
!PTHL_UP(JI,JK+KKL)=ZTHS_UP(JI,JK+KKL)/(1.+XLAMBDA_MF*ZQT_UP(JI))
- PTHL_UP(JI,JK+KKL)=(PTHL_UP(JI,JK)*(1.-0.5*ZMIX2(JI)) + PTHLM(JI,JK)*ZMIX2(JI)) &
+ PTHL_UP(JI,JK+D%NKL)=(PTHL_UP(JI,JK)*(1.-0.5*ZMIX2(JI)) + PTHLM(JI,JK)*ZMIX2(JI)) &
/(1.+0.5*ZMIX2(JI))
ENDIF ! GTEST
ENDDO
IF(OMIXUV) THEN
- IF(JK/=KKB) THEN
- DO JI=1,IIJU
+ IF(JK/=D%NKB) THEN
+ DO JI=D%NIB,D%NIE
IF(GTEST(JI)) THEN
- PU_UP(JI,JK+KKL) = (PU_UP (JI,JK)*(1-0.5*ZMIX2(JI)) + PUM(JI,JK)*ZMIX2(JI)+ &
- 0.5*XPRES_UV*(PZZ(JI,JK+KKL)-PZZ(JI,JK))*&
- ((PUM(JI,JK+KKL)-PUM(JI,JK))/PDZZ(JI,JK+KKL)+&
- (PUM(JI,JK)-PUM(JI,JK-KKL))/PDZZ(JI,JK)) ) &
+ PU_UP(JI,JK+D%NKL) = (PU_UP (JI,JK)*(1-0.5*ZMIX2(JI)) + PUM(JI,JK)*ZMIX2(JI)+ &
+ 0.5*PARAMMF%XPRES_UV*(PZZ(JI,JK+D%NKL)-PZZ(JI,JK))*&
+ ((PUM(JI,JK+D%NKL)-PUM(JI,JK))/PDZZ(JI,JK+D%NKL)+&
+ (PUM(JI,JK)-PUM(JI,JK-D%NKL))/PDZZ(JI,JK)) ) &
/(1+0.5*ZMIX2(JI))
- PV_UP(JI,JK+KKL) = (PV_UP (JI,JK)*(1-0.5*ZMIX2(JI)) + PVM(JI,JK)*ZMIX2(JI)+ &
- 0.5*XPRES_UV*(PZZ(JI,JK+KKL)-PZZ(JI,JK))*&
- ((PVM(JI,JK+KKL)-PVM(JI,JK))/PDZZ(JI,JK+KKL)+&
- (PVM(JI,JK)-PVM(JI,JK-KKL))/PDZZ(JI,JK)) ) &
+ PV_UP(JI,JK+D%NKL) = (PV_UP (JI,JK)*(1-0.5*ZMIX2(JI)) + PVM(JI,JK)*ZMIX2(JI)+ &
+ 0.5*PARAMMF%XPRES_UV*(PZZ(JI,JK+D%NKL)-PZZ(JI,JK))*&
+ ((PVM(JI,JK+D%NKL)-PVM(JI,JK))/PDZZ(JI,JK+D%NKL)+&
+ (PVM(JI,JK)-PVM(JI,JK-D%NKL))/PDZZ(JI,JK)) ) &
/(1+0.5*ZMIX2(JI))
ENDIF
ENDDO
ELSE
- DO JI=1,IIJU
+ DO JI=D%NIB,D%NIE
IF(GTEST(JI)) THEN
- PU_UP(JI,JK+KKL) = (PU_UP (JI,JK)*(1-0.5*ZMIX2(JI)) + PUM(JI,JK)*ZMIX2(JI)+ &
- 0.5*XPRES_UV*(PZZ(JI,JK+KKL)-PZZ(JI,JK))*&
- ((PUM(JI,JK+KKL)-PUM(JI,JK))/PDZZ(JI,JK+KKL)) ) &
+ PU_UP(JI,JK+D%NKL) = (PU_UP (JI,JK)*(1-0.5*ZMIX2(JI)) + PUM(JI,JK)*ZMIX2(JI)+ &
+ 0.5*PARAMMF%XPRES_UV*(PZZ(JI,JK+D%NKL)-PZZ(JI,JK))*&
+ ((PUM(JI,JK+D%NKL)-PUM(JI,JK))/PDZZ(JI,JK+D%NKL)) ) &
/(1+0.5*ZMIX2(JI))
- PV_UP(JI,JK+KKL) = (PV_UP (JI,JK)*(1-0.5*ZMIX2(JI)) + PVM(JI,JK)*ZMIX2(JI)+ &
- 0.5*XPRES_UV*(PZZ(JI,JK+KKL)-PZZ(JI,JK))*&
- ((PVM(JI,JK+KKL)-PVM(JI,JK))/PDZZ(JI,JK+KKL)) ) &
+ PV_UP(JI,JK+D%NKL) = (PV_UP (JI,JK)*(1-0.5*ZMIX2(JI)) + PVM(JI,JK)*ZMIX2(JI)+ &
+ 0.5*PARAMMF%XPRES_UV*(PZZ(JI,JK+D%NKL)-PZZ(JI,JK))*&
+ ((PVM(JI,JK+D%NKL)-PVM(JI,JK))/PDZZ(JI,JK+D%NKL)) ) &
/(1+0.5*ZMIX2(JI))
ENDIF
ENDDO
@@ -504,87 +530,94 @@ DO JK=KKB,KKE-KKL,KKL
! DO JSV=1,ISV
! IF (ONOMIXLG .AND. JSV >= KSV_LGBEG .AND. JSV<= KSV_LGEND) CYCLE
! WHERE(GTEST)
-! PSV_UP(:,JK+KKL,JSV) = (PSV_UP (:,JK,JSV)*(1-0.5*ZMIX2(:)) + &
-! PSVM(:,JK,JSV)*ZMIX2(:)) /(1+0.5*ZMIX2(:))
+! PSV_UP(D%NIB:D%NIE,JK+KKL,JSV) = (PSV_UP (D%NIB:D%NIE,JK,JSV)*(1-0.5*ZMIX2(D%NIB:D%NIE)) + &
+! PSVM(D%NIB:D%NIE,JK,JSV)*ZMIX2(D%NIB:D%NIE)) /(1+0.5*ZMIX2(D%NIB:D%NIE))
! ENDWHERE
! ENDDO
-! Compute non cons. var. at level JK+KKL
- ZRC_UP(:)=PRC_UP(:,JK) ! guess = level just below
- ZRI_UP(:)=PRI_UP(:,JK) ! guess = level just below
- ZRV_UP(:)=PRV_UP(:,JK)
- CALL TH_R_FROM_THL_RT_1D(HFRAC_ICE,PFRAC_ICE_UP(:,JK+KKL),ZPRES_F(:,JK+KKL), &
- PTHL_UP(:,JK+KKL),PRT_UP(:,JK+KKL),ZTH_UP(:,JK+KKL), &
- ZRV_UP(:),ZRC_UP(:),ZRI_UP(:),ZRSATW(:),ZRSATI(:),OOCEAN=.FALSE.)
-
- DO JI=1,IIJU
+ ! Compute non cons. var. at level JK+KKL
+ !$mnh_expand_array(JI=D%NIB:D%NIE)
+ ZRC_UP(D%NIB:D%NIE)=PRC_UP(D%NIB:D%NIE,JK) ! guess = level just below
+ ZRI_UP(D%NIB:D%NIE)=PRI_UP(D%NIB:D%NIE,JK) ! guess = level just below
+ ZRV_UP(D%NIB:D%NIE)=PRV_UP(D%NIB:D%NIE,JK)
+ !$mnh_end_expand_array(JI=D%NIB:D%NIE)
+ CALL TH_R_FROM_THL_RT(CST,NEB, D%NIT, HFRAC_ICE,PFRAC_ICE_UP(:,JK+D%NKL),ZPRES_F(:,JK+D%NKL), &
+ PTHL_UP(:,JK+D%NKL),PRT_UP(:,JK+D%NKL),ZTH_UP(:,JK+D%NKL), &
+ ZRV_UP(:),ZRC_UP(:),ZRI_UP(:),ZRSATW(:),ZRSATI(:),OOCEAN=.FALSE.,&
+ PBUF=ZBUF, KB=D%NIB, KE=D%NIE)
+
+ DO JI=D%NIB,D%NIE
IF(GTEST(JI)) THEN
!ZT_UP(JI) = ZTH_UP(JI,JK+KKL)*PEXNM(JI,JK+KKL)
!ZCP(JI) = XCPD + XCL * ZRC_UP(JI)
!ZLVOCPEXN(JI)=(XLVTT + (XCPV-XCL) * (ZT_UP(JI)-XTT) ) / ZCP(JI) / PEXNM(JI,JK+KKL)
!PRC_UP(JI,JK+KKL)=MIN(0.5E-3,ZRC_UP(JI)) ! On ne peut depasser 0.5 g/kg (autoconversion donc elimination !)
!PTHL_UP(JI,JK+KKL) = PTHL_UP(JI,JK+KKL)+ZLVOCPEXN(JI)*(ZRC_UP(JI)-PRC_UP(JI,JK+KKL))
- PRC_UP(JI,JK+KKL)=ZRC_UP(JI)
- PRV_UP(JI,JK+KKL)=ZRV_UP(JI)
- PRI_UP(JI,JK+KKL)=ZRI_UP(JI)
+ PRC_UP(JI,JK+D%NKL)=ZRC_UP(JI)
+ PRV_UP(JI,JK+D%NKL)=ZRV_UP(JI)
+ PRI_UP(JI,JK+D%NKL)=ZRI_UP(JI)
!PRT_UP(JI,JK+KKL) = PRC_UP(JI,JK+KKL) + PRV_UP(JI,JK+KKL)
- PRSAT_UP(JI,JK+KKL) = ZRSATW(JI)*(1-PFRAC_ICE_UP(JI,JK+KKL)) + ZRSATI(JI)*PFRAC_ICE_UP(JI,JK+KKL)
+ PRSAT_UP(JI,JK+D%NKL) = ZRSATW(JI)*(1-PFRAC_ICE_UP(JI,JK+D%NKL)) + ZRSATI(JI)*PFRAC_ICE_UP(JI,JK+D%NKL)
! Compute the updraft theta_v, buoyancy and w**2 for level JK+1
- !PTHV_UP(:,JK+KKL) = PTH_UP(:,JK+KKL)*((1+ZRVORD*PRV_UP(:,JK+KKL))/(1+PRT_UP(:,JK+KKL)))
+ !PTHV_UP(D%NIB:D%NIE,JK+KKL) = PTH_UP(D%NIB:D%NIE,JK+KKL)*((1+ZRVORD*PRV_UP(D%NIB:D%NIE,JK+KKL))/(1+PRT_UP(D%NIB:D%NIE,JK+KKL)))
!PTHV_UP(JI,JK+KKL) = ZTH_UP(JI,JK+KKL)*(1.+0.608*PRV_UP(JI,JK+KKL) - PRC_UP(JI,JK+KKL))
!! A corriger pour utiliser q et non r !!!!
!ZMIX1(JI)=ZZDZ(JI,JK)*(PENTR(JI,JK)-PDETR(JI,JK))
- PTHV_UP(JI,JK+KKL) = ZTH_UP(JI,JK+KKL)*((1+ZRVORD*PRV_UP(JI,JK+KKL))/(1+PRT_UP(JI,JK+KKL)))
+ PTHV_UP(JI,JK+D%NKL) = ZTH_UP(JI,JK+D%NKL)*((1+ZRVORD*PRV_UP(JI,JK+D%NKL))/(1+PRT_UP(JI,JK+D%NKL)))
ZMIX1(JI)=ZZDZ(JI,JK)*(PENTR(JI,JK)-PDETR(JI,JK))
ENDIF
ENDDO
- DO JI=1,IIJU
+ DO JI=D%NIB,D%NIB
IF(GTEST(JI)) THEN
- PEMF(JI,JK+KKL)=PEMF(JI,JK)*EXP(ZMIX1(JI))
+ PEMF(JI,JK+D%NKL)=PEMF(JI,JK)*EXP(ZMIX1(JI))
ENDIF
ENDDO
- DO JI=1,IIJU
+ DO JI=D%NIB,D%NIE
IF(GTEST(JI)) THEN
! Updraft fraction must be smaller than XFRAC_UP_MAX
- PFRAC_UP(JI,JK+KKL)=MIN(XFRAC_UP_MAX, &
- &PEMF(JI,JK+KKL)/(SQRT(ZW_UP2(JI,JK+KKL))*ZRHO_F(JI,JK+KKL)))
+ PFRAC_UP(JI,JK+D%NKL)=MIN(PARAMMF%XFRAC_UP_MAX, &
+ &PEMF(JI,JK+D%NKL)/(SQRT(ZW_UP2(JI,JK+D%NKL))*ZRHO_F(JI,JK+D%NKL)))
!PEMF(JI,JK+KKL) = ZRHO_F(JI,JK+KKL)*PFRAC_UP(JI,JK+KKL)*SQRT(ZW_UP2(JI,JK+KKL))
ENDIF
ENDDO
! Test if the updraft has reach the ETL
- DO JI=1,IIJU
+ DO JI=D%NIB,D%NIE
IF (GTEST(JI) .AND. (PBUO_INTEG(JI,JK)<=0.)) THEN
- KKETL(JI) = JK+KKL
+ KKETL(JI) = JK+D%NKL
ENDIF
ENDDO
! Test is we have reached the top of the updraft
- DO JI=1,IIJU
- IF (GTEST(JI) .AND. ((ZW_UP2(JI,JK+KKL)<=ZEPS).OR.(PEMF(JI,JK+KKL)<=ZEPS))) THEN
- ZW_UP2 (JI,JK+KKL)=ZEPS
- PEMF (JI,JK+KKL)=0.
+ DO JI=D%NIB,D%NIB
+ IF (GTEST(JI) .AND. ((ZW_UP2(JI,JK+D%NKL)<=ZEPS).OR.(PEMF(JI,JK+D%NKL)<=ZEPS))) THEN
+ ZW_UP2 (JI,JK+D%NKL)=ZEPS
+ PEMF (JI,JK+D%NKL)=0.
GTEST (JI) =.FALSE.
- PTHL_UP (JI,JK+KKL)=ZTHLM_F(JI,JK+KKL)
- PRT_UP (JI,JK+KKL)=ZRTM_F(JI,JK+KKL)
- PRC_UP (JI,JK+KKL)=0.
- PRI_UP (JI,JK+KKL)=0.
- PRV_UP (JI,JK+KKL)=ZRVM_F (JI,JK+KKL)
- PTHV_UP (JI,JK+KKL)=ZTHVM_F(JI,JK+KKL)
- PFRAC_UP (JI,JK+KKL)=0.
- KKCTL (JI) =JK+KKL
+ PTHL_UP (JI,JK+D%NKL)=ZTHLM_F(JI,JK+D%NKL)
+ PRT_UP (JI,JK+D%NKL)=ZRTM_F(JI,JK+D%NKL)
+ PRC_UP (JI,JK+D%NKL)=0.
+ PRI_UP (JI,JK+D%NKL)=0.
+ PRV_UP (JI,JK+D%NKL)=ZRVM_F (JI,JK+D%NKL)
+ PTHV_UP (JI,JK+D%NKL)=ZTHVM_F(JI,JK+D%NKL)
+ PFRAC_UP (JI,JK+D%NKL)=0.
+ KKCTL (JI) =JK+D%NKL
ENDIF
ENDDO
ENDDO ! Fin de la boucle verticale
-PW_UP(:,:)=SQRT(ZW_UP2(:,:))
-PEMF(:,KKB) =0.
+!$mnh_expand_array(JI=D%NIB:D%NIE,JK=1:D%NKT)
+PW_UP(D%NIB:D%NIE,:)=SQRT(ZW_UP2(D%NIB:D%NIE,:))
+!$mnh_end_expand_array(JI=D%NIB:D%NIE,JK=1:D%NKT)
+!$mnh_expand_array(JI=D%NIB:D%NIE)
+PEMF(D%NIB:D%NIE,D%NKB) =0.
+!$mnh_end_expand_array(JI=D%NIB:D%NIE)
! Limits the shallow convection scheme when cloud heigth is higher than 3000m.
! To do this, mass flux is multiplied by a coefficient decreasing linearly
@@ -592,16 +625,22 @@ PEMF(:,KKB) =0.
! This way, all MF fluxes are diminished by this amount.
! Diagnosed cloud fraction is also multiplied by the same coefficient.
!
-DO JI=1,IIJU
+DO JI=D%NIB,D%NIE
PDEPTH(JI) = MAX(0., PZZ(JI,KKCTL(JI)) - PZZ(JI,KKLCL(JI)) )
ENDDO
-GWORK1(:)= (GTESTLCL(:) .AND. (PDEPTH(:) > ZDEPTH_MAX1) )
-GWORK2(:,:) = SPREAD( GWORK1(:), DIM=2, NCOPIES=IKU )
-ZCOEF(:,:) = SPREAD( (1.-(PDEPTH(:)-ZDEPTH_MAX1)/(ZDEPTH_MAX2-ZDEPTH_MAX1)), DIM=2, NCOPIES=IKU)
-ZCOEF(:,:)=MIN(MAX(ZCOEF(:,:),0.),1.)
-DO JK=1, IKU
- DO JI=1,IIJU
+!$mnh_expand_array(JI=D%NIB:D%NIE)
+GWORK1(D%NIB:D%NIE)= (GTESTLCL(D%NIB:D%NIE) .AND. (PDEPTH(D%NIB:D%NIE) > ZDEPTH_MAX1) )
+!$mnh_end_expand_array(JI=D%NIB:D%NIE)
+DO JK=1,D%NKT
+ !$mnh_expand_array(JI=D%NIB:D%NIE)
+ GWORK2(D%NIB:D%NIE,JK) = GWORK1(D%NIB:D%NIE)
+ ZCOEF(D%NIB:D%NIE,JK) = (1.-(PDEPTH(D%NIB:D%NIE)-ZDEPTH_MAX1)/(ZDEPTH_MAX2-ZDEPTH_MAX1))
+ ZCOEF(D%NIB:D%NIE,JK)=MIN(MAX(ZCOEF(D%NIB:D%NIE,JK),0.),1.)
+ !$mnh_end_expand_array(JI=D%NIB:D%NIE)
+ENDDO
+DO JK=1, D%NKT
+ DO JI=D%NIB,D%NIE
IF (GWORK2(JI,JK)) THEN
PEMF(JI,JK) = PEMF(JI,JK) * ZCOEF(JI,JK)
PFRAC_UP(JI,JK) = PFRAC_UP(JI,JK) * ZCOEF(JI,JK)
@@ -610,6 +649,10 @@ DO JK=1, IKU
ENDDO
IF (LHOOK) CALL DR_HOOK('COMPUTE_UPDRAFT_RHCJ10',1,ZHOOK_HANDLE)
-
+!
+CONTAINS
+INCLUDE "th_r_from_thl_rt.func.h"
+INCLUDE "compute_frac_ice.func.h"
+!
END SUBROUTINE COMPUTE_UPDRAFT_RHCJ10
END MODULE MODE_COMPUTE_UPDRAFT_RHCJ10
diff --git a/src/common/turb/mode_mf_turb.F90 b/src/common/turb/mode_mf_turb.F90
index 7f9e698ce2f108aa9b5fc33d8a6ccbfdaa2f0d40..537e16c14db54119da557d425da69494ccd0b387 100644
--- a/src/common/turb/mode_mf_turb.F90
+++ b/src/common/turb/mode_mf_turb.F90
@@ -8,7 +8,7 @@
!
IMPLICIT NONE
CONTAINS
- SUBROUTINE MF_TURB(KKA,KKB,KKE,KKU,KKL,OMIXUV, &
+ SUBROUTINE MF_TURB(D, KSV, OMIXUV, &
ONOMIXLG,KSV_LGBEG,KSV_LGEND, &
PIMPL, PTSTEP, &
PDZZ, &
@@ -62,26 +62,22 @@ CONTAINS
!* 0. DECLARATIONS
! ------------
!
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+!
USE MODI_SHUMAN_MF, ONLY: MZM_MF
USE MODE_TRIDIAG_MASSFLUX, ONLY: TRIDIAG_MASSFLUX
!
USE PARKIND1, ONLY : JPRB
USE YOMHOOK , ONLY : LHOOK, DR_HOOK
!
-USE PARKIND1, ONLY : JPRB
-USE YOMHOOK , ONLY : LHOOK, DR_HOOK
-!
IMPLICIT NONE
!
!
!* 0.1 declarations of arguments
!
!
-INTEGER, INTENT(IN) :: KKA ! near ground array index
-INTEGER, INTENT(IN) :: KKB ! near ground physical index
-INTEGER, INTENT(IN) :: KKE ! uppest atmosphere physical index
-INTEGER, INTENT(IN) :: KKU ! uppest atmosphere array index
-INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+INTEGER, INTENT(IN) :: KSV
LOGICAL, INTENT(IN) :: OMIXUV ! True if mixing of momentum
LOGICAL, INTENT(IN) :: ONOMIXLG ! False if mixing of lagrangian tracer
INTEGER, INTENT(IN) :: KSV_LGBEG ! first index of lag. tracer
@@ -89,39 +85,39 @@ INTEGER, INTENT(IN) :: KSV_LGEND ! last index of lag. tracer
REAL, INTENT(IN) :: PIMPL ! degree of implicitness
REAL, INTENT(IN) :: PTSTEP ! Dynamical timestep
!
-REAL, DIMENSION(:,:), INTENT(IN) :: PDZZ ! metric coefficients
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(IN) :: PDZZ ! metric coefficients
-REAL, DIMENSION(:,:), INTENT(IN) :: PRHODJ ! dry density * Grid size
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(IN) :: PRHODJ ! dry density * Grid size
! Conservative var. at t-dt
-REAL, DIMENSION(:,:), INTENT(IN) :: PTHLM ! conservative pot. temp.
-REAL, DIMENSION(:,:), INTENT(IN) :: PRTM ! water var. where
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(IN) :: PTHLM ! conservative pot. temp.
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(IN) :: PRTM ! water var. where
! Virtual potential temperature at t-dt
-REAL, DIMENSION(:,:), INTENT(IN) :: PTHVM
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(IN) :: PTHVM
! Momentum at t-dt
-REAL, DIMENSION(:,:), INTENT(IN) :: PUM
-REAL, DIMENSION(:,:), INTENT(IN) :: PVM
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(IN) :: PUM
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(IN) :: PVM
! scalar variables at t-dt
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSVM
+REAL, DIMENSION(D%NIT,D%NKT,KSV), INTENT(IN) :: PSVM
!
! Tendencies of conservative variables
-REAL, DIMENSION(:,:), INTENT(OUT) :: PTHLDT
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(OUT) :: PTHLDT
-REAL, DIMENSION(:,:), INTENT(OUT) :: PRTDT
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(OUT) :: PRTDT
! Tendencies of momentum
-REAL, DIMENSION(:,:), INTENT(OUT) :: PUDT
-REAL, DIMENSION(:,:), INTENT(OUT) :: PVDT
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(OUT) :: PUDT
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(OUT) :: PVDT
! Tendencies of scalar variables
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSVDT
+REAL, DIMENSION(D%NIT,D%NKT,KSV), INTENT(OUT) :: PSVDT
! Updraft characteritics
-REAL, DIMENSION(:,:), INTENT(IN) :: PEMF,PTHL_UP,PTHV_UP,PRT_UP,PU_UP,PV_UP
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSV_UP
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(IN) :: PEMF,PTHL_UP,PTHV_UP,PRT_UP,PU_UP,PV_UP
+REAL, DIMENSION(D%NIT,D%NKT,KSV), INTENT(IN) :: PSV_UP
! Fluxes
-REAL, DIMENSION(:,:), INTENT(OUT) :: PFLXZTHMF,PFLXZTHVMF,PFLXZRMF,PFLXZUMF,PFLXZVMF
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(OUT) :: PFLXZTHMF,PFLXZTHVMF,PFLXZRMF,PFLXZUMF,PFLXZVMF
-REAL, DIMENSION(:,:,:), INTENT(OUT):: PFLXZSVMF
+REAL, DIMENSION(D%NIT,D%NKT,KSV), INTENT(OUT):: PFLXZSVMF
!
!
!
@@ -130,8 +126,9 @@ REAL, DIMENSION(:,:,:), INTENT(OUT):: PFLXZSVMF
! 0.2 declaration of local variables
!
-REAL, DIMENSION(SIZE(PTHLM,1),SIZE(PTHLM,2)) :: ZVARS
-INTEGER :: ISV,JSV !number of scalar variables and Loop counter
+REAL, DIMENSION(D%NIT,D%NKT) :: ZVARS
+INTEGER :: JSV !number of scalar variables and Loop counter
+INTEGER :: JI, JK
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!----------------------------------------------------------------------------
@@ -140,10 +137,6 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
! -------------
!
IF (LHOOK) CALL DR_HOOK('MF_TURB',0,ZHOOK_HANDLE)
-!
-! number of scalar var
-ISV=SIZE(PSVM,3)
-
!
PFLXZSVMF = 0.
PSVDT = 0.
@@ -158,15 +151,23 @@ PSVDT = 0.
! ( Resulting fluxes are in flux level (w-point) as PEMF and PTHL_UP )
!
-PFLXZTHMF(:,:) = PEMF(:,:)*(PTHL_UP(:,:)-MZM_MF(PTHLM(:,:), KKA, KKU, KKL))
+CALL MZM_MF(D, PTHLM(:,:), PFLXZTHMF(:,:))
+CALL MZM_MF(D, PRTM(:,:), PFLXZRMF(:,:))
+CALL MZM_MF(D, PTHVM(:,:), PFLXZTHVMF(:,:))
-PFLXZRMF(:,:) = PEMF(:,:)*(PRT_UP(:,:)-MZM_MF(PRTM(:,:), KKA, KKU, KKL))
-
-PFLXZTHVMF(:,:) = PEMF(:,:)*(PTHV_UP(:,:)-MZM_MF(PTHVM(:,:), KKA, KKU, KKL))
+!$mnh_expand_array(JI=D%NIB:D%NIE,JK=D%NKTB:D%NKTE)
+PFLXZTHMF(D%NIB:D%NIE,:) = PEMF(D%NIB:D%NIE,:)*(PTHL_UP(D%NIB:D%NIE,:)-PFLXZTHMF(D%NIB:D%NIE,:))
+PFLXZRMF(D%NIB:D%NIE,:) = PEMF(D%NIB:D%NIE,:)*(PRT_UP(D%NIB:D%NIE,:)-PFLXZRMF(D%NIB:D%NIE,:))
+PFLXZTHVMF(D%NIB:D%NIE,:) = PEMF(D%NIB:D%NIE,:)*(PTHV_UP(D%NIB:D%NIE,:)-PFLXZTHVMF(D%NIB:D%NIE,:))
+!$mnh_end_expand_array(JI=D%NIB:D%NIE,JK=D%NKTB:D%NKTE)
IF (OMIXUV) THEN
- PFLXZUMF(:,:) = PEMF(:,:)*(PU_UP(:,:)-MZM_MF(PUM(:,:), KKA, KKU, KKL))
- PFLXZVMF(:,:) = PEMF(:,:)*(PV_UP(:,:)-MZM_MF(PVM(:,:), KKA, KKU, KKL))
+ CALL MZM_MF(D, PUM(:,:), PFLXZUMF(:,:))
+ CALL MZM_MF(D, PVM(:,:), PFLXZVMF(:,:))
+ !$mnh_expand_array(JI=D%NIB:D%NIE,JK=D%NKTB:D%NKTE)
+ PFLXZUMF(D%NIB:D%NIE,:) = PEMF(D%NIB:D%NIE,:)*(PU_UP(D%NIB:D%NIE,:)-PFLXZUMF(D%NIB:D%NIE,:))
+ PFLXZVMF(D%NIB:D%NIE,:) = PEMF(D%NIB:D%NIE,:)*(PV_UP(D%NIB:D%NIE,:)-PFLXZVMF(D%NIB:D%NIE,:))
+ !$mnh_end_expand_array(JI=D%NIB:D%NIE,JK=D%NKTB:D%NKTE)
ELSE
PFLXZUMF(:,:) = 0.
PFLXZVMF(:,:) = 0.
@@ -185,25 +186,26 @@ ENDIF
! 3.1 Compute the tendency for the conservative potential temperature
! (PDZZ and flux in w-point and PRHODJ is mass point, result in mass point)
!
-CALL TRIDIAG_MASSFLUX(KKA,KKB,KKE,KKU,KKL,PTHLM,PFLXZTHMF,-PEMF,PTSTEP,PIMPL, &
+CALL TRIDIAG_MASSFLUX(D,PTHLM,PFLXZTHMF,-PEMF,PTSTEP,PIMPL, &
PDZZ,PRHODJ,ZVARS )
-! compute new flux
-PFLXZTHMF(:,:) = PEMF(:,:)*(PTHL_UP(:,:)-MZM_MF(ZVARS(:,:), KKA, KKU, KKL))
-
-!!! compute THL tendency
-!
-PTHLDT(:,:)= (ZVARS(:,:)-PTHLM(:,:))/PTSTEP
+! compute new flux and THL tendency
+CALL MZM_MF(D, ZVARS(:,:), PFLXZTHMF(:,:))
+!$mnh_expand_array(JI=D%NIB:D%NIE,JK=D%NKTB:D%NKTE)
+PFLXZTHMF(D%NIB:D%NIE,:) = PEMF(D%NIB:D%NIE,:)*(PTHL_UP(D%NIB:D%NIE,:)-PFLXZTHMF(D%NIB:D%NIE,:))
+PTHLDT(D%NIB:D%NIE,:)= (ZVARS(D%NIB:D%NIE,:)-PTHLM(D%NIB:D%NIE,:))/PTSTEP
+!$mnh_end_expand_array(JI=D%NIB:D%NIE,JK=D%NKTB:D%NKTE)
!
! 3.2 Compute the tendency for the conservative mixing ratio
!
-CALL TRIDIAG_MASSFLUX(KKA,KKB,KKE,KKU,KKL,PRTM(:,:),PFLXZRMF,-PEMF,PTSTEP,PIMPL, &
+CALL TRIDIAG_MASSFLUX(D,PRTM(:,:),PFLXZRMF,-PEMF,PTSTEP,PIMPL, &
PDZZ,PRHODJ,ZVARS )
-! compute new flux
-PFLXZRMF(:,:) = PEMF(:,:)*(PRT_UP(:,:)-MZM_MF(ZVARS(:,:), KKA, KKU, KKL))
-
-!!! compute RT tendency
-PRTDT(:,:) = (ZVARS(:,:)-PRTM(:,:))/PTSTEP
+! compute new flux and RT tendency
+CALL MZM_MF(D, ZVARS(:,:), PFLXZRMF(:,:))
+!$mnh_expand_array(JI=D%NIB:D%NIE,JK=D%NKTB:D%NKTE)
+PFLXZRMF(D%NIB:D%NIE,:) = PEMF(D%NIB:D%NIE,:)*(PRT_UP(D%NIB:D%NIE,:)-PFLXZRMF(D%NIB:D%NIE,:))
+PRTDT(D%NIB:D%NIE,:) = (ZVARS(D%NIB:D%NIE,:)-PRTM(D%NIB:D%NIE,:))/PTSTEP
+!$mnh_end_expand_array(JI=D%NIB:D%NIE,JK=D%NKTB:D%NKTE)
!
IF (OMIXUV) THEN
@@ -212,52 +214,56 @@ IF (OMIXUV) THEN
! (PDZZ and flux in w-point and PRHODJ is mass point, result in mass point)
!
- CALL TRIDIAG_MASSFLUX(KKA,KKB,KKE,KKU,KKL,PUM,PFLXZUMF,-PEMF,PTSTEP,PIMPL, &
+ CALL TRIDIAG_MASSFLUX(D,PUM,PFLXZUMF,-PEMF,PTSTEP,PIMPL, &
PDZZ,PRHODJ,ZVARS )
- ! compute new flux
- PFLXZUMF(:,:) = PEMF(:,:)*(PU_UP(:,:)-MZM_MF(ZVARS(:,:), KKA, KKU, KKL))
-
- ! compute U tendency
- PUDT(:,:)= (ZVARS(:,:)-PUM(:,:))/PTSTEP
-
+ ! compute new flux and U tendency
+ CALL MZM_MF(D, ZVARS(:,:), PFLXZUMF(:,:))
+ !$mnh_expand_array(JI=D%NIB:D%NIE,JK=D%NKTB:D%NKTE)
+ PFLXZUMF(D%NIB:D%NIE,:) = PEMF(D%NIB:D%NIE,:)*(PU_UP(D%NIB:D%NIE,:)-PFLXZUMF(D%NIB:D%NIE,:))
+ PUDT(D%NIB:D%NIE,:)= (ZVARS(D%NIB:D%NIE,:)-PUM(D%NIB:D%NIE,:))/PTSTEP
+ !$mnh_end_expand_array(JI=D%NIB:D%NIE,JK=D%NKTB:D%NKTE)
!
!
! 3.4 Compute the tendency for the (non conservative but treated as it for the time beiing)
! meridian momentum
! (PDZZ and flux in w-point and PRHODJ is mass point, result in mass point)
!
- CALL TRIDIAG_MASSFLUX(KKA,KKB,KKE,KKU,KKL,PVM,PFLXZVMF,-PEMF,PTSTEP,PIMPL, &
+ CALL TRIDIAG_MASSFLUX(D,PVM,PFLXZVMF,-PEMF,PTSTEP,PIMPL, &
PDZZ,PRHODJ,ZVARS )
- ! compute new flux
- PFLXZVMF(:,:) = PEMF(:,:)*(PV_UP(:,:)-MZM_MF(ZVARS(:,:), KKA, KKU, KKL))
-
- ! compute V tendency
- PVDT(:,:)= (ZVARS(:,:)-PVM(:,:))/PTSTEP
+ ! compute new flux and V tendency
+ CALL MZM_MF(D, ZVARS(:,:), PFLXZVMF(:,:))
+ !$mnh_expand_array(JI=D%NIB:D%NIE,JK=D%NKTB:D%NKTE)
+ PFLXZVMF(D%NIB:D%NIE,:) = PEMF(D%NIB:D%NIE,:)*(PV_UP(D%NIB:D%NIE,:)-PFLXZVMF(D%NIB:D%NIE,:))
+ PVDT(D%NIB:D%NIE,:)= (ZVARS(D%NIB:D%NIE,:)-PVM(D%NIB:D%NIE,:))/PTSTEP
+ !$mnh_end_expand_array(JI=D%NIB:D%NIE,JK=D%NKTB:D%NKTE)
ELSE
PUDT(:,:)=0.
PVDT(:,:)=0.
ENDIF
-DO JSV=1,ISV
+DO JSV=1,KSV
IF (ONOMIXLG .AND. JSV >= KSV_LGBEG .AND. JSV<= KSV_LGEND) CYCLE
!* compute mean flux of scalar variables at time t-dt
! ( Resulting fluxes are in flux level (w-point) as PEMF and PTHL_UP )
- PFLXZSVMF(:,:,JSV) = PEMF(:,:)*(PSV_UP(:,:,JSV)-MZM_MF(PSVM(:,:,JSV), KKA, KKU, KKL))
-
+ CALL MZM_MF(D, PSVM(:,:,JSV), PFLXZSVMF(:,:,JSV))
+ !$mnh_expand_array(JI=D%NIB:D%NIE,JK=D%NKTB:D%NKTE)
+ PFLXZSVMF(D%NIB:D%NIE,:,JSV) = PEMF(D%NIB:D%NIE,:)*(PSV_UP(D%NIB:D%NIE,:,JSV)-PFLXZSVMF(D%NIB:D%NIE,:,JSV))
+ !$mnh_end_expand_array(JI=D%NIB:D%NIE,JK=D%NKTB:D%NKTE)
!
! 3.5 Compute the tendency for scalar variables
! (PDZZ and flux in w-point and PRHODJ is mass point, result in mass point)
!
- CALL TRIDIAG_MASSFLUX(KKA,KKB,KKE,KKU,KKL,PSVM(:,:,JSV),PFLXZSVMF(:,:,JSV),&
+ CALL TRIDIAG_MASSFLUX(D,PSVM(:,:,JSV),PFLXZSVMF(:,:,JSV),&
-PEMF,PTSTEP,PIMPL,PDZZ,PRHODJ,ZVARS )
- ! compute new flux
- PFLXZSVMF(:,:,JSV) = PEMF(:,:)*(PSV_UP(:,:,JSV)-MZM_MF(ZVARS, KKA, KKU, KKL))
-
- ! compute Sv tendency
- PSVDT(:,:,JSV)= (ZVARS(:,:)-PSVM(:,:,JSV))/PTSTEP
+ ! compute new flux and Sv tendency
+ CALL MZM_MF(D, ZVARS, PFLXZSVMF(:,:,JSV))
+ !$mnh_expand_array(JI=D%NIB:D%NIE,JK=D%NKTB:D%NKTE)
+ PFLXZSVMF(D%NIB:D%NIE,:,JSV) = PEMF(D%NIB:D%NIE,:)*(PSV_UP(D%NIB:D%NIE,:,JSV)-PFLXZSVMF(D%NIB:D%NIE,:,JSV))
+ PSVDT(D%NIB:D%NIE,:,JSV)= (ZVARS(D%NIB:D%NIE,:)-PSVM(D%NIB:D%NIE,:,JSV))/PTSTEP
+ !$mnh_end_expand_array(JI=D%NIB:D%NIE,JK=D%NKTB:D%NKTE)
ENDDO
!
diff --git a/src/common/turb/mode_mf_turb_expl.F90 b/src/common/turb/mode_mf_turb_expl.F90
index 2bff78e0aa035c9bf2d1427e5c674ec844d2be80..cace0eb3ac7af50ab043dd2e25d2a56ba4063c0b 100644
--- a/src/common/turb/mode_mf_turb_expl.F90
+++ b/src/common/turb/mode_mf_turb_expl.F90
@@ -7,7 +7,7 @@
! ######################
IMPLICIT NONE
CONTAINS
- SUBROUTINE MF_TURB_EXPL(KKA,KKB,KKE,KKU,KKL,OMIXUV, &
+ SUBROUTINE MF_TURB_EXPL(D, PARAMMF, OMIXUV, &
PRHODJ, &
PTHLM,PTHVM,PRTM,PUM,PVM, &
PTHLDT,PRTDT,PUDT,PVDT, &
@@ -51,10 +51,11 @@ CONTAINS
!
!* 0. DECLARATIONS
! ------------
-
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+USE MODD_PARAM_MFSHALL_n, ONLY: PARAM_MFSHALL_t
+!
USE PARKIND1, ONLY : JPRB
USE YOMHOOK , ONLY : LHOOK, DR_HOOK
-USE MODD_PARAM_MFSHALL_n, ONLY: XLAMBDA_MF
USE MODI_SHUMAN_MF, ONLY: MZM_MF
IMPLICIT NONE
@@ -63,45 +64,42 @@ IMPLICIT NONE
!* 0.1 declarations of arguments
-INTEGER, INTENT(IN) :: KKA ! near ground array index
-INTEGER, INTENT(IN) :: KKB ! near ground physical index
-INTEGER, INTENT(IN) :: KKE ! uppest atmosphere physical index
-INTEGER, INTENT(IN) :: KKU ! uppest atmosphere array index
-INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+TYPE(PARAM_MFSHALL_t), INTENT(IN) :: PARAMMF
LOGICAL, INTENT(IN) :: OMIXUV ! True if mixing of momentum
-REAL, DIMENSION(:,:), INTENT(IN) :: PRHODJ ! dry density * Grid size
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(IN) :: PRHODJ ! dry density * Grid size
! Conservative var. at t-dt
-REAL, DIMENSION(:,:), INTENT(IN) :: PTHLM ! conservative pot. temp.
-REAL, DIMENSION(:,:), INTENT(IN) :: PRTM ! water var. where
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(IN) :: PTHLM ! conservative pot. temp.
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(IN) :: PRTM ! water var. where
! Virtual potential temperature at t-dt
-REAL, DIMENSION(:,:), INTENT(IN) :: PTHVM
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(IN) :: PTHVM
! Momentum at t-dt
-REAL, DIMENSION(:,:), INTENT(IN) :: PUM
-REAL, DIMENSION(:,:), INTENT(IN) :: PVM
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(IN) :: PUM
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(IN) :: PVM
!
! Tendencies of conservative variables
-REAL, DIMENSION(:,:), INTENT(OUT) :: PTHLDT
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(OUT) :: PTHLDT
-REAL, DIMENSION(:,:), INTENT(OUT) :: PRTDT
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(OUT) :: PRTDT
! Tendencies of momentum
-REAL, DIMENSION(:,:), INTENT(OUT) :: PUDT
-REAL, DIMENSION(:,:), INTENT(OUT) :: PVDT
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(OUT) :: PUDT
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(OUT) :: PVDT
! Updraft characteritics
-REAL, DIMENSION(:,:), INTENT(IN) :: PEMF,PTHL_UP,PTHV_UP,PRT_UP,PU_UP,PV_UP
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(IN) :: PEMF,PTHL_UP,PTHV_UP,PRT_UP,PU_UP,PV_UP
! Fluxes
-REAL, DIMENSION(:,:), INTENT(OUT) :: PFLXZTHLMF,PFLXZTHVMF,PFLXZRMF,PFLXZUMF,PFLXZVMF
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(OUT) :: PFLXZTHLMF,PFLXZTHVMF,PFLXZRMF,PFLXZUMF,PFLXZVMF
-REAL, DIMENSION(SIZE(PFLXZTHLMF,1),SIZE(PFLXZTHLMF,2)) :: ZFLXZTHSMF,ZTHS_UP,ZTHSM ! Theta S flux
-REAL, DIMENSION(SIZE(PFLXZTHLMF,1),SIZE(PFLXZTHLMF,2)) :: ZQT_UP,ZQTM,ZTHSDT,ZQTDT
-REAL, DIMENSION(SIZE(PFLXZTHLMF,1),SIZE(PFLXZTHLMF,2)) :: ZTHLM_F,ZRTM_F
+REAL, DIMENSION(D%NIT,D%NKT) :: ZFLXZTHSMF,ZTHS_UP,ZTHSM ! Theta S flux
+REAL, DIMENSION(D%NIT,D%NKT) :: ZQT_UP,ZQTM,ZTHSDT,ZQTDT
+REAL, DIMENSION(D%NIT,D%NKT) :: ZTHLM_F,ZRTM_F
-INTEGER :: JK ! loop counter
+INTEGER :: JK, JI ! loop counter
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!----------------------------------------------------------------------------
@@ -130,22 +128,33 @@ PVDT = 0.
! -----------------------------------------------
! ( Resulting fluxes are in flux level (w-point) as PEMF and PTHL_UP )
-ZRTM_F (:,:) = MZM_MF(PRTM (:,:), KKA, KKU, KKL)
-ZTHLM_F(:,:) = MZM_MF(PTHLM(:,:), KKA, KKU, KKL)
-ZQTM (:,:) = ZRTM_F (:,:)/(1.+ZRTM_F (:,:))
-ZQT_UP (:,:) = PRT_UP (:,:)/(1.+PRT_UP (:,:))
-ZTHS_UP(:,:) = PTHL_UP(:,:)*(1.+XLAMBDA_MF*ZQT_UP(:,:))
-ZTHSM (:,:) = ZTHLM_F(:,:)*(1.+XLAMBDA_MF*ZQTM(:,:))
-
-PFLXZTHLMF(:,:) = PEMF(:,:)*(PTHL_UP(:,:)-MZM_MF(PTHLM(:,:), KKA, KKU, KKL)) ! ThetaL
-PFLXZRMF(:,:) = PEMF(:,:)*(PRT_UP (:,:)-MZM_MF(PRTM (:,:), KKA, KKU, KKL)) ! Rt
-PFLXZTHVMF(:,:) = PEMF(:,:)*(PTHV_UP(:,:)-MZM_MF(PTHVM(:,:), KKA, KKU, KKL)) ! ThetaV
-
-ZFLXZTHSMF(:,:) = PEMF(:,:)*(ZTHS_UP(:,:)-ZTHSM(:,:)) ! Theta S flux
+CALL MZM_MF(D, PRTM (:,:), ZRTM_F(:,:))
+CALL MZM_MF(D, PTHLM(:,:), ZTHLM_F(:,:))
+!$mnh_expand_array(JI=D%NIB:D%NIE,JK=D%NKTB:D%NKTE)
+ZQTM(D%NIB:D%NIE,:) = ZRTM_F(D%NIB:D%NIE,:)/(1.+ZRTM_F(D%NIB:D%NIE,:))
+ZQT_UP(D%NIB:D%NIE,:) = PRT_UP(D%NIB:D%NIE,:)/(1.+PRT_UP(D%NIB:D%NIE,:))
+ZTHS_UP(D%NIB:D%NIE,:)= PTHL_UP(D%NIB:D%NIE,:)*(1.+PARAMMF%XLAMBDA_MF*ZQT_UP(D%NIB:D%NIE,:))
+ZTHSM(D%NIB:D%NIE,:) = ZTHLM_F(D%NIB:D%NIE,:)*(1.+PARAMMF%XLAMBDA_MF*ZQTM(D%NIB:D%NIE,:))
+!$mnh_end_expand_array(JI=D%NIB:D%NIE,JK=D%NKTB:D%NKTE)
+
+CALL MZM_MF(D, PTHLM(:,:), PFLXZTHLMF(:,:))
+CALL MZM_MF(D, PRTM(:,:), PFLXZRMF(:,:))
+CALL MZM_MF(D, PTHVM(:,:), PFLXZTHVMF(:,:))
+!$mnh_expand_array(JI=D%NIB:D%NIE,JK=D%NKTB:D%NKTE)
+PFLXZTHLMF(D%NIB:D%NIE,:) = PEMF(D%NIB:D%NIE,:)*(PTHL_UP(D%NIB:D%NIE,:)-PFLXZTHLMF(D%NIB:D%NIE,:)) ! ThetaL
+PFLXZRMF(D%NIB:D%NIE,:) = PEMF(D%NIB:D%NIE,:)*(PRT_UP(D%NIB:D%NIE,:)-PFLXZRMF(D%NIB:D%NIE,:)) ! Rt
+PFLXZTHVMF(D%NIB:D%NIE,:) = PEMF(D%NIB:D%NIE,:)*(PTHV_UP(D%NIB:D%NIE,:)-PFLXZTHVMF(D%NIB:D%NIE,:)) ! ThetaV
+
+ZFLXZTHSMF(D%NIB:D%NIE,:) = PEMF(D%NIB:D%NIE,:)*(ZTHS_UP(D%NIB:D%NIE,:)-ZTHSM(D%NIB:D%NIE,:)) ! Theta S flux
+!$mnh_end_expand_array(JI=D%NIB:D%NIE,JK=D%NKTB:D%NKTE)
IF (OMIXUV) THEN
- PFLXZUMF(:,:) = PEMF(:,:)*(PU_UP(:,:)-MZM_MF(PUM(:,:), KKA, KKU, KKL)) ! U
- PFLXZVMF(:,:) = PEMF(:,:)*(PV_UP(:,:)-MZM_MF(PVM(:,:), KKA, KKU, KKL)) ! V
+ CALL MZM_MF(D, PUM(:,:), PFLXZUMF(:,:))
+ CALL MZM_MF(D, PVM(:,:), PFLXZVMF(:,:))
+ !$mnh_expand_array(JI=D%NIB:D%NIE,JK=D%NKTB:D%NKTE)
+ PFLXZUMF(D%NIB:D%NIE,:) = PEMF(D%NIB:D%NIE,:)*(PU_UP(D%NIB:D%NIE,:)-PFLXZUMF(D%NIB:D%NIE,:)) ! U
+ PFLXZVMF(D%NIB:D%NIE,:) = PEMF(D%NIB:D%NIE,:)*(PV_UP(D%NIB:D%NIE,:)-PFLXZVMF(D%NIB:D%NIE,:)) ! V
+ !$mnh_end_expand_array(JI=D%NIB:D%NIE,JK=D%NKTB:D%NKTE)
ELSE
PFLXZUMF(:,:) = 0.
PFLXZVMF(:,:) = 0.
@@ -158,18 +167,22 @@ ENDIF
! (explicit formulation)
! --------------------------------------------
-DO JK=KKB,KKE-KKL,KKL
-! PTHLDT(:,JK) = (PFLXZTHLMF(:,JK ) - PFLXZTHLMF(:,JK+KKL)) / PRHODJ(:,JK)
- PRTDT (:,JK) = (PFLXZRMF (:,JK ) - PFLXZRMF (:,JK+KKL)) / PRHODJ(:,JK)
- ZQTDT (:,JK) = PRTDT (:,JK)/(1.+ ZRTM_F (:,JK)*ZRTM_F (:,JK))
- ZTHSDT(:,JK) = (ZFLXZTHSMF(:,JK ) - ZFLXZTHSMF(:,JK+KKL)) / PRHODJ(:,JK)
- PTHLDT(:,JK) = ZTHSDT(:,JK)/(1.+XLAMBDA_MF*ZQTM(:,JK)) - ZTHLM_F(:,JK)*XLAMBDA_MF*ZQTDT(:,JK)
+DO JK=D%NKB,D%NKE-D%NKL,D%NKL
+ DO JI=D%NIB,D%NIE
+ !PTHLDT(JI,JK) = (PFLXZTHLMF(JI,JK ) - PFLXZTHLMF(JI,JK+D%NKL)) / PRHODJ(JI,JK)
+ PRTDT(JI,JK) = (PFLXZRMF(JI,JK) - PFLXZRMF(JI,JK+D%NKL)) / PRHODJ(JI,JK)
+ ZQTDT(JI,JK) = PRTDT(JI,JK)/(1.+ ZRTM_F(JI,JK)*ZRTM_F(JI,JK))
+ ZTHSDT(JI,JK)= (ZFLXZTHSMF(JI,JK) - ZFLXZTHSMF(JI,JK+D%NKL)) / PRHODJ(JI,JK)
+ PTHLDT(JI,JK) = ZTHSDT(JI,JK)/(1.+PARAMMF%XLAMBDA_MF*ZQTM(JI,JK)) - ZTHLM_F(JI,JK)*PARAMMF%XLAMBDA_MF*ZQTDT(JI,JK)
+ ENDDO
END DO
IF (OMIXUV) THEN
- DO JK=KKB,KKE-KKL,KKL
- PUDT(:,JK) = (PFLXZUMF(:,JK ) - PFLXZUMF(:,JK+KKL)) / PRHODJ(:,JK)
- PVDT(:,JK) = (PFLXZVMF(:,JK ) - PFLXZVMF(:,JK+KKL)) / PRHODJ(:,JK)
+ DO JK=D%NKB,D%NKE-D%NKL,D%NKL
+ DO JI=D%NIB,D%NIE
+ PUDT(JI,JK) = (PFLXZUMF(JI,JK) - PFLXZUMF(JI,JK+D%NKL)) / PRHODJ(JI,JK)
+ PVDT(JI,JK) = (PFLXZVMF(JI,JK) - PFLXZVMF(JI,JK+D%NKL)) / PRHODJ(JI,JK)
+ ENDDO
END DO
ENDIF
diff --git a/src/common/turb/mode_th_r_from_thl_rt_1d.F90 b/src/common/turb/mode_th_r_from_thl_rt_1d.F90
deleted file mode 100644
index 1aff6f5943ff5a99cf55a46a60c48fdb72ca3118..0000000000000000000000000000000000000000
--- a/src/common/turb/mode_th_r_from_thl_rt_1d.F90
+++ /dev/null
@@ -1,210 +0,0 @@
-!MNH_LIC Copyright 2006-2022 CNRS, Meteo-France and Universite Paul Sabatier
-!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!MNH_LIC for details. version 1.
-MODULE MODE_TH_R_FROM_THL_RT_1D
-IMPLICIT NONE
-CONTAINS
- SUBROUTINE TH_R_FROM_THL_RT_1D(HFRAC_ICE,PFRAC_ICE,PP, &
- PTHL, PRT, PTH, PRV, PRL, PRI, &
- PRSATW, PRSATI, PRR, PRS, PRG, PRH,OOCEAN)
-! #################################################################
-!
-!
-!!**** *TH_R_FROM_THL_RT_1D* - computes the non-conservative variables
-!! from conservative variables
-!!
-!! PURPOSE
-!! -------
-!!
-!!** METHOD
-!! ------
-!!
-!!
-!! EXTERNAL
-!! --------
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!!
-!! REFERENCE
-!! ---------
-!!
-!! AUTHOR
-!! ------
-!! Julien PERGAUD * Meteo-France *
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 13/03/06
-!! S. Riette April 2011 : ice added, allow ZRLTEMP to be negative
-!! we use dQsat/dT to help convergence
-!! use of optional PRR, PRS, PRG, PRH
-!! S. Riette Nov 2016: support for HFRAC_ICE='S'
-!!
-!! --------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE PARKIND1, ONLY : JPRB
-USE YOMHOOK , ONLY : LHOOK, DR_HOOK
-USE MODD_CST !, ONLY: XP00, XRD, XCPD, XCPV, XCL, XCI, XLVTT, XTT, XLSTT
-USE MODD_NEB, ONLY: NEB
-USE MODE_THERMO
-!
-IMPLICIT NONE
-!
-!
-!* 0.1 declarations of arguments
-!
-CHARACTER(LEN=1), INTENT(IN) :: HFRAC_ICE
-LOGICAL, INTENT(IN) :: OOCEAN ! switch for Ocean model version
-REAL, DIMENSION(:), INTENT(INOUT) :: PFRAC_ICE
-REAL, DIMENSION(:), INTENT(IN) :: PP ! Pressure
-REAL, DIMENSION(:), INTENT(IN) :: PTHL ! thetal to transform into th
-REAL, DIMENSION(:),INTENT(IN) :: PRT ! Total mixing ratios to transform into rv,rc and ri
-REAL, DIMENSION(:),OPTIONAL,INTENT(IN) :: PRR, PRS, PRG, PRH
-REAL, DIMENSION(:), INTENT(OUT):: PTH ! th
-REAL, DIMENSION(:), INTENT(OUT):: PRV ! vapor mixing ratio
-REAL, DIMENSION(:), INTENT(INOUT):: PRL ! vapor mixing ratio
-REAL, DIMENSION(:), INTENT(INOUT):: PRI ! vapor mixing ratio
-REAL, DIMENSION(:), INTENT(OUT) :: PRSATW ! estimated mixing ration at saturation over water
-REAL, DIMENSION(:), INTENT(OUT) :: PRSATI ! estimated mixing ration at saturation over ice
-!
-!-------------------------------------------------------------------------------
-!
-! 0.2 declaration of local variables
-INTEGER :: II ! Loop control
-INTEGER :: JITER ! number of iterations
-INTEGER :: J
-REAL, DIMENSION(SIZE(PTHL,1)) :: ZEXN
-REAL, DIMENSION(SIZE(PTHL,1)) :: ZRVSAT,ZCPH,ZRLTEMP,ZCPH2
-REAL, DIMENSION(SIZE(PTHL,1)) :: ZT,ZLVOCPEXN,ZLSOCPEXN
-REAL, DIMENSION(SIZE(PTHL,1)) :: ZDRSATODT,ZDRSATODTW,ZDRSATODTI
-REAL, DIMENSION(SIZE(PTHL,1)) :: ZFOESW, ZFOESI
-REAL, DIMENSION(SIZE(PTHL,1)) :: ZLOGT, Z99PP, Z1PRT
-REAL(KIND=JPRB) :: ZVAR1, ZVAR2, ZTPOW2, ZDELT
-INTEGER, DIMENSION(SIZE(PTHL,1)) :: IERR
-
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!----------------------------------------------------------------------------
-!
-!* 1 Initialisation
-! --------------
-!
-!
-IF (LHOOK) CALL DR_HOOK('TH_R_FROM_THL_RT_1D',0,ZHOOK_HANDLE)
-!
-!Number of iterations
-JITER=2
-!
-!Computation of ZCPH2 depending on dummy arguments received
-ZCPH2(:)=0
-IF(PRESENT(PRR)) ZCPH2(:)=ZCPH2(:) + XCL*PRR(:)
-IF(PRESENT(PRS)) ZCPH2(:)=ZCPH2(:) + XCI*PRS(:)
-IF(PRESENT(PRG)) ZCPH2(:)=ZCPH2(:) + XCI*PRG(:)
-IF(PRESENT(PRH)) ZCPH2(:)=ZCPH2(:) + XCI*PRH(:)
-!
-!Computation of an approximate state thanks to PRL and PRI guess
-ZEXN(:)=(PP(:)/XP00) ** RDSCPD
-
-DO J=1,SIZE(PTHL,1)
-Z99PP(J)=0.99*PP(J)
-PRV(J)=PRT(J)-PRL(J)-PRI(J)
-ZCPH(J)=XCPD+ XCPV * PRV(J)+ XCL * PRL(J) + XCI * PRI(J) + ZCPH2(J)
-ZVAR2=ZCPH(J)*ZEXN(J)
-ZDELT=(PTHL(J)*ZEXN(J))-XTT
-ZLVOCPEXN(J) = (XLVTT + (XCPV-XCL) * ZDELT) /ZVAR2
-ZLSOCPEXN(J) = (XLSTT + (XCPV-XCI) * ZDELT) /ZVAR2
-PTH(J)=PTHL(J)+ZLVOCPEXN(J)*PRL(J)+ZLSOCPEXN(J)*PRI(J)
-Z1PRT(J)=1+PRT(J)
-ENDDO
-!
-!
-! 2 Iteration
-! ---------
-
-DO II=1,JITER
- IF (OOCEAN) THEN
- ZT=PTH
- ELSE
- ZT(:)=PTH(:)*ZEXN(:)
- END IF
- !Computation of liquid/ice fractions
- PFRAC_ICE(:) = 0.
- DO J=1, SIZE(PFRAC_ICE, 1)
- IF(PRL(J)+PRI(J) > 1.E-20) THEN
- PFRAC_ICE(J) = PRI(J) / (PRL(J)+PRI(J))
- ENDIF
- ENDDO
- 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
- !due to performance issue
-
- ! Log does not vectorize on all compilers:
- ZLOGT(:)=LOG(ZT(:))
-
- DO J=1,SIZE(PTHL,1)
-
- ZFOESW(J) = MIN(EXP( XALPW - XBETAW/ZT(J) - XGAMW*ZLOGT(J) ), Z99PP(J))
- ZFOESI(J) = MIN(EXP( XALPI - XBETAI/ZT(J) - XGAMI*ZLOGT(J) ), Z99PP(J))
- PRSATW(J) = XRD/XRV*ZFOESW(J)/PP(J) / (1.+(XRD/XRV-1.)*ZFOESW(J)/PP(J))
- PRSATI(J) = XRD/XRV*ZFOESI(J)/PP(J) / (1.+(XRD/XRV-1.)*ZFOESI(J)/PP(J))
- ZTPOW2=ZT(J)**2
- ZDRSATODTW(J) = PRSATW(J) / (1.+(XRD/XRV-1.)*ZFOESW(J)/PP(J) ) &
- * (XBETAW/ZTPOW2 - XGAMW/ZT(J))*Z1PRT(J)
- ZDRSATODTI(J) = PRSATI(J) / (1.+(XRD/XRV-1.)*ZFOESI(J)/PP(J) ) &
- * (XBETAI/ZTPOW2 - XGAMI/ZT(J))*Z1PRT(J)
- !PRSATW(J) = QSAT(ZT(J),PP(J)) !qsatw
- !PRSATI(J) = QSATI(ZT(J),PP(J)) !qsati
- !ZDRSATODTW(J) = DQSAT(ZT(J),PP(J),PRSATW(J))*Z1PRT(J)
- !ZDRSATODTI(J) = DQSATI(ZT(J),PP(J),PRSATI(J))*Z1PRT(J)
- PRSATW(J) = PRSATW(J)*Z1PRT(J)
- PRSATI(J) = PRSATI(J)*Z1PRT(J)
- ZRVSAT(J) = PRSATW(J)*(1-PFRAC_ICE(J)) + PRSATI(J)*PFRAC_ICE(J)
- ZDRSATODT(J) = (ZDRSATODTW(J)*(1-PFRAC_ICE(J))+ &
- & ZDRSATODTI(J)*PFRAC_ICE(J))
-
- !Computation of new PRL, PRI and PRV
- !Correction term applied to (PRV(J)-ZRVSAT(J)) is computed assuming that
- !ZLVOCPEXN, ZLSOCPEXN and ZCPH don't vary to much with T. It takes into account
- !the variation (estimated linear) of Qsat with T
- ZRLTEMP(J)=(PRV(J)-ZRVSAT(J))/ &
- &(1 + ZDRSATODT(J)*ZEXN(J)* &
- & (ZLVOCPEXN(J)*(1-PFRAC_ICE(J))+ZLSOCPEXN(J)*PFRAC_ICE(J)))
- ZRLTEMP(J)=MIN(MAX(-PRL(J)-PRI(J), ZRLTEMP(J)),PRV(J))
- PRV(J)=PRV(J)-ZRLTEMP(J)
- PRL(J)=PRL(J)+PRI(J)+ZRLTEMP(J)
- PRI(J)=PFRAC_ICE(J) * (PRL(J))
- PRL(J)=(1-PFRAC_ICE(J)) * (PRT(J) - PRV(J))
-
- !Computation of Cph (as defined in Meso-NH doc, equation 2.2, to be used with mixing ratios)
- ZCPH(J)=XCPD+ XCPV * PRV(J)+ XCL * PRL(J) + XCI * PRI(J) + ZCPH2(J)
-
- !Computation of L/Cph/EXN, then new PTH
- ZVAR2=ZCPH(J)*ZEXN(J)
- ZLVOCPEXN(J) = (XLVTT + (XCPV-XCL) * (ZT(J)-XTT)) /ZVAR2
- ZLSOCPEXN(J) = (XLSTT + (XCPV-XCI) * (ZT(J)-XTT)) /ZVAR2
- PTH(J)=PTHL(J)+ZLVOCPEXN(J)*PRL(J)+ZLSOCPEXN(J)*PRI(J)
-
- !Computation of estimated mixing ration at saturation
- !To compute the adjustement a first order development was used
- ZVAR1=PTH(J)*ZEXN(J)-ZT(J)
- PRSATW(J)=PRSATW(J) + ZDRSATODTW(J)*ZVAR1
- PRSATI(J)=PRSATI(J) + ZDRSATODTI(J)*ZVAR1
-
- ENDDO
-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
-END MODULE MODE_TH_R_FROM_THL_RT_1D
diff --git a/src/common/turb/mode_th_r_from_thl_rt_2d.F90 b/src/common/turb/mode_th_r_from_thl_rt_2d.F90
deleted file mode 100644
index 2ac0c85284102e0ce45d4fa88a97f9fa474e708d..0000000000000000000000000000000000000000
--- a/src/common/turb/mode_th_r_from_thl_rt_2d.F90
+++ /dev/null
@@ -1,112 +0,0 @@
-!MNH_LIC Copyright 2006-2022 CNRS, Meteo-France and Universite Paul Sabatier
-!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!MNH_LIC for details. version 1.
-MODULE MODE_TH_R_FROM_THL_RT_2D
-IMPLICIT NONE
-CONTAINS
- SUBROUTINE TH_R_FROM_THL_RT_2D(HFRAC_ICE,PFRAC_ICE,PP, &
- PTHL, PRT, PTH, PRV, PRL, PRI, &
- PRSATW, PRSATI, PRR, PRS, PRG, PRH,OOCEAN)
-! #################################################################
-!
-!
-!!**** *TH_R_FROM_THL_RT_2D* - computes the non-conservative variables
-!! from conservative variables
-!!
-!! PURPOSE
-!! -------
-!!
-!!** METHOD
-!! ------
-!!
-!!
-!! EXTERNAL
-!! --------
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!!
-!! REFERENCE
-!! ---------
-!!
-!! AUTHOR
-!! ------
-!! Julien PERGAUD * Meteo-France *
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 13/03/06
-!! Sébastien Riette April 2011: code moved in th_r_from_thl_rt_1D
-!!
-!! --------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-!
-USE MODE_TH_R_FROM_THL_RT_3D, ONLY: TH_R_FROM_THL_RT_3D
-USE PARKIND1, ONLY : JPRB
-USE YOMHOOK , ONLY : LHOOK, DR_HOOK
-
-IMPLICIT NONE
-!
-!
-!* 0.1 declarations of arguments
-!
-CHARACTER(LEN=1), INTENT(IN) :: HFRAC_ICE
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PFRAC_ICE
-REAL, DIMENSION(:,:), INTENT(IN) :: PP ! Pressure
-REAL, DIMENSION(:,:), INTENT(IN) :: PTHL ! Liquid pot. temp.
-REAL, DIMENSION(:,:), INTENT(IN) :: PRT ! Total mixing ratios
-REAL, DIMENSION(:,:),OPTIONAL,INTENT(IN) :: PRR, PRS, PRG, PRH
-REAL, DIMENSION(:,:), INTENT(OUT):: PTH ! Potential temp.
-REAL, DIMENSION(:,:), INTENT(OUT):: PRV ! vapor mixing ratio
-REAL, DIMENSION(:,:), INTENT(INOUT):: PRL ! cloud mixing ratio
-REAL, DIMENSION(:,:), INTENT(INOUT):: PRI ! ice mixing ratio
-REAL, DIMENSION(:,:), INTENT(OUT) :: PRSATW ! estimated mixing ration at saturation over water
-REAL, DIMENSION(:,:), INTENT(OUT) :: PRSATI ! estimated mixing ration at saturation over ice
-LOGICAL, INTENT(IN) :: OOCEAN ! switch OCEAN version
-
-!
-!-------------------------------------------------------------------------------
-!
-! 0.2 declaration of local variables
-!
-!----------------------------------------------------------------------------
-!
-REAL, DIMENSION(SIZE(PP,1),SIZE(PP,2)) :: ZRR, ZRS, ZRG, ZRH
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-INTEGER :: JK
-!----------------------------------------------------------------------------
-!
-!* 1 Initialisation
-! --------------
-!
-IF (LHOOK) CALL DR_HOOK('TH_R_FROM_THL_RT_2D',0,ZHOOK_HANDLE)
-ZRR(:,:)=0.
-ZRS(:,:)=0.
-ZRG(:,:)=0.
-ZRH(:,:)=0.
-IF(PRESENT(PRR)) ZRR(:,:)=PRR(:,:)
-IF(PRESENT(PRS)) ZRS(:,:)=PRS(:,:)
-IF(PRESENT(PRG)) ZRG(:,:)=PRG(:,:)
-IF(PRESENT(PRH)) ZRH(:,:)=PRH(:,:)
-!
-!
-! 2 Call of 1d version
-! ------------------
-DO JK=1, SIZE(PTHL,2)
- CALL TH_R_FROM_THL_RT_1D(HFRAC_ICE,PFRAC_ICE(:,JK),PP(:,JK), &
- PTHL(:,JK), PRT(:,JK), PTH(:,JK), &
- PRV(:,JK), PRL(:,JK), PRI(:,JK), &
- PRSATW(:,JK), PRSATI(:,JK), &
- ZRR(:,JK), ZRS(:,JK), ZRG(:,JK), ZRH(:,JK),OOCEAN)
-ENDDO
-
-IF (LHOOK) CALL DR_HOOK('TH_R_FROM_THL_RT_2D',1,ZHOOK_HANDLE)
-
-END SUBROUTINE TH_R_FROM_THL_RT_2D
-END MODULE MODE_TH_R_FROM_THL_RT_2D
-
diff --git a/src/common/turb/mode_th_r_from_thl_rt_3d.F90 b/src/common/turb/mode_th_r_from_thl_rt_3d.F90
deleted file mode 100644
index 1e179b139debd6d2c8e7c57146ba47244e7442ac..0000000000000000000000000000000000000000
--- a/src/common/turb/mode_th_r_from_thl_rt_3d.F90
+++ /dev/null
@@ -1,108 +0,0 @@
-!MNH_LIC Copyright 2006-2022 CNRS, Meteo-France and Universite Paul Sabatier
-!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!MNH_LIC for details. version 1.
-MODULE MODE_TH_R_FROM_THL_RT_3D
-IMPLICIT NONE
-CONTAINS
- SUBROUTINE TH_R_FROM_THL_RT_3D(HFRAC_ICE,PFRAC_ICE,PP, &
- PTHL, PRT, PTH, PRV, PRL, PRI, &
- PRSATW, PRSATI, PRR, PRS, PRG, PRH,OOCEAN)
-! #################################################################
-!
-!
-!!**** *TH_R_FROM_THL_RT_3D* - computes the non-conservative variables
-!! from conservative variables
-!!
-!! PURPOSE
-!! -------
-!!
-!!** METHOD
-!! ------
-!!
-!!
-!! EXTERNAL
-!! --------
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!!
-!! REFERENCE
-!! ---------
-!!
-!! AUTHOR
-!! ------
-!! Julien PERGAUD * Meteo-France *
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 15/03/2011
-!! S. Riette April 2011 : code moved in th_r_from_thl_rt_1d
-!!
-!! --------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODE_TH_R_FROM_THL_RT_1D, ONLY: TH_R_FROM_THL_RT_1D
-USE PARKIND1, ONLY : JPRB
-USE YOMHOOK , ONLY : LHOOK, DR_HOOK
-!
-IMPLICIT NONE
-!
-!
-!* 0.1 declarations of arguments
-!
-CHARACTER(LEN=1), INTENT(IN) :: HFRAC_ICE
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PFRAC_ICE
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PP ! Pressure
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHL ! thetal to transform into th
-REAL, DIMENSION(:,:,:),INTENT(IN) :: PRT ! Total mixing ratios to transform into rv,rc and ri
-REAL, DIMENSION(:,:,:),OPTIONAL,INTENT(IN) :: PRR, PRS, PRG, PRH
-REAL, DIMENSION(:,:,:), INTENT(OUT):: PTH ! th
-REAL, DIMENSION(:,:,:), INTENT(OUT):: PRV ! vapor mixing ratio
-REAL, DIMENSION(:,:,:), INTENT(INOUT):: PRL ! vapor mixing ratio
-REAL, DIMENSION(:,:,:), INTENT(INOUT):: PRI ! vapor mixing ratio
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRSATW ! estimated mixing ration at saturation over water
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRSATI ! estimated mixing ration at saturation over ice
-LOGICAL, INTENT(IN) :: OOCEAN ! switch OCEAN version
-!
-!-------------------------------------------------------------------------------
-!
-! 0.2 declaration of local variables
-REAL, DIMENSION(SIZE(PTHL,1),SIZE(PTHL,2),SIZE(PTHL,3)) :: ZRR, ZRS, ZRG, ZRH
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-INTEGER :: JJ, JK
-!----------------------------------------------------------------------------
-!
-!* 1 Initialisation
-! --------------
-!
-IF (LHOOK) CALL DR_HOOK('TH_R_FROM_THL_RT_3D',0,ZHOOK_HANDLE)
-ZRR(:,:,:)=0.
-ZRS(:,:,:)=0.
-ZRG(:,:,:)=0.
-ZRH(:,:,:)=0.
-IF(PRESENT(PRR)) ZRR(:,:,:)=PRR(:,:,:)
-IF(PRESENT(PRS)) ZRS(:,:,:)=PRS(:,:,:)
-IF(PRESENT(PRG)) ZRG(:,:,:)=PRG(:,:,:)
-IF(PRESENT(PRH)) ZRH(:,:,:)=PRH(:,:,:)
-!
-!
-! 2 Call of 1d version
-! ------------------
-DO JK=1, SIZE(PTHL,3)
- DO JJ=1, SIZE(PTHL,2)
- CALL TH_R_FROM_THL_RT_1D(HFRAC_ICE,PFRAC_ICE(:,JJ,JK),PP(:,JJ,JK), &
- PTHL(:,JJ,JK), PRT(:,JJ,JK), PTH(:,JJ,JK), &
- PRV(:,JJ,JK), PRL(:,JJ,JK), PRI(:,JJ,JK), &
- PRSATW(:,JJ,JK), PRSATI(:,JJ,JK), &
- ZRR(:,JJ,JK), ZRS(:,JJ,JK), ZRG(:,JJ,JK), ZRH(:,JJ,JK),OOCEAN)
- ENDDO
-ENDDO
-
-IF (LHOOK) CALL DR_HOOK('TH_R_FROM_THL_RT_3D',1,ZHOOK_HANDLE)
-
-END SUBROUTINE TH_R_FROM_THL_RT_3D
-END MODULE MODE_TH_R_FROM_THL_RT_3D
diff --git a/src/common/turb/mode_thl_rt_from_th_r_mf.F90 b/src/common/turb/mode_thl_rt_from_th_r_mf.F90
index bf72ab9439b62e883471b54f7abb10ecce8c4031..c83a0ff578f714f84542d789806b55590b454cce 100644
--- a/src/common/turb/mode_thl_rt_from_th_r_mf.F90
+++ b/src/common/turb/mode_thl_rt_from_th_r_mf.F90
@@ -5,7 +5,7 @@
MODULE MODE_THL_RT_FROM_TH_R_MF
IMPLICIT NONE
CONTAINS
- SUBROUTINE THL_RT_FROM_TH_R_MF( KRR,KRRL,KRRI, &
+ SUBROUTINE THL_RT_FROM_TH_R_MF( D, CST, KRR, KRRL, KRRI, &
PTH, PR, PEXN, &
PTHL, PRT )
! #################################################################
@@ -47,7 +47,8 @@ CONTAINS
!* 0. DECLARATIONS
! ------------
!
-USE MODD_CST
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+USE MODD_CST, ONLY : CST_t
USE PARKIND1, ONLY : JPRB
USE YOMHOOK , ONLY : LHOOK, DR_HOOK
!
@@ -56,16 +57,18 @@ IMPLICIT NONE
!
!* 0.1 declarations of arguments
!
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+TYPE(CST_t), INTENT(IN) :: CST
INTEGER, INTENT(IN) :: KRR ! number of moist var.
INTEGER, INTENT(IN) :: KRRL ! number of liquid water var.
INTEGER, INTENT(IN) :: KRRI ! number of ice water var.
-REAL, DIMENSION(:,:), INTENT(IN) :: PTH ! theta
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PR ! water species
-REAL, DIMENSION(:,:), INTENT(IN) :: PEXN ! exner function
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(IN) :: PTH ! theta
+REAL, DIMENSION(D%NIT,D%NKT,KRR), INTENT(IN) :: PR ! water species
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(IN) :: PEXN ! exner function
-REAL, DIMENSION(:,:), INTENT(OUT) :: PTHL ! th_l
-REAL, DIMENSION(:,:), INTENT(OUT) :: PRT ! total non precip. water
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(OUT) :: PTHL ! th_l
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(OUT) :: PRT ! total non precip. water
!
!-------------------------------------------------------------------------------
!
@@ -73,50 +76,65 @@ REAL, DIMENSION(:,:), INTENT(OUT) :: PRT ! total non precip. water
!
!----------------------------------------------------------------------------
-REAL, DIMENSION(SIZE(PTH,1),SIZE(PTH,2)) :: ZCP, ZT
-REAL, DIMENSION(SIZE(PTH,1),SIZE(PTH,2)) :: ZLVOCPEXN, ZLSOCPEXN
-INTEGER :: JRR
+REAL, DIMENSION(D%NIT,D%NKT) :: ZCP, ZT
+REAL, DIMENSION(D%NIT,D%NKT) :: ZLVOCPEXN, ZLSOCPEXN
+INTEGER :: JRR, JI, JK
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!----------------------------------------------------------------------------
!
!
IF (LHOOK) CALL DR_HOOK('THL_RT_FRM_TH_R_MF',0,ZHOOK_HANDLE)
+!$mnh_expand_array(JI=D%NIB:D%NIE,JK=1:D%NKT)
!temperature
-ZT(:,:) = PTH(:,:) * PEXN(:,:)
+ZT(D%NIB:D%NIE,:) = PTH(D%NIB:D%NIE,:) * PEXN(D%NIB:D%NIE,:)
!Cp
-ZCP=XCPD
-IF (KRR > 0) ZCP(:,:) = ZCP(:,:) + XCPV * PR(:,:,1)
+ZCP(D%NIB:D%NIE,:)=CST%XCPD
+IF (KRR > 0) ZCP(D%NIB:D%NIE,:) = ZCP(D%NIB:D%NIE,:) + CST%XCPV * PR(D%NIB:D%NIE,:,1)
+!$mnh_end_expand_array(JI=D%NIB:D%NIE,JK=1:D%NKT)
DO JRR = 2,1+KRRL ! loop on the liquid components
- ZCP(:,:) = ZCP(:,:) + XCL * PR(:,:,JRR)
+ !$mnh_expand_array(JI=D%NIB:D%NIE,JK=1:D%NKT)
+ ZCP(D%NIB:D%NIE,:) = ZCP(D%NIB:D%NIE,:) + CST%XCL * PR(D%NIB:D%NIE,:,JRR)
+ !$mnh_end_expand_array(JI=D%NIB:D%NIE,JK=1:D%NKT)
END DO
DO JRR = 2+KRRL,1+KRRL+KRRI ! loop on the solid components
- ZCP(:,:) = ZCP(:,:) + XCI * PR(:,:,JRR)
+ !$mnh_expand_array(JI=D%NIB:D%NIE,JK=1:D%NKT)
+ ZCP(D%NIB:D%NIE,:) = ZCP(D%NIB:D%NIE,:) + CST%XCI * PR(D%NIB:D%NIE,:,JRR)
+ !$mnh_end_expand_array(JI=D%NIB:D%NIE,JK=1:D%NKT)
END DO
IF ( KRRL >= 1 ) THEN
IF ( KRRI >= 1 ) THEN
+ !$mnh_expand_array(JI=D%NIB:D%NIE,JK=1:D%NKT)
!ZLVOCPEXN and ZLSOCPEXN
- ZLVOCPEXN(:,:)=(XLVTT + (XCPV-XCL) * (ZT(:,:)-XTT) ) / ZCP(:,:) / PEXN(:,:)
- ZLSOCPEXN(:,:)=(XLSTT + (XCPV-XCI) * (ZT(:,:)-XTT) ) / ZCP(:,:) / PEXN(:,:)
+ ZLVOCPEXN(D%NIB:D%NIE,:)=(CST%XLVTT + (CST%XCPV-CST%XCL) * (ZT(D%NIB:D%NIE,:)-CST%XTT) ) &
+ &/ ZCP(D%NIB:D%NIE,:) / PEXN(D%NIB:D%NIE,:)
+ ZLSOCPEXN(D%NIB:D%NIE,:)=(CST%XLSTT + (CST%XCPV-CST%XCI) * (ZT(D%NIB:D%NIE,:)-CST%XTT) ) &
+ &/ ZCP(D%NIB:D%NIE,:) / PEXN(D%NIB:D%NIE,:)
! Rnp
- PRT(:,:) = PR(:,:,1) + PR(:,:,2) + PR(:,:,4)
+ PRT(D%NIB:D%NIE,:) = PR(D%NIB:D%NIE,:,1) + PR(D%NIB:D%NIE,:,2) + PR(D%NIB:D%NIE,:,4)
! Theta_l
- PTHL(:,:) = PTH(:,:) - ZLVOCPEXN(:,:) * PR(:,:,2) &
- - ZLSOCPEXN(:,:) * PR(:,:,4)
+ PTHL(D%NIB:D%NIE,:) = PTH(D%NIB:D%NIE,:) - ZLVOCPEXN(D%NIB:D%NIE,:) * PR(D%NIB:D%NIE,:,2) &
+ - ZLSOCPEXN(D%NIB:D%NIE,:) * PR(D%NIB:D%NIE,:,4)
+ !$mnh_end_expand_array(JI=D%NIB:D%NIE,JK=1:D%NKT)
ELSE
+ !$mnh_expand_array(JI=D%NIB:D%NIE,JK=1:D%NKT)
!ZLVOCPEXN
- ZLVOCPEXN(:,:)=(XLVTT + (XCPV-XCL) * (ZT(:,:)-XTT) ) / ZCP(:,:) / PEXN(:,:)
+ ZLVOCPEXN(D%NIB:D%NIE,:)=(CST%XLVTT + (CST%XCPV-CST%XCL) * (ZT(D%NIB:D%NIE,:)-CST%XTT) ) &
+ &/ ZCP(D%NIB:D%NIE,:) / PEXN(D%NIB:D%NIE,:)
! Rnp
- PRT(:,:) = PR(:,:,1) + PR(:,:,2)
+ PRT(D%NIB:D%NIE,:) = PR(D%NIB:D%NIE,:,1) + PR(D%NIB:D%NIE,:,2)
! Theta_l
- PTHL(:,:) = PTH(:,:) - ZLVOCPEXN(:,:) * PR(:,:,2)
+ PTHL(D%NIB:D%NIE,:) = PTH(D%NIB:D%NIE,:) - ZLVOCPEXN(D%NIB:D%NIE,:) * PR(D%NIB:D%NIE,:,2)
+ !$mnh_end_expand_array(JI=D%NIB:D%NIE,JK=1:D%NKT)
END IF
ELSE
+ !$mnh_expand_array(JI=D%NIB:D%NIE,JK=1:D%NKT)
! Rnp = rv
- PRT(:,:) = PR(:,:,1)
+ PRT(D%NIB:D%NIE,:) = PR(D%NIB:D%NIE,:,1)
! Theta_l = Theta
- PTHL(:,:) = PTH(:,:)
+ PTHL(D%NIB:D%NIE,:) = PTH(D%NIB:D%NIE,:)
+ !$mnh_end_expand_array(JI=D%NIB:D%NIE,JK=1:D%NKT)
END IF
IF (LHOOK) CALL DR_HOOK('THL_RT_FRM_TH_R_MF',1,ZHOOK_HANDLE)
END SUBROUTINE THL_RT_FROM_TH_R_MF
diff --git a/src/common/turb/mode_tridiag_massflux.F90 b/src/common/turb/mode_tridiag_massflux.F90
index 915d75b936fd4131452da4cf5c7e41a9922390f5..88fd02999a71cf1e3b35a2bfd5ada7cbdda82348 100644
--- a/src/common/turb/mode_tridiag_massflux.F90
+++ b/src/common/turb/mode_tridiag_massflux.F90
@@ -5,7 +5,7 @@
MODULE MODE_TRIDIAG_MASSFLUX
IMPLICIT NONE
CONTAINS
-SUBROUTINE TRIDIAG_MASSFLUX(KKA,KKB,KKE,KKU,KKL,PVARM,PF,PDFDT,PTSTEP,PIMPL, &
+SUBROUTINE TRIDIAG_MASSFLUX(D,PVARM,PF,PDFDT,PTSTEP,PIMPL, &
PDZZ,PRHODJ,PVARP )
USE PARKIND1, ONLY : JPRB
@@ -121,38 +121,35 @@ SUBROUTINE TRIDIAG_MASSFLUX(KKA,KKB,KKE,KKU,KKL,PVARM,PF,PDFDT,PTSTEP,PIMPL, &
!
!* 0. DECLARATIONS
!
-USE MODD_PARAMETERS, ONLY: JPVEXT
-USE MODI_SHUMAN_MF
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+!
+USE MODI_SHUMAN_MF, ONLY: MZM_MF
!
IMPLICIT NONE
!
!
!* 0.1 declarations of arguments
!
-INTEGER, INTENT(IN) :: KKA ! near ground array index
-INTEGER, INTENT(IN) :: KKB ! near ground physical index
-INTEGER, INTENT(IN) :: KKE ! uppest atmosphere physical index
-INTEGER, INTENT(IN) :: KKU ! uppest atmosphere array index
-INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
-REAL, DIMENSION(:,:), INTENT(IN) :: PVARM ! variable at t-1 at mass point
-REAL, DIMENSION(:,:), INTENT(IN) :: PF ! flux in dT/dt=-dF/dz at flux point
-REAL, DIMENSION(:,:), INTENT(IN) :: PDFDT ! dF/dT at flux point
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(IN) :: PVARM ! variable at t-1 at mass point
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(IN) :: PF ! flux in dT/dt=-dF/dz at flux point
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(IN) :: PDFDT ! dF/dT at flux point
REAL, INTENT(IN) :: PTSTEP ! Double time step
REAL, INTENT(IN) :: PIMPL ! implicit weight
-REAL, DIMENSION(:,:), INTENT(IN) :: PDZZ ! Dz at flux point
-REAL, DIMENSION(:,:), INTENT(IN) :: PRHODJ ! (dry rho)*J at mass point
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(IN) :: PDZZ ! Dz at flux point
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(IN) :: PRHODJ ! (dry rho)*J at mass point
!
-REAL, DIMENSION(:,:), INTENT(OUT):: PVARP ! variable at t+1 at mass point
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(OUT):: PVARP ! variable at t+1 at mass point
!
!
!* 0.2 declarations of local variables
!
-REAL, DIMENSION(SIZE(PVARM,1),SIZE(PVARM,2)) :: ZRHODJ_DFDT_O_DZ
-REAL, DIMENSION(SIZE(PVARM,1),SIZE(PVARM,2)) :: ZMZM_RHODJ
-REAL, DIMENSION(SIZE(PVARM,1),SIZE(PVARM,2)) :: ZA, ZB, ZC
-REAL, DIMENSION(SIZE(PVARM,1),SIZE(PVARM,2)) :: ZY ,ZGAM
+REAL, DIMENSION(D%NIT,D%NKT) :: ZRHODJ_DFDT_O_DZ
+REAL, DIMENSION(D%NIT,D%NKT) :: ZMZM_RHODJ
+REAL, DIMENSION(D%NIT,D%NKT) :: ZA, ZB, ZC
+REAL, DIMENSION(D%NIT,D%NKT) :: ZY ,ZGAM
! RHS of the equation, 3D work array
-REAL, DIMENSION(SIZE(PVARM,1)) :: ZBET
+REAL, DIMENSION(D%NIT) :: ZBET
! 2D work array
INTEGER :: JK ! loop counter
!
@@ -163,7 +160,7 @@ INTEGER :: JK ! loop counter
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('TRIDIAG_MASSFLUX',0,ZHOOK_HANDLE)
-ZMZM_RHODJ = MZM_MF(PRHODJ, KKA, KKU, KKL)
+CALL MZM_MF(D, PRHODJ, ZMZM_RHODJ)
ZRHODJ_DFDT_O_DZ = ZMZM_RHODJ*PDFDT/PDZZ
!
ZA=0.
@@ -175,30 +172,30 @@ ZY=0.
!* 2. COMPUTE THE RIGHT HAND SIDE
! ---------------------------
!
-ZY(:,KKB) = PRHODJ(:,KKB)*PVARM(:,KKB)/PTSTEP &
- - ZMZM_RHODJ(:,KKB+KKL) * PF(:,KKB+KKL)/PDZZ(:,KKB+KKL) &
- + ZMZM_RHODJ(:,KKB ) * PF(:,KKB )/PDZZ(:,KKB ) &
- + ZRHODJ_DFDT_O_DZ(:,KKB+KKL) * 0.5*PIMPL * PVARM(:,KKB+KKL) &
- + ZRHODJ_DFDT_O_DZ(:,KKB+KKL) * 0.5*PIMPL * PVARM(:,KKB )
+ZY(:,D%NKB) = PRHODJ(:,D%NKB)*PVARM(:,D%NKB)/PTSTEP &
+ - ZMZM_RHODJ(:,D%NKB+D%NKL) * PF(:,D%NKB+D%NKL)/PDZZ(:,D%NKB+D%NKL) &
+ + ZMZM_RHODJ(:,D%NKB ) * PF(:,D%NKB )/PDZZ(:,D%NKB ) &
+ + ZRHODJ_DFDT_O_DZ(:,D%NKB+D%NKL) * 0.5*PIMPL * PVARM(:,D%NKB+D%NKL) &
+ + ZRHODJ_DFDT_O_DZ(:,D%NKB+D%NKL) * 0.5*PIMPL * PVARM(:,D%NKB )
!
-DO JK=2+JPVEXT,SIZE(ZY,2)-JPVEXT-1
+DO JK=1+D%NKTB,D%NKTE-1
ZY(:,JK) = PRHODJ(:,JK)*PVARM(:,JK)/PTSTEP &
- - ZMZM_RHODJ(:,JK+KKL) * PF(:,JK+KKL)/PDZZ(:,JK+KKL) &
+ - ZMZM_RHODJ(:,JK+D%NKL) * PF(:,JK+D%NKL)/PDZZ(:,JK+D%NKL) &
+ ZMZM_RHODJ(:,JK ) * PF(:,JK )/PDZZ(:,JK ) &
- + ZRHODJ_DFDT_O_DZ(:,JK+KKL) * 0.5*PIMPL * PVARM(:,JK+KKL) &
- + ZRHODJ_DFDT_O_DZ(:,JK+KKL) * 0.5*PIMPL * PVARM(:,JK ) &
+ + ZRHODJ_DFDT_O_DZ(:,JK+D%NKL) * 0.5*PIMPL * PVARM(:,JK+D%NKL) &
+ + ZRHODJ_DFDT_O_DZ(:,JK+D%NKL) * 0.5*PIMPL * PVARM(:,JK ) &
- ZRHODJ_DFDT_O_DZ(:,JK ) * 0.5*PIMPL * PVARM(:,JK ) &
- - ZRHODJ_DFDT_O_DZ(:,JK ) * 0.5*PIMPL * PVARM(:,JK-KKL)
+ - ZRHODJ_DFDT_O_DZ(:,JK ) * 0.5*PIMPL * PVARM(:,JK-D%NKL)
END DO
!
-IF (JPVEXT==0) THEN
- ZY(:,KKE) = PRHODJ(:,KKE)*PVARM(:,KKE)/PTSTEP
+IF (D%NKE==D%NKU) THEN
+ ZY(:,D%NKE) = PRHODJ(:,D%NKE)*PVARM(:,D%NKE)/PTSTEP
ELSE
- ZY(:,KKE) = PRHODJ(:,KKE)*PVARM(:,KKE)/PTSTEP &
- - ZMZM_RHODJ(:,KKE+KKL) * PF(:,KKE+KKL)/PDZZ(:,KKE+KKL) &
- + ZMZM_RHODJ(:,KKE ) * PF(:,KKE )/PDZZ(:,KKE ) &
- - ZRHODJ_DFDT_O_DZ(:,KKE ) * 0.5*PIMPL * PVARM(:,KKE ) &
- - ZRHODJ_DFDT_O_DZ(:,KKE ) * 0.5*PIMPL * PVARM(:,KKE-KKL)
+ ZY(:,D%NKE) = PRHODJ(:,D%NKE)*PVARM(:,D%NKE)/PTSTEP &
+ - ZMZM_RHODJ(:,D%NKE+D%NKL) * PF(:,D%NKE+D%NKL)/PDZZ(:,D%NKE+D%NKL) &
+ + ZMZM_RHODJ(:,D%NKE ) * PF(:,D%NKE )/PDZZ(:,D%NKE ) &
+ - ZRHODJ_DFDT_O_DZ(:,D%NKE ) * 0.5*PIMPL * PVARM(:,D%NKE ) &
+ - ZRHODJ_DFDT_O_DZ(:,D%NKE ) * 0.5*PIMPL * PVARM(:,D%NKE-D%NKL)
ENDIF
!
!
@@ -210,57 +207,57 @@ IF ( PIMPL > 1.E-10 ) THEN
!* 3.1 arrays A, B, C
! --------------
!
- ZB(:,KKB) = PRHODJ(:,KKB)/PTSTEP &
- + ZRHODJ_DFDT_O_DZ(:,KKB+KKL) * 0.5*PIMPL
- ZC(:,KKB) = ZRHODJ_DFDT_O_DZ(:,KKB+KKL) * 0.5*PIMPL
+ ZB(:,D%NKB) = PRHODJ(:,D%NKB)/PTSTEP &
+ + ZRHODJ_DFDT_O_DZ(:,D%NKB+D%NKL) * 0.5*PIMPL
+ ZC(:,D%NKB) = ZRHODJ_DFDT_O_DZ(:,D%NKB+D%NKL) * 0.5*PIMPL
- DO JK=2+JPVEXT,SIZE(ZY,2)-JPVEXT-1
+ DO JK=1+D%NKTB,D%NKTE-1
ZA(:,JK) = - ZRHODJ_DFDT_O_DZ(:,JK ) * 0.5*PIMPL
ZB(:,JK) = PRHODJ(:,JK)/PTSTEP &
- + ZRHODJ_DFDT_O_DZ(:,JK+KKL) * 0.5*PIMPL &
+ + ZRHODJ_DFDT_O_DZ(:,JK+D%NKL) * 0.5*PIMPL &
- ZRHODJ_DFDT_O_DZ(:,JK ) * 0.5*PIMPL
- ZC(:,JK) = ZRHODJ_DFDT_O_DZ(:,JK+KKL) * 0.5*PIMPL
+ ZC(:,JK) = ZRHODJ_DFDT_O_DZ(:,JK+D%NKL) * 0.5*PIMPL
END DO
- ZA(:,KKE) = - ZRHODJ_DFDT_O_DZ(:,KKE ) * 0.5*PIMPL
- ZB(:,KKE) = PRHODJ(:,KKE)/PTSTEP &
- - ZRHODJ_DFDT_O_DZ(:,KKE ) * 0.5*PIMPL
+ ZA(:,D%NKE) = - ZRHODJ_DFDT_O_DZ(:,D%NKE ) * 0.5*PIMPL
+ ZB(:,D%NKE) = PRHODJ(:,D%NKE)/PTSTEP &
+ - ZRHODJ_DFDT_O_DZ(:,D%NKE ) * 0.5*PIMPL
!
!* 3.2 going up
! --------
!
- ZBET(:) = ZB(:,KKB) ! bet = b(KKB)
- PVARP(:,KKB) = ZY(:,KKB) / ZBET(:)
+ ZBET(:) = ZB(:,D%NKB) ! bet = b(D%NKB)
+ PVARP(:,D%NKB) = ZY(:,D%NKB) / ZBET(:)
!
- DO JK = KKB+KKL,KKE-KKL,KKL
- ZGAM(:,JK) = ZC(:,JK-KKL) / ZBET(:)
+ DO JK = D%NKB+D%NKL,D%NKE-D%NKL,D%NKL
+ ZGAM(:,JK) = ZC(:,JK-D%NKL) / ZBET(:)
! gam(k) = c(k-1) / bet
ZBET(:) = ZB(:,JK) - ZA(:,JK) * ZGAM(:,JK)
! bet = b(k) - a(k)* gam(k)
- PVARP(:,JK)= ( ZY(:,JK) - ZA(:,JK) * PVARP(:,JK-KKL) ) / ZBET(:)
+ PVARP(:,JK)= ( ZY(:,JK) - ZA(:,JK) * PVARP(:,JK-D%NKL) ) / ZBET(:)
! res(k) = (y(k) -a(k)*res(k-1))/ bet
END DO
! special treatment for the last level
- ZGAM(:,KKE) = ZC(:,KKE-KKL) / ZBET(:)
+ ZGAM(:,D%NKE) = ZC(:,D%NKE-D%NKL) / ZBET(:)
! gam(k) = c(k-1) / bet
- ZBET(:) = ZB(:,KKE) - ZA(:,KKE) * ZGAM(:,KKE)
+ ZBET(:) = ZB(:,D%NKE) - ZA(:,D%NKE) * ZGAM(:,D%NKE)
! bet = b(k) - a(k)* gam(k)
- PVARP(:,KKE)= ( ZY(:,KKE) - ZA(:,KKE) * PVARP(:,KKE-KKL) ) / ZBET(:)
+ PVARP(:,D%NKE)= ( ZY(:,D%NKE) - ZA(:,D%NKE) * PVARP(:,D%NKE-D%NKL) ) / ZBET(:)
! res(k) = (y(k) -a(k)*res(k-1))/ bet
!
!* 3.3 going down
! ----------
!
- DO JK = KKE-KKL,KKB,-KKL
- PVARP(:,JK) = PVARP(:,JK) - ZGAM(:,JK+KKL) * PVARP(:,JK+KKL)
+ DO JK = D%NKE-D%NKL,D%NKB,-D%NKL
+ PVARP(:,JK) = PVARP(:,JK) - ZGAM(:,JK+D%NKL) * PVARP(:,JK+D%NKL)
END DO
!
!
ELSE
!!! EXPLICIT FORMULATION
!
- DO JK=1+JPVEXT,SIZE(PVARP,2)-JPVEXT
+ DO JK=D%NKTB,D%NKTE
PVARP(:,JK) = ZY(:,JK) * PTSTEP / PRHODJ(:,JK)
ENDDO
!
@@ -270,8 +267,8 @@ END IF
!* 4. FILL THE UPPER AND LOWER EXTERNAL VALUES
! ----------------------------------------
!
-PVARP(:,KKA)=PVARP(:,KKB)
-PVARP(:,KKU)=PVARP(:,KKE)
+PVARP(:,D%NKA)=PVARP(:,D%NKB)
+PVARP(:,D%NKU)=PVARP(:,D%NKE)
!
!-------------------------------------------------------------------------------
!
diff --git a/src/common/turb/modi_shallow_mf.F90 b/src/common/turb/modi_shallow_mf.F90
index 23559eeec6a0afd8573c7c913de4933267eb154b..7271a8b0864437564fa5b5704a89603d5921dec9 100644
--- a/src/common/turb/modi_shallow_mf.F90
+++ b/src/common/turb/modi_shallow_mf.F90
@@ -4,7 +4,8 @@
!
INTERFACE
! #################################################################
- SUBROUTINE SHALLOW_MF(KKA,KKU,KKL,KRR,KRRL,KRRI, &
+ SUBROUTINE SHALLOW_MF(D, CST, NEB, PARAMMF, TURB, CSTURB, &
+ KRR, KRRL, KRRI, KSV, &
HMF_UPDRAFT, HMF_CLOUD, HFRAC_ICE, OMIXUV, &
ONOMIXLG,KSV_LGBEG,KSV_LGEND, &
PIMPL_MF, PTSTEP, &
@@ -23,16 +24,26 @@ INTERFACE
KKLCL,KKETL,KKCTL,PDX,PDY )
! #################################################################
!!
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+USE MODD_CST, ONLY: CST_t
+USE MODD_NEB, ONLY: NEB_t
+USE MODD_PARAM_MFSHALL_n, ONLY: PARAM_MFSHALL_t
+USE MODD_TURB_n, ONLY: TURB_t
+USE MODD_CTURB, ONLY: CSTURB_t
!
!* 1.1 Declaration of Arguments
!
!
-INTEGER, INTENT(IN) :: KKA ! near ground array index
-INTEGER, INTENT(IN) :: KKU ! uppest atmosphere array index
-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(NEB_t), INTENT(IN) :: NEB
+TYPE(PARAM_MFSHALL_t), INTENT(IN) :: PARAMMF
+TYPE(TURB_t), INTENT(IN) :: TURB
+TYPE(CSTURB_t), INTENT(IN) :: CSTURB
INTEGER, INTENT(IN) :: KRR ! number of moist var.
INTEGER, INTENT(IN) :: KRRL ! number of liquid water var.
INTEGER, INTENT(IN) :: KRRI ! number of ice water var.
+INTEGER, INTENT(IN) :: KSV
CHARACTER (LEN=4), INTENT(IN) :: HMF_UPDRAFT ! Type of Mass Flux Scheme
! 'NONE' if no parameterization
CHARACTER (LEN=4), INTENT(IN) :: HMF_CLOUD ! Type of statistical cloud
@@ -45,49 +56,49 @@ INTEGER, INTENT(IN) :: KSV_LGEND ! last index of lag. tracer
REAL, INTENT(IN) :: PIMPL_MF ! degre of implicitness
REAL, INTENT(IN) :: PTSTEP ! Dynamical timestep
-REAL, DIMENSION(:,:), INTENT(IN) :: PZZ ! Height of flux point
-REAL, DIMENSION(:,:), INTENT(IN) :: PDZZ ! Metric coefficients
-REAL, DIMENSION(:,:), INTENT(IN) :: PRHODJ ! dry density * Grid size
-REAL, DIMENSION(:,:), INTENT(IN) :: PRHODREF ! dry density of the
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(IN) :: PZZ ! Height of flux point
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(IN) :: PDZZ ! Metric coefficients
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(IN) :: PRHODJ ! dry density * Grid size
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(IN) :: PRHODREF ! dry density of the
! reference state
-REAL, DIMENSION(:,:), INTENT(IN) :: PPABSM ! Pressure at time t-1
-REAL, DIMENSION(:,:), INTENT(IN) :: PEXNM ! Exner function at t-dt
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(IN) :: PPABSM ! Pressure at time t-1
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(IN) :: PEXNM ! Exner function at t-dt
-REAL, DIMENSION(:), INTENT(IN) :: PSFTH,PSFRV ! normal surface fluxes of theta and Rv
-REAL, DIMENSION(:,:), INTENT(IN) :: PTHM ! Theta at t-dt
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRM ! water var. at t-dt
-REAL, DIMENSION(:,:), INTENT(IN) :: PUM,PVM ! wind components at t-dt
-REAL, DIMENSION(:,:), INTENT(IN) :: PTKEM ! tke at t-dt
+REAL, DIMENSION(D%NIT), INTENT(IN) :: PSFTH,PSFRV ! normal surface fluxes of theta and Rv
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(IN) :: PTHM ! Theta at t-dt
+REAL, DIMENSION(D%NIT,KRR), INTENT(IN) :: PRM ! water var. at t-dt
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(IN) :: PUM,PVM ! wind components at t-dt
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(IN) :: PTKEM ! tke at t-dt
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSVM ! scalar variable a t-dt
+REAL, DIMENSION(D%NIT,D%NKT,KSV), INTENT(IN) :: PSVM ! scalar variable a t-dt
-REAL, DIMENSION(:,:), INTENT(OUT):: PDUDT_MF ! tendency of U by massflux scheme
-REAL, DIMENSION(:,:), INTENT(OUT):: PDVDT_MF ! tendency of V by massflux scheme
-REAL, DIMENSION(:,:), INTENT(OUT):: PDTHLDT_MF ! tendency of thl by massflux scheme
-REAL, DIMENSION(:,:), INTENT(OUT):: PDRTDT_MF ! tendency of rt by massflux scheme
-REAL, DIMENSION(:,:,:), INTENT(OUT):: PDSVDT_MF ! tendency of Sv by massflux scheme
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(OUT):: PDUDT_MF ! tendency of U by massflux scheme
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(OUT):: PDVDT_MF ! tendency of V by massflux scheme
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(OUT):: PDTHLDT_MF ! tendency of thl by massflux scheme
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(OUT):: PDRTDT_MF ! tendency of rt by massflux scheme
+REAL, DIMENSION(D%NIT,D%NKT,KSV), INTENT(OUT):: PDSVDT_MF ! tendency of Sv by massflux scheme
-REAL, DIMENSION(:,:), INTENT(OUT) :: PSIGMF,PRC_MF,PRI_MF,PCF_MF ! cloud info for the cloud scheme
-REAL, DIMENSION(:,:), INTENT(OUT) :: PFLXZTHVMF ! Thermal production for TKE scheme
-REAL, DIMENSION(:,:), INTENT(OUT) :: PFLXZTHMF
-REAL, DIMENSION(:,:), INTENT(OUT) :: PFLXZRMF
-REAL, DIMENSION(:,:), INTENT(OUT) :: PFLXZUMF
-REAL, DIMENSION(:,:), INTENT(OUT) :: PFLXZVMF
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PTHL_UP ! Thl updraft characteristics
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PRT_UP ! Rt updraft characteristics
-REAL, DIMENSION(:,:), INTENT(OUT) :: PRV_UP ! Vapor updraft characteristics
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PU_UP ! U wind updraft characteristics
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PV_UP ! V wind updraft characteristics
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PRC_UP ! cloud content updraft characteristics
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PRI_UP ! ice content updraft characteristics
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PTHV_UP ! Thv updraft characteristics
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PW_UP ! vertical speed updraft characteristics
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PFRAC_UP ! updraft fraction
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PEMF ! updraft mass flux
-REAL, DIMENSION(:,:), INTENT(OUT) :: PDETR ! updraft detrainment
-REAL, DIMENSION(:,:), INTENT(OUT) :: PENTR ! updraft entrainment
-INTEGER,DIMENSION(:), INTENT(OUT) :: KKLCL,KKETL,KKCTL ! level of LCL,ETL and CTL
-REAL, INTENT(IN) :: PDX, PDY
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(OUT) :: PSIGMF,PRC_MF,PRI_MF,PCF_MF ! cloud info for the cloud scheme
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(OUT) :: PFLXZTHVMF ! Thermal production for TKE scheme
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(OUT) :: PFLXZTHMF
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(OUT) :: PFLXZRMF
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(OUT) :: PFLXZUMF
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(OUT) :: PFLXZVMF
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(INOUT) :: PTHL_UP ! Thl updraft characteristics
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(INOUT) :: PRT_UP ! Rt updraft characteristics
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(OUT) :: PRV_UP ! Vapor updraft characteristics
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(INOUT) :: PU_UP ! U wind updraft characteristics
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(INOUT) :: PV_UP ! V wind updraft characteristics
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(INOUT) :: PRC_UP ! cloud content updraft characteristics
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(INOUT) :: PRI_UP ! ice content updraft characteristics
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(INOUT) :: PTHV_UP ! Thv updraft characteristics
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(INOUT) :: PW_UP ! vertical speed updraft characteristics
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(INOUT) :: PFRAC_UP ! updraft fraction
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(INOUT) :: PEMF ! updraft mass flux
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(OUT) :: PDETR ! updraft detrainment
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(OUT) :: PENTR ! updraft entrainment
+INTEGER,DIMENSION(D%NIT), INTENT(OUT) :: KKLCL,KKETL,KKCTL ! level of LCL,ETL and CTL
+REAL, INTENT(IN) :: PDX, PDY
END SUBROUTINE SHALLOW_MF
diff --git a/src/common/turb/shallow_mf.F90 b/src/common/turb/shallow_mf.F90
index 814869f50f9f33b5914a93c2779b8fddbaa4aa21..c59028930612593fdcec07a62d02b97dc047fcec 100644
--- a/src/common/turb/shallow_mf.F90
+++ b/src/common/turb/shallow_mf.F90
@@ -4,7 +4,8 @@
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! ################################################################
- SUBROUTINE SHALLOW_MF(KKA,KKU,KKL,KRR,KRRL,KRRI, &
+ SUBROUTINE SHALLOW_MF(D, CST, NEB, PARAMMF, TURB, CSTURB, &
+ KRR, KRRL, KRRI, KSV, &
HMF_UPDRAFT, HMF_CLOUD, HFRAC_ICE, OMIXUV, &
ONOMIXLG,KSV_LGBEG,KSV_LGEND, &
PIMPL_MF, PTSTEP, &
@@ -71,11 +72,13 @@
!* 0. DECLARATIONS
! ------------
!
-USE MODD_CST
-USE MODD_PARAMETERS, ONLY: JPVEXT
-USE MODD_NEB, ONLY: NEB
-USE MODD_PARAM_MFSHALL_n
-
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+USE MODD_CST, ONLY: CST_t
+USE MODD_NEB, ONLY: NEB_t
+USE MODD_PARAM_MFSHALL_n, ONLY: PARAM_MFSHALL_t
+USE MODD_TURB_n, ONLY: TURB_t
+USE MODD_CTURB, ONLY: CSTURB_t
+!
USE MODE_THL_RT_FROM_TH_R_MF, ONLY: THL_RT_FROM_TH_R_MF
USE MODE_COMPUTE_UPDRAFT, ONLY: COMPUTE_UPDRAFT
USE MODE_COMPUTE_UPDRAFT_RHCJ10, ONLY: COMPUTE_UPDRAFT_RHCJ10
@@ -93,12 +96,16 @@ IMPLICIT NONE
!
!
!
-INTEGER, INTENT(IN) :: KKA ! near ground array index
-INTEGER, INTENT(IN) :: KKU ! uppest atmosphere array index
-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(NEB_t), INTENT(IN) :: NEB
+TYPE(PARAM_MFSHALL_t), INTENT(IN) :: PARAMMF
+TYPE(TURB_t), INTENT(IN) :: TURB
+TYPE(CSTURB_t), INTENT(IN) :: CSTURB
INTEGER, INTENT(IN) :: KRR ! number of moist var.
INTEGER, INTENT(IN) :: KRRL ! number of liquid water var.
INTEGER, INTENT(IN) :: KRRI ! number of ice water var.
+INTEGER, INTENT(IN) :: KSV
CHARACTER(LEN=4), INTENT(IN) :: HMF_UPDRAFT ! Type of Mass Flux Scheme
! 'NONE' if no parameterization
CHARACTER(LEN=4), INTENT(IN) :: HMF_CLOUD ! Type of statistical cloud
@@ -111,71 +118,71 @@ INTEGER, INTENT(IN) :: KSV_LGEND ! last index of lag. tracer
REAL, INTENT(IN) :: PIMPL_MF ! degre of implicitness
REAL, INTENT(IN) :: PTSTEP ! Dynamical timestep
-REAL, DIMENSION(:,:), INTENT(IN) :: PZZ ! Height of flux point
-REAL, DIMENSION(:,:), INTENT(IN) :: PDZZ ! Metric coefficients
-REAL, DIMENSION(:,:), INTENT(IN) :: PRHODJ ! dry density * Grid size
-REAL, DIMENSION(:,:), INTENT(IN) :: PRHODREF ! dry density of the
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(IN) :: PZZ ! Height of flux point
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(IN) :: PDZZ ! Metric coefficients
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(IN) :: PRHODJ ! dry density * Grid size
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(IN) :: PRHODREF ! dry density of the
! reference state
-REAL, DIMENSION(:,:), INTENT(IN) :: PPABSM ! Pressure at time t-1
-REAL, DIMENSION(:,:), INTENT(IN) :: PEXNM ! Exner function at t-dt
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(IN) :: PPABSM ! Pressure at time t-1
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(IN) :: PEXNM ! Exner function at t-dt
-REAL, DIMENSION(:), INTENT(IN) :: PSFTH,PSFRV ! normal surface fluxes of theta and Rv
-REAL, DIMENSION(:,:), INTENT(IN) :: PTHM ! Theta at t-dt
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRM ! water var. at t-dt
-REAL, DIMENSION(:,:), INTENT(IN) :: PUM,PVM ! wind components at t-dt
-REAL, DIMENSION(:,:), INTENT(IN) :: PTKEM ! tke at t-dt
+REAL, DIMENSION(D%NIT), INTENT(IN) :: PSFTH,PSFRV ! normal surface fluxes of theta and Rv
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(IN) :: PTHM ! Theta at t-dt
+REAL, DIMENSION(D%NIT,D%NKT,KRR), INTENT(IN) :: PRM ! water var. at t-dt
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(IN) :: PUM,PVM ! wind components at t-dt
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(IN) :: PTKEM ! tke at t-dt
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSVM ! scalar variable a t-dt
+REAL, DIMENSION(D%NIT,D%NKT,KSV), INTENT(IN) :: PSVM ! scalar variable a t-dt
-REAL, DIMENSION(:,:), INTENT(OUT):: PDUDT_MF ! tendency of U by massflux scheme
-REAL, DIMENSION(:,:), INTENT(OUT):: PDVDT_MF ! tendency of V by massflux scheme
-REAL, DIMENSION(:,:), INTENT(OUT):: PDTHLDT_MF ! tendency of thl by massflux scheme
-REAL, DIMENSION(:,:), INTENT(OUT):: PDRTDT_MF ! tendency of rt by massflux scheme
-REAL, DIMENSION(:,:,:), INTENT(OUT):: PDSVDT_MF ! tendency of Sv by massflux scheme
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(OUT):: PDUDT_MF ! tendency of U by massflux scheme
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(OUT):: PDVDT_MF ! tendency of V by massflux scheme
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(OUT):: PDTHLDT_MF ! tendency of thl by massflux scheme
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(OUT):: PDRTDT_MF ! tendency of rt by massflux scheme
+REAL, DIMENSION(D%NIT,D%NKT,KSV), INTENT(OUT):: PDSVDT_MF ! tendency of Sv by massflux scheme
-REAL, DIMENSION(:,:), INTENT(OUT) :: PSIGMF,PRC_MF,PRI_MF,PCF_MF ! cloud info for the cloud scheme
-REAL, DIMENSION(:,:), INTENT(OUT) :: PFLXZTHVMF ! Thermal production for TKE scheme
-REAL, DIMENSION(:,:), INTENT(OUT) :: PFLXZTHMF
-REAL, DIMENSION(:,:), INTENT(OUT) :: PFLXZRMF
-REAL, DIMENSION(:,:), INTENT(OUT) :: PFLXZUMF
-REAL, DIMENSION(:,:), INTENT(OUT) :: PFLXZVMF
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PTHL_UP ! Thl updraft characteristics
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PRT_UP ! Rt updraft characteristics
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PRV_UP ! Vapor updraft characteristics
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PU_UP ! U wind updraft characteristics
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PV_UP ! V wind updraft characteristics
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PRC_UP ! cloud content updraft characteristics
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PRI_UP ! ice content updraft characteristics
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PTHV_UP ! Thv updraft characteristics
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PW_UP ! vertical speed updraft characteristics
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PFRAC_UP ! updraft fraction
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PEMF ! updraft mass flux
-REAL, DIMENSION(:,:), INTENT(OUT) :: PDETR ! updraft detrainment
-REAL, DIMENSION(:,:), INTENT(OUT) :: PENTR ! updraft entrainment
-INTEGER,DIMENSION(:), INTENT(OUT) :: KKLCL,KKETL,KKCTL ! level of LCL,ETL and CTL
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(OUT) :: PSIGMF,PRC_MF,PRI_MF,PCF_MF ! cloud info for the cloud scheme
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(OUT) :: PFLXZTHVMF ! Thermal production for TKE scheme
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(OUT) :: PFLXZTHMF
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(OUT) :: PFLXZRMF
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(OUT) :: PFLXZUMF
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(OUT) :: PFLXZVMF
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(INOUT) :: PTHL_UP ! Thl updraft characteristics
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(INOUT) :: PRT_UP ! Rt updraft characteristics
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(INOUT) :: PRV_UP ! Vapor updraft characteristics
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(INOUT) :: PU_UP ! U wind updraft characteristics
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(INOUT) :: PV_UP ! V wind updraft characteristics
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(INOUT) :: PRC_UP ! cloud content updraft characteristics
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(INOUT) :: PRI_UP ! ice content updraft characteristics
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(INOUT) :: PTHV_UP ! Thv updraft characteristics
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(INOUT) :: PW_UP ! vertical speed updraft characteristics
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(INOUT) :: PFRAC_UP ! updraft fraction
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(INOUT) :: PEMF ! updraft mass flux
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(OUT) :: PDETR ! updraft detrainment
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(OUT) :: PENTR ! updraft entrainment
+INTEGER,DIMENSION(D%NIT), INTENT(OUT) :: KKLCL,KKETL,KKCTL ! level of LCL,ETL and CTL
REAL, INTENT(IN) :: PDX, PDY
!
! 0.2 Declaration of local variables
!
-REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: &
+REAL, DIMENSION(D%NIT,D%NKT) :: &
ZTHLM, & !
ZRTM, & !
ZTHVM, & !
ZEMF_O_RHODREF, & ! entrainment/detrainment
ZBUO_INTEG ! integrated buoyancy
-REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZFRAC_ICE
+REAL, DIMENSION(D%NIT,D%NKT) :: ZFRAC_ICE
+REAL, DIMENSION(D%NIT,D%NKT) :: ZWK
-REAL, DIMENSION(SIZE(PSVM,1),SIZE(PSVM,2),SIZE(PSVM,3)) :: &
+REAL, DIMENSION(D%NIT,D%NKT,KSV) :: &
ZSV_UP,& ! updraft scalar var.
ZFLXZSVMF ! Flux
-REAL, DIMENSION(SIZE(PTHM,1)) :: ZDEPTH ! Deepness of cloud
-REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZFRAC_ICE_UP ! liquid/solid fraction in updraft
-REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZRSAT_UP ! Rsat in updraft
+REAL, DIMENSION(D%NIT) :: ZDEPTH ! Deepness of cloud
+REAL, DIMENSION(D%NIT,D%NKT) :: ZFRAC_ICE_UP ! liquid/solid fraction in updraft
+REAL, DIMENSION(D%NIT,D%NKT) :: ZRSAT_UP ! Rsat in updraft
LOGICAL :: GENTR_DETR ! flag to recompute entrainment, detrainment and mass flux
-INTEGER :: IKB ! near ground physical index
-INTEGER :: IKE ! uppest atmosphere physical index
-INTEGER, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: IERR
+INTEGER, DIMENSION(D%NIT,D%NKT) :: IERR
+INTEGER :: JI, JK
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!------------------------------------------------------------------------
@@ -183,10 +190,6 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!!! 1. Initialisation
IF (LHOOK) CALL DR_HOOK('SHALLOW_MF',0,ZHOOK_HANDLE)
-! vertical boundaries
-IKB=KKA+KKL*JPVEXT
-IKE=KKU-KKL*JPVEXT
-
! updraft governing variables
IF (HMF_UPDRAFT == 'EDKF' .OR. HMF_UPDRAFT == 'RHCJ') THEN
PENTR = 1.E20
@@ -197,28 +200,35 @@ ENDIF
! Thermodynamics functions
ZFRAC_ICE(:,:) = 0.
-IF (SIZE(PRM,3).GE.4) THEN
- WHERE(PRM(:,:,2)+PRM(:,:,4) > 1.E-20)
- ZFRAC_ICE(:,:) = PRM(:,:,4) / (PRM(:,:,2)+PRM(:,:,4))
+IF (KRR.GE.4) THEN
+ !$mnh_expand_where(JI=D%NIB:D%NIE,JK=D%NKTB:D%NKTE)
+ WHERE(PRM(D%NIB:D%NIE,:,2)+PRM(D%NIB:D%NIE,:,4) > 1.E-20)
+ ZFRAC_ICE(D%NIB:D%NIE,:) = PRM(D%NIB:D%NIE,:,4) / (PRM(D%NIB:D%NIE,:,2)+PRM(D%NIB:D%NIE,:,4))
ENDWHERE
+ !$mnh_end_expand_where(JI=D%NIB:D%NIE,JK=D%NKTB:D%NKTE)
ENDIF
-CALL COMPUTE_FRAC_ICE(HFRAC_ICE,NEB,ZFRAC_ICE(:,:),PTHM(:,:)*PEXNM(:,:), IERR(:,:))
+!$mnh_expand_array(JI=D%NIB:D%NIE,JK=D%NKTB:D%NKTE)
+ZWK(D%NIB:D%NIE,:)=PTHM(D%NIB:D%NIE,:)*PEXNM(D%NIB:D%NIE,:)
+!$mnh_end_expand_array(JI=D%NIB:D%NIE,JK=D%NKTB:D%NKTE)
+CALL COMPUTE_FRAC_ICE(HFRAC_ICE,NEB,ZFRAC_ICE(:,:),ZWK(:,:), IERR(:,:))
! Conservative variables at t-dt
-CALL THL_RT_FROM_TH_R_MF(KRR,KRRL,KRRI, &
+CALL THL_RT_FROM_TH_R_MF(D, CST, KRR,KRRL,KRRI, &
PTHM, PRM, PEXNM, &
ZTHLM, ZRTM )
! Virtual potential temperature at t-dt
-ZTHVM(:,:) = PTHM(:,:)*((1.+XRV / XRD *PRM(:,:,1))/(1.+ZRTM(:,:)))
-
+!$mnh_expand_array(JI=D%NIB:D%NIE,JK=D%NKTB:D%NKTE)
+ZTHVM(D%NIB:D%NIE,:) = PTHM(D%NIB:D%NIE,:)*((1.+CST%XRV / CST%XRD *PRM(D%NIB:D%NIE,:,1))/(1.+ZRTM(D%NIB:D%NIE,:)))
+!$mnh_end_expand_array(JI=D%NIB:D%NIE,JK=D%NKTB:D%NKTE)
!
!!! 2. Compute updraft
!!! ---------------
!
IF (HMF_UPDRAFT == 'EDKF') THEN
GENTR_DETR = .TRUE.
- CALL COMPUTE_UPDRAFT(KKA,IKB,IKE,KKU,KKL,HFRAC_ICE,GENTR_DETR,OMIXUV,&
+ CALL COMPUTE_UPDRAFT(D, CST, NEB, PARAMMF, TURB, CSTURB, &
+ KSV, HFRAC_ICE, GENTR_DETR, OMIXUV, &
ONOMIXLG,KSV_LGBEG,KSV_LGEND, &
PZZ,PDZZ, &
PSFTH,PSFRV,PPABSM,PRHODREF, &
@@ -231,7 +241,8 @@ IF (HMF_UPDRAFT == 'EDKF') THEN
PDX,PDY)
ELSEIF (HMF_UPDRAFT == 'RHCJ') THEN
GENTR_DETR = .TRUE.
- CALL COMPUTE_UPDRAFT_RHCJ10(KKA,IKB,IKE,KKU,KKL,HFRAC_ICE,GENTR_DETR,OMIXUV,&
+ CALL COMPUTE_UPDRAFT_RHCJ10(D, CST, NEB, PARAMMF, TURB, CSTURB,&
+ KSV, HFRAC_ICE, GENTR_DETR, OMIXUV, &
ONOMIXLG,KSV_LGBEG,KSV_LGEND, &
PZZ,PDZZ, &
PSFTH,PSFRV,PPABSM,PRHODREF, &
@@ -242,8 +253,8 @@ ELSEIF (HMF_UPDRAFT == 'RHCJ') THEN
PFRAC_UP,ZFRAC_ICE_UP,ZRSAT_UP,PEMF,PDETR,&
PENTR,ZBUO_INTEG,KKLCL,KKETL,KKCTL,ZDEPTH )
ELSEIF (HMF_UPDRAFT == 'RAHA') THEN
- CALL COMPUTE_UPDRAFT_RAHA(KKA,IKB,IKE,KKU,KKL,HFRAC_ICE, &
- GENTR_DETR,OMIXUV, &
+ CALL COMPUTE_UPDRAFT_RAHA(D, CST, NEB, PARAMMF, &
+ KSV, HFRAC_ICE, GENTR_DETR, OMIXUV, &
ONOMIXLG,KSV_LGBEG,KSV_LGEND, &
PZZ,PDZZ, &
PSFTH,PSFRV, &
@@ -265,7 +276,7 @@ ENDIF
!!! 5. Compute diagnostic convective cloud fraction and content
!!! --------------------------------------------------------
!
-CALL COMPUTE_MF_CLOUD(KKA,IKB,IKE,KKU,KKL,KRR,KRRL,KRRI,&
+CALL COMPUTE_MF_CLOUD(D, CST, PARAMMF, KRR, KRRL, KRRI, &
HMF_CLOUD,ZFRAC_ICE, &
PRC_UP,PRI_UP,PEMF, &
PTHL_UP,PRT_UP,PFRAC_UP, &
@@ -280,10 +291,12 @@ CALL COMPUTE_MF_CLOUD(KKA,IKB,IKE,KKU,KKL,KRR,KRRL,KRRI,&
!!! 3. Compute fluxes of conservative variables and their divergence = tendency
!!! ------------------------------------------------------------------------
!
-ZEMF_O_RHODREF=PEMF/PRHODREF
+!$mnh_expand_array(JI=D%NIB:D%NIE,JK=D%NKTB:D%NKTE)
+ZEMF_O_RHODREF(D%NIB:D%NIE,:)=PEMF(D%NIB:D%NIE,:)/PRHODREF(D%NIB:D%NIE,:)
+!$mnh_end_expand_array(JI=D%NIB:D%NIE,JK=D%NKTB:D%NKTE)
IF ( PIMPL_MF > 1.E-10 ) THEN
- CALL MF_TURB(KKA, IKB, IKE, KKU, KKL, OMIXUV, &
+ CALL MF_TURB(D, KSV, OMIXUV, &
ONOMIXLG,KSV_LGBEG,KSV_LGEND, &
PIMPL_MF, PTSTEP, &
PDZZ, &
@@ -294,7 +307,7 @@ IF ( PIMPL_MF > 1.E-10 ) THEN
PFLXZTHMF,PFLXZTHVMF,PFLXZRMF,PFLXZUMF,PFLXZVMF, &
ZFLXZSVMF )
ELSE
- CALL MF_TURB_EXPL(KKA, IKB, IKE, KKU, KKL, OMIXUV, &
+ CALL MF_TURB_EXPL(D, PARAMMF, OMIXUV, &
PRHODJ, &
ZTHLM,ZTHVM,ZRTM,PUM,PVM, &
PDTHLDT_MF,PDRTDT_MF,PDUDT_MF,PDVDT_MF, &
diff --git a/src/common/turb/shuman_mf.F90 b/src/common/turb/shuman_mf.F90
index 8c1c1ade02fbc219bd9d6143c08cd42293a50bb9..2618e4052fbb194b1e577006eaa3cac0a972ebac 100644
--- a/src/common/turb/shuman_mf.F90
+++ b/src/common/turb/shuman_mf.F90
@@ -8,51 +8,56 @@
!
INTERFACE
!
-FUNCTION DZF_MF(PA, KKA, KKU, KKL) RESULT(PDZF)
-REAL, DIMENSION(:,:), INTENT(IN) :: PA ! variable at flux side
-INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
-INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
-REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2)) :: PDZF ! result at mass
+SUBROUTINE DZF_MF(D, PA, PDZF)
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+IMPLICIT NONE
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(IN) :: PA ! variable at flux side
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(OUT) :: PDZF ! result at mass
! localization
-END FUNCTION DZF_MF
+END SUBROUTINE DZF_MF
!
-FUNCTION DZM_MF(PA, KKA, KKU, KKL) RESULT(PDZM)
-REAL, DIMENSION(:,:), INTENT(IN) :: PA ! variable at mass localization
-INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
-INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
-REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2)) :: PDZM ! result at flux
+SUBROUTINE DZM_MF(D, PA, PDZM)
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+IMPLICIT NONE
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(IN) :: PA ! variable at mass localization
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(OUT) :: PDZM ! result at flux
! side
-END FUNCTION DZM_MF
+END SUBROUTINE DZM_MF
!
-FUNCTION MZF_MF(PA, KKA, KKU, KKL) RESULT(PMZF)
-REAL, DIMENSION(:,:), INTENT(IN) :: PA ! variable at flux side
-INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
-INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
-REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2)) :: PMZF ! result at mass
+SUBROUTINE MZF_MF(D, PA, PMZF)
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+IMPLICIT NONE
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(IN) :: PA ! variable at flux side
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(OUT) :: PMZF ! result at mass
! localization
-END FUNCTION MZF_MF
-!
-FUNCTION MZM_MF(PA, KKA, KKU, KKL) RESULT(PMZM)
-REAL, DIMENSION(:,:), INTENT(IN) :: PA ! variable at mass localization
-INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
-INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
-REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2)) :: PMZM ! result at flux localization
-END FUNCTION MZM_MF
-!
-FUNCTION GZ_M_W_MF(PY,PDZZ, KKA, KKU, KKL) RESULT(PGZ_M_W)
-REAL, DIMENSION(:,:), INTENT(IN) :: PDZZ ! Metric coefficient d*zz
-REAL, DIMENSION(:,:), INTENT(IN) :: PY ! variable at mass localization
-INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
-INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
-REAL, DIMENSION(SIZE(PY,1),SIZE(PY,2)) :: PGZ_M_W ! result at flux side
-END FUNCTION GZ_M_W_MF
+END SUBROUTINE MZF_MF
+!
+SUBROUTINE MZM_MF(D, PA, PMZM)
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+IMPLICIT NONE
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(IN) :: PA ! variable at mass localization
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(OUT) :: PMZM ! result at flux localization
+END SUBROUTINE MZM_MF
+!
+SUBROUTINE GZ_M_W_MF(D, PY, PDZZ, PGZ_M_W)
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+IMPLICIT NONE
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(IN) :: PDZZ ! Metric coefficient d*zz
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(IN) :: PY ! variable at mass localization
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(OUT) :: PGZ_M_W ! result at flux side
+END SUBROUTINE GZ_M_W_MF
!
END INTERFACE
!
END MODULE MODI_SHUMAN_MF
!
! ###############################
- FUNCTION MZF_MF(PA, KKA, KKU, KKL) RESULT(PMZF)
+ SUBROUTINE MZF_MF(D, PA, PMZF)
! ###############################
!
!!**** *MZF* - SHUMAN_MF operator : mean operator in z direction for a
@@ -98,15 +103,15 @@ END MODULE MODI_SHUMAN_MF
!* 0. DECLARATIONS
! ------------
!
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
IMPLICIT NONE
!
!* 0.1 Declarations of argument and result
! ------------------------------------
!
-REAL, DIMENSION(:,:), INTENT(IN) :: PA ! variable at flux side
-INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
-INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
-REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2)) :: PMZF ! result at mass
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(IN) :: PA ! variable at flux side
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(OUT) :: PMZF ! result at mass
! localization
!
!* 0.2 Declarations of local variables
@@ -120,17 +125,17 @@ INTEGER :: JK ! Loop index in z direction
!* 1. DEFINITION OF MZF
! ------------------
!
-DO JK=2,SIZE(PA,2)-1
- PMZF(:,JK) = 0.5*( PA(:,JK)+PA(:,JK+KKL) )
+DO JK=2,D%NKT-1
+ PMZF(:,JK) = 0.5*( PA(:,JK)+PA(:,JK+D%NKL) )
END DO
-PMZF(:,KKA) = 0.5*( PA(:,KKA)+PA(:,KKA+KKL) )
-PMZF(:,KKU) = PA(:,KKU)
+PMZF(:,D%NKA) = 0.5*( PA(:,D%NKA)+PA(:,D%NKA+D%NKL) )
+PMZF(:,D%NKU) = PA(:,D%NKU)
!
!-------------------------------------------------------------------------------
!
-END FUNCTION MZF_MF
+END SUBROUTINE MZF_MF
! ###############################
- FUNCTION MZM_MF(PA, KKA, KKU, KKL) RESULT(PMZM)
+ SUBROUTINE MZM_MF(D, PA, PMZM)
! ###############################
!
!!**** *MZM* - SHUMAN_MF operator : mean operator in z direction for a
@@ -176,15 +181,15 @@ END FUNCTION MZF_MF
!* 0. DECLARATIONS
! ------------
!
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
IMPLICIT NONE
!
!* 0.1 Declarations of argument and result
! ------------------------------------
!
-REAL, DIMENSION(:,:), INTENT(IN) :: PA ! variable at mass localization
-INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
-INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
-REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2)) :: PMZM ! result at flux localization
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(IN) :: PA ! variable at mass localization
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(OUT) :: PMZM ! result at flux localization
!
!* 0.2 Declarations of local variables
! -------------------------------
@@ -197,17 +202,17 @@ INTEGER :: JK ! Loop index in z direction
!* 1. DEFINITION OF MZM
! ------------------
!
-DO JK=2,SIZE(PA,2)-1
- PMZM(:,JK) = 0.5*( PA(:,JK)+PA(:,JK-KKL) )
+DO JK=2,D%NKT-1
+ PMZM(:,JK) = 0.5*( PA(:,JK)+PA(:,JK-D%NKL) )
END DO
-PMZM(:,KKA) = PA(:,KKA)
-PMZM(:,KKU) = 0.5*( PA(:,KKU)+PA(:,KKU-KKL) )
+PMZM(:,D%NKA) = PA(:,D%NKA)
+PMZM(:,D%NKU) = 0.5*( PA(:,D%NKU)+PA(:,D%NKU-D%NKL) )
!
!-------------------------------------------------------------------------------
!
-END FUNCTION MZM_MF
+END SUBROUTINE MZM_MF
! ###############################
- FUNCTION DZF_MF(PA, KKA, KKU, KKL) RESULT(PDZF)
+ SUBROUTINE DZF_MF(D, PA, PDZF)
! ###############################
!
!!**** *DZF* - SHUMAN_MF operator : finite difference operator in z direction
@@ -253,15 +258,15 @@ END FUNCTION MZM_MF
!* 0. DECLARATIONS
! ------------
!
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
IMPLICIT NONE
!
!* 0.1 Declarations of argument and result
! ------------------------------------
!
-REAL, DIMENSION(:,:), INTENT(IN) :: PA ! variable at flux side
-INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
-INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
-REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2)) :: PDZF ! result at mass
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(IN) :: PA ! variable at flux side
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(OUT) :: PDZF ! result at mass
! localization
!
!* 0.2 Declarations of local variables
@@ -274,17 +279,17 @@ INTEGER :: JK ! Loop index in z direction
!* 1. DEFINITION OF DZF
! ------------------
!
-DO JK=2,SIZE(PA,2)-1
- PDZF(:,JK) = PA(:,JK+KKL) - PA(:,JK)
+DO JK=2,D%NKT-1
+ PDZF(:,JK) = PA(:,JK+D%NKL) - PA(:,JK)
END DO
-PDZF(:,KKA) = PA(:,KKA+KKL) - PA(:,KKA)
-PDZF(:,KKU) = 0.
+PDZF(:,D%NKA) = PA(:,D%NKA+D%NKL) - PA(:,D%NKA)
+PDZF(:,D%NKU) = 0.
!
!-------------------------------------------------------------------------------
!
-END FUNCTION DZF_MF
+END SUBROUTINE DZF_MF
! ###############################
- FUNCTION DZM_MF(PA, KKA, KKU, KKL) RESULT(PDZM)
+ SUBROUTINE DZM_MF(D, PA, PDZM)
! ###############################
!
!!**** *DZM* - SHUMAN_MF operator : finite difference operator in z direction
@@ -330,15 +335,15 @@ END FUNCTION DZF_MF
!* 0. DECLARATIONS
! ------------
!
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
IMPLICIT NONE
!
!* 0.1 Declarations of argument and result
! ------------------------------------
!
-REAL, DIMENSION(:,:), INTENT(IN) :: PA ! variable at mass localization
-INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
-INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
-REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2)) :: PDZM ! result at flux
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(IN) :: PA ! variable at mass localization
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(OUT) :: PDZM ! result at flux
! side
!
!* 0.2 Declarations of local variables
@@ -351,18 +356,18 @@ INTEGER :: JK ! Loop index in z direction
!* 1. DEFINITION OF DZM
! ------------------
!
-DO JK=2,SIZE(PA,2)-1
- PDZM(:,JK) = PA(:,JK) - PA(:,JK-KKL)
+DO JK=2,D%NKT-1
+ PDZM(:,JK) = PA(:,JK) - PA(:,JK-D%NKL)
END DO
-PDZM(:,KKA) = 0.
-PDZM(:,KKU) = PA(:,KKU) - PA(:,KKU-KKL)
+PDZM(:,D%NKA) = 0.
+PDZM(:,D%NKU) = PA(:,D%NKU) - PA(:,D%NKU-D%NKL)
!
!-------------------------------------------------------------------------------
!
-END FUNCTION DZM_MF
+END SUBROUTINE DZM_MF
! ###############################
- FUNCTION GZ_M_W_MF(PY,PDZZ, KKA, KKU, KKL) RESULT(PGZ_M_W)
+ SUBROUTINE GZ_M_W_MF(D, PY, PDZZ, PGZ_M_W)
! ###############################
!
!!**** *GZ_M_W * - Compute the gradient along z direction for a
@@ -408,16 +413,16 @@ END FUNCTION DZM_MF
!
!-------------------------------------------------------------------------------
!
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
IMPLICIT NONE
!
!* 0.1 Declarations of argument and result
! ------------------------------------
!
-REAL, DIMENSION(:,:), INTENT(IN) :: PDZZ ! Metric coefficient d*zz
-REAL, DIMENSION(:,:), INTENT(IN) :: PY ! variable at mass localization
-INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
-INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
-REAL, DIMENSION(SIZE(PY,1),SIZE(PY,2)) :: PGZ_M_W ! result at flux side
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(IN) :: PDZZ ! Metric coefficient d*zz
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(IN) :: PY ! variable at mass localization
+REAL, DIMENSION(D%NIT,D%NKT), INTENT(OUT) :: PGZ_M_W ! result at flux side
!
!* 0.2 Declarations of local variables
! -------------------------------
@@ -428,12 +433,12 @@ INTEGER JK
!* 1. COMPUTE THE GRADIENT ALONG Z
! -----------------------------
!
-DO JK=2,SIZE(PY,2)-1
- PGZ_M_W(:,JK) = (PY(:,JK) - PY(:,JK-KKL)) / PDZZ(:,JK)
+DO JK=2,D%NKT-1
+ PGZ_M_W(:,JK) = (PY(:,JK) - PY(:,JK-D%NKL)) / PDZZ(:,JK)
END DO
-PGZ_M_W(:,KKA) = 0.
-PGZ_M_W(:,KKU) = (PY(:,KKU) - PY(:,KKU-KKL)) / PDZZ(:,KKU)
+PGZ_M_W(:,D%NKA) = 0.
+PGZ_M_W(:,D%NKU) = (PY(:,D%NKU) - PY(:,D%NKU-D%NKL)) / PDZZ(:,D%NKU)
!
!-------------------------------------------------------------------------------
!
-END FUNCTION GZ_M_W_MF
+END SUBROUTINE GZ_M_W_MF
diff --git a/src/common/turb/th_r_from_thl_rt.func.h b/src/common/turb/th_r_from_thl_rt.func.h
new file mode 100644
index 0000000000000000000000000000000000000000..5a571b688d6ca46c05818bd43cc87947491f043a
--- /dev/null
+++ b/src/common/turb/th_r_from_thl_rt.func.h
@@ -0,0 +1,201 @@
+!MNH_LIC Copyright 2006-2022 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+ SUBROUTINE TH_R_FROM_THL_RT(CST, NEB, KT, HFRAC_ICE,PFRAC_ICE,PP, &
+ PTHL, PRT, PTH, PRV, PRL, PRI, &
+ PRSATW, PRSATI, PRR, PRS, PRG, PRH, OOCEAN,&
+ PBUF, KB, KE)
+! ******* TO BE INCLUDED IN THE *CONTAINS* OF A SUBROUTINE, IN ORDER TO EASE AUTOMATIC INLINING ******
+! => Don't use drHook !!!
+! "compute_frac_ice.func.h" must be included at the same time
+! #################################################################
+!
+!
+!!**** *TH_R_FROM_THL_RT* - computes the non-conservative variables
+!! from conservative variables
+!!
+!! PURPOSE
+!! -------
+!!
+!!** METHOD
+!! ------
+!!
+!!
+!! EXTERNAL
+!! --------
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!!
+!! REFERENCE
+!! ---------
+!!
+!! AUTHOR
+!! ------
+!! Julien PERGAUD * Meteo-France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 13/03/06
+!! S. Riette April 2011 : ice added, allow ZRLTEMP to be negative
+!! we use dQsat/dT to help convergence
+!! use of optional PRR, PRS, PRG, PRH
+!! S. Riette Nov 2016: support for HFRAC_ICE='S'
+!!
+!! --------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CST, ONLY : CST_t
+USE MODD_NEB, ONLY : NEB_t
+!
+IMPLICIT NONE
+!
+!
+!* 0.1 declarations of arguments
+!
+TYPE(CST_t), INTENT(IN) :: CST
+TYPE(NEB_t), INTENT(IN) :: NEB
+INTEGER, INTENT(IN) :: KT
+CHARACTER(LEN=1), INTENT(IN) :: HFRAC_ICE
+LOGICAL, INTENT(IN) :: OOCEAN ! switch for Ocean model version
+REAL, DIMENSION(KT), INTENT(INOUT) :: PFRAC_ICE
+REAL, DIMENSION(KT), INTENT(IN) :: PP ! Pressure
+REAL, DIMENSION(KT), INTENT(IN) :: PTHL ! thetal to transform into th
+REAL, DIMENSION(KT),INTENT(IN) :: PRT ! Total mixing ratios to transform into rv,rc and ri
+REAL, DIMENSION(KT),OPTIONAL,INTENT(IN) :: PRR, PRS, PRG, PRH
+REAL, DIMENSION(KT), INTENT(OUT):: PTH ! th
+REAL, DIMENSION(KT), INTENT(OUT):: PRV ! vapor mixing ratio
+REAL, DIMENSION(KT), INTENT(INOUT):: PRL ! vapor mixing ratio
+REAL, DIMENSION(KT), INTENT(INOUT):: PRI ! vapor mixing ratio
+REAL, DIMENSION(KT), INTENT(OUT) :: PRSATW ! estimated mixing ration at saturation over water
+REAL, DIMENSION(KT), INTENT(OUT) :: PRSATI ! estimated mixing ration at saturation over ice
+REAL, DIMENSION(KT, 16), INTENT(OUT) :: PBUF ! buffer to replace automatic arrays
+INTEGER, OPTIONAL :: KB !first index to deal with (default is 1)
+INTEGER, OPTIONAL :: KE !last index to deal with (default if KT)
+!
+!-------------------------------------------------------------------------------
+!
+! 0.2 declaration of local variables
+INTEGER :: II ! Loop control
+INTEGER :: JITER ! number of iterations
+INTEGER :: J, IB, IE
+INTEGER, PARAMETER :: IEXN=1, IRVSAT=2, ICPH=3, IRLTEMP=4, ICPH2=5, IT=6, ILVOCPEXN=7, ILSOCPEXN=8, &
+ & IDRSATODT=9, IDRSATODTW=10, IDRSATODTI=11, IFOESW=12, IFOESI=13, &
+ & ILOGT=14, I99PP=15, I1PRT=16
+REAL :: ZVAR1, ZVAR2, ZTPOW2, ZDELT
+
+!----------------------------------------------------------------------------
+!
+!* 1 Initialisation
+! --------------
+!
+!
+!
+IB=MERGE(KB, 1, PRESENT(KB))
+IE=MERGE(KE, KT, PRESENT(KE))
+!Number of iterations
+JITER=2
+!
+!Computation of PBUF(IB:IE, ICPH2) depending on dummy arguments received
+PBUF(IB:IE, ICPH2)=0
+IF(PRESENT(PRR)) PBUF(IB:IE, ICPH2)=PBUF(IB:IE, ICPH2) + CST%XCL*PRR(IB:IE)
+IF(PRESENT(PRS)) PBUF(IB:IE, ICPH2)=PBUF(IB:IE, ICPH2) + CST%XCI*PRS(IB:IE)
+IF(PRESENT(PRG)) PBUF(IB:IE, ICPH2)=PBUF(IB:IE, ICPH2) + CST%XCI*PRG(IB:IE)
+IF(PRESENT(PRH)) PBUF(IB:IE, ICPH2)=PBUF(IB:IE, ICPH2) + CST%XCI*PRH(IB:IE)
+!
+!Computation of an approximate state thanks to PRL and PRI guess
+PBUF(IB:IE, IEXN)=(PP(IB:IE)/CST%XP00) ** CST%RDSCPD
+
+DO J=IB,IE
+ PBUF(J, I99PP)=0.99*PP(J)
+ PRV(J)=PRT(J)-PRL(J)-PRI(J)
+ PBUF(J, ICPH)=CST%XCPD+ CST%XCPV * PRV(J)+ CST%XCL * PRL(J) + CST%XCI * PRI(J) + PBUF(J, ICPH2)
+ ZVAR2=PBUF(J, ICPH)*PBUF(J, IEXN)
+ ZDELT=(PTHL(J)*PBUF(J, IEXN))-CST%XTT
+ PBUF(J, ILVOCPEXN) = (CST%XLVTT + (CST%XCPV-CST%XCL) * ZDELT) /ZVAR2
+ PBUF(J, ILSOCPEXN) = (CST%XLSTT + (CST%XCPV-CST%XCI) * ZDELT) /ZVAR2
+ PTH(J)=PTHL(J)+PBUF(J, ILVOCPEXN)*PRL(J)+PBUF(J, ILSOCPEXN)*PRI(J)
+ PBUF(J, I1PRT)=1+PRT(J)
+ENDDO
+!
+!
+! 2 Iteration
+! ---------
+
+DO II=1,JITER
+ IF (OOCEAN) THEN
+ PBUF(IB:IE, IT)=PTH(IB:IE)
+ ELSE
+ PBUF(IB:IE, IT)=PTH(IB:IE)*PBUF(IB:IE, IEXN)
+ END IF
+ !Computation of liquid/ice fractions
+ PFRAC_ICE(IB:IE) = 0.
+ DO J=IB, IE
+ IF(PRL(J)+PRI(J) > 1.E-20) THEN
+ PFRAC_ICE(J) = PRI(J) / (PRL(J)+PRI(J))
+ ENDIF
+ ENDDO
+ CALL COMPUTE_FRAC_ICE(HFRAC_ICE,NEB,PFRAC_ICE(IB:IE),PBUF(IB:IE, IT))
+
+ !Computation of Rvsat and dRsat/dT
+ !In this version QSAT, QSATI, DQSAT and DQASATI functions are not used
+ !due to performance issue
+
+ ! Log does not vectorize on all compilers:
+ PBUF(IB:IE, ILOGT)=LOG(PBUF(IB:IE, IT))
+
+ DO J=IB, IE
+ PBUF(J, IFOESW) = MIN(EXP( CST%XALPW - CST%XBETAW/PBUF(J, IT) - CST%XGAMW*PBUF(J, ILOGT) ), PBUF(J, I99PP))
+ PBUF(J, IFOESI) = MIN(EXP( CST%XALPI - CST%XBETAI/PBUF(J, IT) - CST%XGAMI*PBUF(J, ILOGT) ), PBUF(J, I99PP))
+ PRSATW(J) = CST%XRD/CST%XRV*PBUF(J, IFOESW)/PP(J) / (1.+(CST%XRD/CST%XRV-1.)*PBUF(J, IFOESW)/PP(J))
+ PRSATI(J) = CST%XRD/CST%XRV*PBUF(J, IFOESI)/PP(J) / (1.+(CST%XRD/CST%XRV-1.)*PBUF(J, IFOESI)/PP(J))
+ ZTPOW2=PBUF(J, IT)**2
+ PBUF(J, IDRSATODTW) = PRSATW(J) / (1.+(CST%XRD/CST%XRV-1.)*PBUF(J, IFOESW)/PP(J) ) &
+ * (CST%XBETAW/ZTPOW2 - CST%XGAMW/PBUF(J, IT))*PBUF(J, I1PRT)
+ PBUF(J, IDRSATODTI) = PRSATI(J) / (1.+(CST%XRD/CST%XRV-1.)*PBUF(J, IFOESI)/PP(J) ) &
+ * (CST%XBETAI/ZTPOW2 - CST%XGAMI/PBUF(J, IT))*PBUF(J, I1PRT)
+ !PRSATW(J) = QSAT(PBUF(J, IT),PP(J)) !qsatw
+ !PRSATI(J) = QSATI(PBUF(J, IT),PP(J)) !qsati
+ !PBUF(J, IDRSATODTW) = DQSAT(PBUF(J, IT),PP(J),PRSATW(J))*PBUF(J, I1PRT)
+ !PBUF(J, IDRSATODTI) = DQSATI(PBUF(J, IT),PP(J),PRSATI(J))*PBUF(J, I1PRT)
+ PRSATW(J) = PRSATW(J)*PBUF(J, I1PRT)
+ PRSATI(J) = PRSATI(J)*PBUF(J, I1PRT)
+ PBUF(J, IRVSAT) = PRSATW(J)*(1-PFRAC_ICE(J)) + PRSATI(J)*PFRAC_ICE(J)
+ PBUF(J, IDRSATODT) = (PBUF(J, IDRSATODTW)*(1-PFRAC_ICE(J))+ &
+ & PBUF(J, IDRSATODTI)*PFRAC_ICE(J))
+
+ !Computation of new PRL, PRI and PRV
+ !Correction term applied to (PRV(J)-PBUF(J, IRVSAT)) is computed assuming that
+ !PBUF(J, ILVOCPEXN), PBUF(J, ILSOCPEXN) and PBUF(J, ICPH) don't vary to much with T. It takes into account
+ !the variation (estimated linear) of Qsat with T
+ PBUF(J, IRLTEMP)=(PRV(J)-PBUF(J, IRVSAT))/ &
+ &(1 + PBUF(J, IDRSATODT)*PBUF(J, IEXN)* &
+ & (PBUF(J, ILVOCPEXN)*(1-PFRAC_ICE(J))+PBUF(J, ILSOCPEXN)*PFRAC_ICE(J)))
+ PBUF(J, IRLTEMP)=MIN(MAX(-PRL(J)-PRI(J), PBUF(J, IRLTEMP)),PRV(J))
+ PRV(J)=PRV(J)-PBUF(J, IRLTEMP)
+ PRL(J)=PRL(J)+PRI(J)+PBUF(J, IRLTEMP)
+ PRI(J)=PFRAC_ICE(J) * (PRL(J))
+ PRL(J)=(1-PFRAC_ICE(J)) * (PRT(J) - PRV(J))
+
+ !Computation of Cph (as defined in Meso-NH doc, equation 2.2, to be used with mixing ratios)
+ PBUF(J, ICPH)=CST%XCPD+ CST%XCPV * PRV(J)+ CST%XCL * PRL(J) + CST%XCI * PRI(J) + PBUF(J, ICPH2)
+
+ !Computation of L/Cph/EXN, then new PTH
+ ZVAR2=PBUF(J, ICPH)*PBUF(J, IEXN)
+ PBUF(J, ILVOCPEXN) = (CST%XLVTT + (CST%XCPV-CST%XCL) * (PBUF(J, IT)-CST%XTT)) /ZVAR2
+ PBUF(J, ILSOCPEXN) = (CST%XLSTT + (CST%XCPV-CST%XCI) * (PBUF(J, IT)-CST%XTT)) /ZVAR2
+ PTH(J)=PTHL(J)+PBUF(J, ILVOCPEXN)*PRL(J)+PBUF(J, ILSOCPEXN)*PRI(J)
+
+ !Computation of estimated mixing ration at saturation
+ !To compute the adjustement a first order development was used
+ ZVAR1=PTH(J)*PBUF(J, IEXN)-PBUF(J, IT)
+ PRSATW(J)=PRSATW(J) + PBUF(J, IDRSATODTW)*ZVAR1
+ PRSATI(J)=PRSATI(J) + PBUF(J, IDRSATODTI)*ZVAR1
+ ENDDO
+ENDDO
+
+END SUBROUTINE TH_R_FROM_THL_RT
diff --git a/src/mesonh/aux/mode_fill_dimphyexn.F90 b/src/mesonh/aux/mode_fill_dimphyexn.F90
index 351c96d49720d56cab26f73ac1808854602d9b04..416d34ce3a3d4683cd03d1f595a005d8e6ea16ee 100644
--- a/src/mesonh/aux/mode_fill_dimphyexn.F90
+++ b/src/mesonh/aux/mode_fill_dimphyexn.F90
@@ -6,7 +6,7 @@
MODULE MODE_FILL_DIMPHYEX
IMPLICIT NONE
CONTAINS
-SUBROUTINE FILL_DIMPHYEX(YDDIMPHYEX, KIT, KJT, KKT, LTURB)
+SUBROUTINE FILL_DIMPHYEX(YDDIMPHYEX, KIT, KJT, KKT, LTURB, OHPACK)
! #########################
!
!!
@@ -48,19 +48,38 @@ TYPE(DIMPHYEX_t), INTENT(OUT) :: YDDIMPHYEX ! Structure to fill in
INTEGER, INTENT(IN) :: KIT, KJT, KKT ! Array dimensions
LOGICAL, INTENT(IN), OPTIONAL :: LTURB ! Flag to replace array dimensions I/JB and I/JE to the full array size
! needed if computation in HALO points (e.g. in turbulence)
+LOGICAL, OPTIONAL, INTENT(IN) :: OHPACK ! True to pack both horizontal dimension into a single one
LOGICAL :: YTURB
!
!* 0.2 declaration of local variables
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
+LOGICAL :: LHPACK
!-------------------------------------------------------------------------------
!
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)
+IF(PRESENT(OHPACK)) THEN
+ LHPACK=OHPACK
+ELSE
+ LHPACK=.FALSE.
+ENDIF
+IF(LHPACK) THEN
+ !Both horizontal dimensions are packed into a single one
+ !Computations are done on the entire array
+ YDDIMPHYEX%NIT=KIT*KJT
+ YDDIMPHYEX%NJT=1
+ YDDIMPHYEX%NIB=1
+ YDDIMPHYEX%NJB=1
+ YDDIMPHYEX%NIE=KIT*KJT
+ YDDIMPHYEX%NJE=1
+ELSE
+ !Computations are done only on the physical domain
+ YDDIMPHYEX%NIT=KIT
+ YDDIMPHYEX%NJT=KJT
+ CALL GET_INDICE_ll(YDDIMPHYEX%NIB, YDDIMPHYEX%NJB,&
+ &YDDIMPHYEX%NIE, YDDIMPHYEX%NJE)
+ENDIF
!
YDDIMPHYEX%NKL=1
YDDIMPHYEX%NKT=KKT
diff --git a/src/mesonh/ext/ice_adjust_bis.f90 b/src/mesonh/ext/ice_adjust_bis.f90
index c6f72a0868eee72ac6bd97ad98e4d3bd692529b2..44ab0c680b6d689ab050c53ddd39ec799bf0b100 100644
--- a/src/mesonh/ext/ice_adjust_bis.f90
+++ b/src/mesonh/ext/ice_adjust_bis.f90
@@ -65,10 +65,10 @@ END MODULE MODI_ICE_ADJUST_BIS
!* 0. DECLARATIONS
! ------------
!
-USE MODD_CST, ONLY : XCPD, XRD, XP00
+USE MODD_CST, ONLY : XCPD, XRD, XP00, CST
+USE MODD_NEB, ONLY : NEB
!
USE MODI_COMPUTE_FUNCTION_THERMO
-USE MODE_TH_R_FROM_THL_RT_3D
USE MODI_THLRT_FROM_THRVRCRI
!
USE MODE_ll
@@ -89,6 +89,7 @@ REAL, DIMENSION(SIZE(PTH,1),SIZE(PTH,2),SIZE(PTH,3)) :: ZTHL, ZRW, ZRV, ZRC, &
ZRI, ZWORK
REAL, DIMENSION(SIZE(PTH,1),SIZE(PTH,2),SIZE(PTH,3)) :: ZFRAC_ICE, ZRSATW, ZRSATI
REAL, DIMENSION(SIZE(PTH,1),SIZE(PTH,2),SIZE(PTH,3)) :: ZT, ZEXN, ZLVOCPEXN,ZLSOCPEXN
+REAL, DIMENSION(SIZE(PTH,1),SIZE(PTH,2),SIZE(PTH,3), 16) :: ZBUF
INTEGER :: IRR
CHARACTER(LEN=1) :: YFRAC_ICE
!
@@ -127,10 +128,11 @@ CALL COMPUTE_FUNCTION_THERMO( IRR, &
CALL THLRT_FROM_THRVRCRI( IRR, PTH, PR, ZLVOCPEXN, ZLSOCPEXN,&
ZTHL, ZRW )
!
-CALL TH_R_FROM_THL_RT_3D(YFRAC_ICE,ZFRAC_ICE(:,:,:),PP(:,:,:), &
+CALL TH_R_FROM_THL_RT(CST, NEB, SIZE(ZFRAC_ICE), YFRAC_ICE,ZFRAC_ICE(:,:,:),PP(:,:,:), &
ZTHL(:,:,:), ZRW(:,:,:), PTH(:,:,:), &
ZRV(:,:,:), ZRC(:,:,:), ZRI(:,:,:), &
- ZRSATW(:,:,:), ZRSATI(:,:,:),OOCEAN=.FALSE.)
+ ZRSATW(:,:,:), ZRSATI(:,:,:),OOCEAN=.FALSE.,&
+ PBUF=ZBUF)
CALL ADD3DFIELD_ll( TZFIELDS_ll, PTH, 'ICE_ADJUST_BIS::PTH')
IF (IRR>=1) THEN
CALL ADD3DFIELD_ll( TZFIELDS_ll, ZRV, 'ICE_ADJUST_BIS::ZRV' )
@@ -152,4 +154,7 @@ PR(:,:,:,2) = ZRC(:,:,:)
IF (IRR>=4) &
PR(:,:,:,4) = ZRI(:,:,:)
!
+CONTAINS
+INCLUDE "th_r_from_thl_rt.func.h"
+INCLUDE "compute_frac_ice.func.h"
END SUBROUTINE ICE_ADJUST_BIS
diff --git a/src/mesonh/ext/prep_ideal_case.f90 b/src/mesonh/ext/prep_ideal_case.f90
index a1c1ec6c6a4d7ab52ea4549f93ffc4a35a2deb5b..7a1b8787e20d1a285ca8977ac578783f49181674 100644
--- a/src/mesonh/ext/prep_ideal_case.f90
+++ b/src/mesonh/ext/prep_ideal_case.f90
@@ -416,7 +416,6 @@ USE MODD_SUB_MODEL_n
USE MODE_MNH_TIMING
USE MODN_CONFZ
!JUAN
-USE MODE_TH_R_FROM_THL_RT_3D
!
USE MODI_VERSION
USE MODI_INIT_PGD_SURF_ATM
@@ -431,6 +430,7 @@ USE MODI_SET_RELFRC
!
USE MODI_INI_CST
USE MODI_INI_NEB
+USE MODD_NEB, ONLY: NEB
USE MODI_WRITE_HGRID
USE MODD_MPIF
USE MODD_VAR_ll
@@ -556,6 +556,7 @@ REAL, DIMENSION(:), ALLOCATABLE :: ZXHAT_ll, ZYHAT_ll
REAL, DIMENSION(:,:,:), ALLOCATABLE ::ZTHL,ZT,ZRT,ZFRAC_ICE,&
ZEXN,ZLVOCPEXN,ZLSOCPEXN,ZCPH, &
ZRSATW, ZRSATI
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZBUF
! variables for adjustement
REAL :: ZDIST
!
@@ -1667,6 +1668,7 @@ IF (CIDEAL == 'RSOU') THEN
ALLOCATE(ZFRAC_ICE(NIU,NJU,NKU))
ALLOCATE(ZRSATW(NIU,NJU,NKU))
ALLOCATE(ZRSATI(NIU,NJU,NKU))
+ ALLOCATE(ZBUF(NIU,NJU,NKU,16))
ZRT=XRT(:,:,:,1)+XRT(:,:,:,2)+XRT(:,:,:,4)
IF (LOCEAN) THEN
ZEXN(:,:,:)= 1.
@@ -1682,8 +1684,9 @@ ELSE
ZLVOCPEXN = (XLVTT + (XCPV-XCL) * (ZT-XTT))/(ZCPH*ZEXN)
ZLSOCPEXN = (XLSTT + (XCPV-XCI) * (ZT-XTT))/(ZCPH*ZEXN)
ZTHL=XTHT-ZLVOCPEXN*XRT(:,:,:,2)-ZLSOCPEXN*XRT(:,:,:,4)
- CALL TH_R_FROM_THL_RT_3D('T',ZFRAC_ICE,XPABST,ZTHL,ZRT,XTHT,XRT(:,:,:,1), &
- XRT(:,:,:,2),XRT(:,:,:,4),ZRSATW, ZRSATI,OOCEAN=.FALSE.)
+ CALL TH_R_FROM_THL_RT(CST, NEB, SIZE(ZFRAC_ICE), 'T',ZFRAC_ICE,XPABST,ZTHL,ZRT,XTHT,XRT(:,:,:,1), &
+ XRT(:,:,:,2),XRT(:,:,:,4),ZRSATW, ZRSATI,OOCEAN=.FALSE.,&
+ PBUF=ZBUF)
END IF
DEALLOCATE(ZEXN)
DEALLOCATE(ZT)
@@ -1692,6 +1695,7 @@ END IF
DEALLOCATE(ZLSOCPEXN)
DEALLOCATE(ZTHL)
DEALLOCATE(ZRT)
+ DEALLOCATE(ZBUF)
! Coherence test
IF ((.NOT. LUSERI) ) THEN
IF (MAXVAL(XRT(:,:,:,4))/= 0) THEN
@@ -1930,4 +1934,8 @@ WRITE(NLUOUT,FMT=*) '****************************************************'
!
CALL FINALIZE_MNH()
!
+!
+CONTAINS
+INCLUDE "th_r_from_thl_rt.func.h"
+INCLUDE "compute_frac_ice.func.h"
END PROGRAM PREP_IDEAL_CASE
diff --git a/src/mesonh/ext/set_rsou.f90 b/src/mesonh/ext/set_rsou.f90
index 9f7cca3e1c76de20267a8a398b309e005b804022..352af8a53b1efdaca9aa28ef28c9658ef2d27ef5 100644
--- a/src/mesonh/ext/set_rsou.f90
+++ b/src/mesonh/ext/set_rsou.f90
@@ -261,6 +261,7 @@ END MODULE MODI_SET_RSOU
USE MODD_CONF
USE MODD_CONF_n
USE MODD_CST
+USE MODD_NEB, ONLY: NEB
USE MODD_DYN_n, ONLY: LOCEAN
USE MODD_FIELD_n
USE MODD_GRID
@@ -282,7 +283,6 @@ USE MODI_PRESS_HEIGHT
USE MODI_SET_MASS
USE MODI_SHUMAN
USE MODI_THETAVPU_THETAVPM
-USE MODE_TH_R_FROM_THL_RT_1D
USE MODI_VERT_COORD
!
USE NETCDF ! for reading the NR files
@@ -374,6 +374,7 @@ REAL, DIMENSION(:), ALLOCATABLE :: ZFRAC_ICE ! ice fraction
REAL, DIMENSION(:), ALLOCATABLE :: ZRSATW, ZRSATI
REAL :: ZDZSDH,ZDZ1SDH,ZDZ2SDH ! interpolation
! working arrays
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZBUF
!
INTEGER :: JK,JKLEV,JKU,JKM,JKT,JJ,JI,JO,JLOOP ! Loop indexes
INTEGER :: IKU ! Upper bound in z direction
@@ -1573,6 +1574,7 @@ ALLOCATE(ZFRAC_ICE(IKU))
ALLOCATE(ZRSATW(IKU))
ALLOCATE(ZRSATI(IKU))
ALLOCATE(ZMRT(IKU))
+ALLOCATE(ZBUF(IKU,16))
ZMRT=ZMRM+ZMRCM+ZMRIM
ZTHVM=ZTHLM
!
@@ -1592,8 +1594,9 @@ ELSE
DO JLOOP=1,20 ! loop for pression
CALL COMPUTE_EXNER_FROM_GROUND(ZTHVM,ZZMASS_PROFILE(:),ZEXNSURF,ZEXNFLUX,ZEXNMASS)
ZPRESS(:)=XP00*(ZEXNMASS(:))**(XCPD/XRD)
- CALL TH_R_FROM_THL_RT_1D('T',ZFRAC_ICE,ZPRESS,ZTHLM,ZMRT,ZTHM,ZMRM,ZMRCM,ZMRIM, &
- ZRSATW, ZRSATI,OOCEAN=.FALSE.)
+ CALL TH_R_FROM_THL_RT(CST,NEB,SIZE(ZPRESS,1),'T',ZFRAC_ICE,ZPRESS,ZTHLM,ZMRT,ZTHM,ZMRM,ZMRCM,ZMRIM, &
+ ZRSATW, ZRSATI,OOCEAN=.FALSE.,&
+ PBUF=ZBUF)
ZTHVM(:)=ZTHM(:)*(1.+XRV/XRD*ZMRM(:))/(1.+(ZMRM(:)+ZMRIM(:)+ZMRCM(:)))
ENDDO
ENDIF
@@ -1605,6 +1608,7 @@ DEALLOCATE(ZFRAC_ICE)
DEALLOCATE(ZRSATW)
DEALLOCATE(ZRSATI)
DEALLOCATE(ZMRT)
+DEALLOCATE(ZBUF)
!-------------------------------------------------------------------------------
!
!* 4. COMPUTE FIELDS ON THE MODEL GRID (WITH OROGRAPHY)
@@ -1629,5 +1633,8 @@ CONTAINS
CALL PRINT_MSG( NVERB_ERROR, 'IO', 'SET_RSOU', 'error at ' // Trim( yloc) // ': ' // NF90_STRERROR( ISTATUS ) )
END IF
END SUBROUTINE check
-!
+ !
+ INCLUDE "th_r_from_thl_rt.func.h"
+ INCLUDE "compute_frac_ice.func.h"
+ !
END SUBROUTINE SET_RSOU
diff --git a/src/mesonh/ext/shallow_mf_pack.f90 b/src/mesonh/ext/shallow_mf_pack.f90
index 5001e4bad2c8926109efca0bcc1c4cf4469ba006..73a1810be3d509d037a26c52efe5a0157d25a465 100644
--- a/src/mesonh/ext/shallow_mf_pack.f90
+++ b/src/mesonh/ext/shallow_mf_pack.f90
@@ -123,11 +123,19 @@ END MODULE MODI_SHALLOW_MF_PACK
!* 0. DECLARATIONS
! ------------
!
+USE MODD_CST, ONLY: CST
+USE MODD_NEB, ONLY: NEB
+USE MODD_TURB_n, ONLY: TURBN
+USE MODD_CTURB, ONLY: CSTURB
+USE MODD_PARAM_MFSHALL_n, ONLY: PARAM_MFSHALLN
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+!
+USE MODE_FILL_DIMPHYEX, ONLY: FILL_DIMPHYEX
+!
use modd_budget, only: lbudget_u, lbudget_v, lbudget_th, lbudget_rv, lbudget_sv, &
NBUDGET_U, NBUDGET_V, NBUDGET_TH, NBUDGET_RV, NBUDGET_SV1, &
tbudgets
USE MODD_CONF
-USE MODD_CST
USE MODD_IO, ONLY: TFILEDATA
use modd_field, only: tfielddata, TYPEREAL
USE MODD_NSV
@@ -260,9 +268,11 @@ INTEGER :: IIU, IJU, IKU, IKB, IKE, IRR, ISV
INTEGER :: JK,JRR,JSV ! Loop counters
TYPE(TFIELDDATA) :: TZFIELD
+TYPE(DIMPHYEX_t) :: YLDIMPHYEXPACK
!------------------------------------------------------------------------
!!! 1. Initialisation
+CALL FILL_DIMPHYEX(YLDIMPHYEXPACK, SIZE(PZZ,1), SIZE(PZZ,2), SIZE(PZZ,3), OHPACK=.TRUE.)
! Internal Domain
IIU=SIZE(PTHM,1)
@@ -323,7 +333,8 @@ ZSFRV(:)=RESHAPE(PSFRV(:,:),(/ IIU*IJU /) )
!!! 3. Call of the physical parameterization of massflux vertical transport
-CALL SHALLOW_MF(1,IKU,1,KRR,KRRL,KRRI, &
+CALL SHALLOW_MF(YLDIMPHYEXPACK, CST, NEB, PARAM_MFSHALLN, TURBN, CSTURB,&
+ KRR,KRRL,KRRI,ISV, &
HMF_UPDRAFT, HMF_CLOUD, CFRAC_ICE_SHALLOW_MF, OMIXUV, &
LNOMIXLG,NSV_LGBEG,NSV_LGEND, &
PIMPL_MF, PTSTEP, &