From 058136252f1bf58116a43fefaea8a73117434366 Mon Sep 17 00:00:00 2001
From: Quentin Rodier <quentin.rodier@meteo.fr>
Date: Tue, 22 Feb 2022 12:02:54 +0100
Subject: [PATCH] Quentin 22/02/2022: Merge from main commit 1a99e96 +
corrections : - phys_paramn : adapt call to turb (new args LENGTHs and MOIST)
- modd_cturb : add LHARAT key (to move in namelist reading) - mode_prandtl :
merge prandtl and mode_prandtl. Correct the use of SMOOTH functions -
turb.f90 : add new args (incremental merge) - shuman and gradients : add
adaptation of optional args as for AROME - remove old turb_ver routines -
mode_turb_ver, mode_turb_ver_dyn_flux, _sv_flux, sv_corr : correction of
shuman/gradient to the final solution - mode_turb_ver_thermo_corr : add
REPRO48 to final computation of PSIGS (without : not bit_repro) -
mode_turb_ver_thermo_flux : add REPRO55 to new upper condition of ZF flux
with LOCEAN contribution + to computation of vertical divergence of the
fluxes (desactivated in AROME) + final version of mode_prandtl (no REDR1 and
REDT1 args in some functions) - resolved_cloud : add BUDGETS, OCND2 and 2D
SIGQSAT
---
src/mesonh/aux/gradient_m.f90 | 22 +-
src/mesonh/aux/gradient_u.f90 | 25 +-
src/mesonh/aux/gradient_v.f90 | 24 +-
src/mesonh/aux/gradient_w.f90 | 24 +-
src/mesonh/aux/shuman.f90 | 27 +-
src/mesonh/ext/phys_paramn.f90 | 9 +-
src/mesonh/ext/resolved_cloud.f90 | 26 +-
src/mesonh/turb/modd_cturb.f90 | 1 +
src/mesonh/turb/mode_prandtl.f90 | 1095 ++++++++++++++--
src/mesonh/turb/mode_turb_ver_dyn_flux.f90 | 4 +-
src/mesonh/turb/mode_turb_ver_sv_corr.f90 | 10 +-
src/mesonh/turb/mode_turb_ver_sv_flux.f90 | 2 +-
src/mesonh/turb/mode_turb_ver_thermo_corr.f90 | 6 +-
src/mesonh/turb/mode_turb_ver_thermo_flux.f90 | 74 +-
src/mesonh/turb/prandtl.f90 | 611 ---------
src/mesonh/turb/turb.f90 | 67 +-
src/mesonh/turb/turb_ver_dyn_flux.f90 | 932 --------------
src/mesonh/turb/turb_ver_sv_corr.f90 | 229 ----
src/mesonh/turb/turb_ver_sv_flux.f90 | 500 --------
src/mesonh/turb/turb_ver_thermo_corr.f90 | 756 -----------
src/mesonh/turb/turb_ver_thermo_flux.f90 | 1117 -----------------
21 files changed, 1193 insertions(+), 4368 deletions(-)
delete mode 100644 src/mesonh/turb/prandtl.f90
delete mode 100644 src/mesonh/turb/turb_ver_dyn_flux.f90
delete mode 100644 src/mesonh/turb/turb_ver_sv_corr.f90
delete mode 100644 src/mesonh/turb/turb_ver_sv_flux.f90
delete mode 100644 src/mesonh/turb/turb_ver_thermo_corr.f90
delete mode 100644 src/mesonh/turb/turb_ver_thermo_flux.f90
diff --git a/src/mesonh/aux/gradient_m.f90 b/src/mesonh/aux/gradient_m.f90
index b5ec025aa..60e7ffa57 100644
--- a/src/mesonh/aux/gradient_m.f90
+++ b/src/mesonh/aux/gradient_m.f90
@@ -10,35 +10,41 @@
INTERFACE
!
!
-FUNCTION GX_M_M(PA,PDXX,PDZZ,PDZX) RESULT(PGX_M_M)
+FUNCTION GX_M_M(PA,PDXX,PDZZ,PDZX,KKA,KKU,KL) RESULT(PGX_M_M)
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the mass point
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX ! metric coefficient dxx
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZX ! metric coefficient dzx
+INTEGER, INTENT(IN),OPTIONAL :: KKA, KKU ! near ground and uppest atmosphere array indexes (AROME)
+INTEGER, INTENT(IN),OPTIONAL :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise (AROME)
!
REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PGX_M_M ! result mass point
!
END FUNCTION GX_M_M
!
!
-FUNCTION GY_M_M(PA,PDYY,PDZZ,PDZY) RESULT(PGY_M_M)
+FUNCTION GY_M_M(PA,PDYY,PDZZ,PDZY,KKA,KKU,KL) RESULT(PGY_M_M)
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the mass point
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDYY ! metric coefficient dyy
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZY ! metric coefficient dzy
!
+INTEGER, INTENT(IN),OPTIONAL :: KKA, KKU ! near ground and uppest atmosphere array indexes (AROME)
+INTEGER, INTENT(IN),OPTIONAL :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise (AROME)
REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PGY_M_M ! result mass point
!
END FUNCTION GY_M_M
!
!
-FUNCTION GZ_M_M(PA,PDZZ) RESULT(PGZ_M_M)
+FUNCTION GZ_M_M(PA,PDZZ,KKA,KKU,KL) RESULT(PGZ_M_M)
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the mass point
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
!
+INTEGER, INTENT(IN),OPTIONAL :: KKA, KKU ! near ground and uppest atmosphere array indexes (AROME)
+INTEGER, INTENT(IN),OPTIONAL :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise (AROME)
REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PGZ_M_M ! result mass point
!
END FUNCTION GZ_M_M
@@ -76,7 +82,7 @@ REAL, DIMENSION(SIZE(PY,1),SIZE(PY,2),SIZE(PY,3)) :: PGY_M_V ! result at flux
! side
END FUNCTION GY_M_V
!
- FUNCTION GZ_M_W(KKA,KKU,KL,PY,PDZZ) RESULT(PGZ_M_W)
+ FUNCTION GZ_M_W(KKA, KKU, KL,PY,PDZZ) RESULT(PGZ_M_W)
!
IMPLICIT NONE
!
@@ -99,7 +105,7 @@ END MODULE MODI_GRADIENT_M
!
!
! #######################################################
- FUNCTION GX_M_M(PA,PDXX,PDZZ,PDZX) RESULT(PGX_M_M)
+ FUNCTION GX_M_M(PA,PDXX,PDZZ,PDZX,KKA,KKU,KL) RESULT(PGX_M_M)
! #######################################################
!
!!**** *GX_M_M* - Cartesian Gradient operator:
@@ -170,6 +176,8 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX ! metric coefficient dxx
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZX ! metric coefficient dzx
!
+INTEGER, INTENT(IN),OPTIONAL :: KKA, KKU ! near ground and uppest atmosphere array indexes (AROME)
+INTEGER, INTENT(IN),OPTIONAL :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise (AROME)
REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PGX_M_M ! result mass point
!
!
@@ -196,7 +204,7 @@ END FUNCTION GX_M_M
!
!
! #######################################################
- FUNCTION GY_M_M(PA,PDYY,PDZZ,PDZY) RESULT(PGY_M_M)
+ FUNCTION GY_M_M(PA,PDYY,PDZZ,PDZY,KKA,KKU,KL) RESULT(PGY_M_M)
! #######################################################
!
!!**** *GY_M_M* - Cartesian Gradient operator:
@@ -265,6 +273,8 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PDYY ! metric coefficient dyy
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZY ! metric coefficient dzy
!
+INTEGER, INTENT(IN),OPTIONAL :: KKA, KKU ! near ground and uppest atmosphere array indexes (AROME)
+INTEGER, INTENT(IN),OPTIONAL :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise (AROME)
REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PGY_M_M ! result mass point
!
!
diff --git a/src/mesonh/aux/gradient_u.f90 b/src/mesonh/aux/gradient_u.f90
index 3d32ffa80..1b82a616a 100644
--- a/src/mesonh/aux/gradient_u.f90
+++ b/src/mesonh/aux/gradient_u.f90
@@ -10,8 +10,9 @@
INTERFACE
!
!
-FUNCTION GX_U_M(PA,PDXX,PDZZ,PDZX) RESULT(PGX_U_M)
-!
+FUNCTION GX_U_M(PA,PDXX,PDZZ,PDZX, KKA, KKU, KL) RESULT(PGX_U_M)
+INTEGER, INTENT(IN),OPTIONAL :: KKA, KKU ! near ground and uppest atmosphere array indexes
+INTEGER, INTENT(IN),OPTIONAL :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the U point
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX ! metric coefficient dxx
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
@@ -22,8 +23,10 @@ REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PGX_U_M ! result mass point
END FUNCTION GX_U_M
!
!
-FUNCTION GY_U_UV(PA,PDYY,PDZZ,PDZY) RESULT(PGY_U_UV)
+FUNCTION GY_U_UV(PA,PDYY,PDZZ,PDZY, KKA, KKU, KL) RESULT(PGY_U_UV)
!
+INTEGER, INTENT(IN),OPTIONAL :: KKA, KKU ! near ground and uppest atmosphere array indexes
+INTEGER, INTENT(IN),OPTIONAL :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the U point
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDYY ! metric coefficient dyy
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
@@ -34,8 +37,10 @@ REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PGY_U_UV ! result UV point
END FUNCTION GY_U_UV
!
!
-FUNCTION GZ_U_UW(PA,PDZZ) RESULT(PGZ_U_UW)
+FUNCTION GZ_U_UW(PA,PDZZ, KKA, KKU, KL) RESULT(PGZ_U_UW)
!
+INTEGER, INTENT(IN),OPTIONAL :: KKA, KKU ! near ground and uppest atmosphere array indexes
+INTEGER, INTENT(IN),OPTIONAL :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the U point
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
!
@@ -51,7 +56,7 @@ END MODULE MODI_GRADIENT_U
!
!
! #######################################################
- FUNCTION GX_U_M(PA,PDXX,PDZZ,PDZX) RESULT(PGX_U_M)
+ FUNCTION GX_U_M(PA,PDXX,PDZZ,PDZX, KKA, KKU, KL) RESULT(PGX_U_M)
! #######################################################
!
!!**** *GX_U_M* - Cartesian Gradient operator:
@@ -116,6 +121,8 @@ IMPLICIT NONE
!
!* 0.1 declarations of arguments and result
!
+INTEGER, INTENT(IN),OPTIONAL :: KKA, KKU ! near ground and uppest atmosphere array indexes
+INTEGER, INTENT(IN),OPTIONAL :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the U point
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX ! metric coefficient dxx
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
@@ -147,7 +154,7 @@ END FUNCTION GX_U_M
!
!
! #########################################################
- FUNCTION GY_U_UV(PA,PDYY,PDZZ,PDZY) RESULT(PGY_U_UV)
+ FUNCTION GY_U_UV(PA,PDYY,PDZZ,PDZY, KKA, KKU, KL) RESULT(PGY_U_UV)
! #########################################################
!
!!**** *GY_U_UV* - Cartesian Gradient operator:
@@ -213,6 +220,8 @@ IMPLICIT NONE
!
!* 0.1 declarations of arguments and result
!
+INTEGER, INTENT(IN),OPTIONAL :: KKA, KKU ! near ground and uppest atmosphere array indexes
+INTEGER, INTENT(IN),OPTIONAL :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the U point
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDYY ! metric coefficient dyy
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
@@ -243,7 +252,7 @@ END FUNCTION GY_U_UV
!
!
! #######################################################
- FUNCTION GZ_U_UW(PA,PDZZ) RESULT(PGZ_U_UW)
+ FUNCTION GZ_U_UW(PA,PDZZ, KKA, KKU, KL) RESULT(PGZ_U_UW)
! #######################################################
!
!!**** *GZ_U_UW - Cartesian Gradient operator:
@@ -301,6 +310,8 @@ IMPLICIT NONE
!
!* 0.1 declarations of arguments and result
!
+INTEGER, INTENT(IN),OPTIONAL :: KKA, KKU ! near ground and uppest atmosphere array indexes
+INTEGER, INTENT(IN),OPTIONAL :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the U point
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
!
diff --git a/src/mesonh/aux/gradient_v.f90 b/src/mesonh/aux/gradient_v.f90
index 12c1be749..2e9762584 100644
--- a/src/mesonh/aux/gradient_v.f90
+++ b/src/mesonh/aux/gradient_v.f90
@@ -10,8 +10,10 @@
INTERFACE
!
!
-FUNCTION GY_V_M(PA,PDYY,PDZZ,PDZY) RESULT(PGY_V_M)
+FUNCTION GY_V_M(PA,PDYY,PDZZ,PDZY, KKA, KKU, KL) RESULT(PGY_V_M)
!
+INTEGER, INTENT(IN),OPTIONAL :: KKA, KKU ! near ground and uppest atmosphere array indexes
+INTEGER, INTENT(IN),OPTIONAL :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the V point
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDYY ! metric coefficient dyy
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
@@ -21,8 +23,10 @@ REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PGY_V_M ! result mass point
!
END FUNCTION GY_V_M
!
-FUNCTION GX_V_UV(PA,PDXX,PDZZ,PDZX) RESULT(PGX_V_UV)
+FUNCTION GX_V_UV(PA,PDXX,PDZZ,PDZX, KKA, KKU, KL) RESULT(PGX_V_UV)
!
+INTEGER, INTENT(IN),OPTIONAL :: KKA, KKU ! near ground and uppest atmosphere array indexes
+INTEGER, INTENT(IN),OPTIONAL :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the V point
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX ! metric coefficient dxx
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
@@ -33,8 +37,10 @@ REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PGX_V_UV ! result UV point
END FUNCTION GX_V_UV
!
!
-FUNCTION GZ_V_VW(PA,PDZZ) RESULT(PGZ_V_VW)
+FUNCTION GZ_V_VW(PA,PDZZ, KKA, KKU, KL) RESULT(PGZ_V_VW)
!
+INTEGER, INTENT(IN),OPTIONAL :: KKA, KKU ! near ground and uppest atmosphere array indexes
+INTEGER, INTENT(IN),OPTIONAL :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the V point
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
!
@@ -50,7 +56,7 @@ END MODULE MODI_GRADIENT_V
!
!
! #######################################################
- FUNCTION GY_V_M(PA,PDYY,PDZZ,PDZY) RESULT(PGY_V_M)
+ FUNCTION GY_V_M(PA,PDYY,PDZZ,PDZY, KKA, KKU, KL) RESULT(PGY_V_M)
! #######################################################
!
!!**** *GY_V_M* - Cartesian Gradient operator:
@@ -114,6 +120,8 @@ IMPLICIT NONE
!
!* 0.1 declarations of arguments and result
!
+INTEGER, INTENT(IN),OPTIONAL :: KKA, KKU ! near ground and uppest atmosphere array indexes
+INTEGER, INTENT(IN),OPTIONAL :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the V point
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDYY ! metric coefficient dyy
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
@@ -145,7 +153,7 @@ END FUNCTION GY_V_M
!
!
! #########################################################
- FUNCTION GX_V_UV(PA,PDXX,PDZZ,PDZX) RESULT(PGX_V_UV)
+ FUNCTION GX_V_UV(PA,PDXX,PDZZ,PDZX, KKA, KKU, KL) RESULT(PGX_V_UV)
! #########################################################
!
!!**** *GX_V_UV* - Cartesian Gradient operator:
@@ -210,6 +218,8 @@ IMPLICIT NONE
!
!* 0.1 declarations of arguments and result
!
+INTEGER, INTENT(IN),OPTIONAL :: KKA, KKU ! near ground and uppest atmosphere array indexes
+INTEGER, INTENT(IN),OPTIONAL :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the V point
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX ! metric coefficient dxx
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
@@ -240,7 +250,7 @@ END FUNCTION GX_V_UV
!
!
! #######################################################
- FUNCTION GZ_V_VW(PA,PDZZ) RESULT(PGZ_V_VW)
+ FUNCTION GZ_V_VW(PA,PDZZ, KKA, KKU, KL) RESULT(PGZ_V_VW)
! #######################################################
!
!!**** *GZ_V_VW - Cartesian Gradient operator:
@@ -299,6 +309,8 @@ IMPLICIT NONE
!
!* 0.1 declarations of arguments and result
!
+INTEGER, INTENT(IN),OPTIONAL :: KKA, KKU ! near ground and uppest atmosphere array indexes
+INTEGER, INTENT(IN),OPTIONAL :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the V point
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
!
diff --git a/src/mesonh/aux/gradient_w.f90 b/src/mesonh/aux/gradient_w.f90
index 1ef8f6916..097016ea9 100644
--- a/src/mesonh/aux/gradient_w.f90
+++ b/src/mesonh/aux/gradient_w.f90
@@ -10,8 +10,10 @@
INTERFACE
!
!
-FUNCTION GZ_W_M(PA,PDZZ) RESULT(PGZ_W_M)
+FUNCTION GZ_W_M(PA,PDZZ, KKA, KKU, KL) RESULT(PGZ_W_M)
!
+INTEGER, INTENT(IN),OPTIONAL :: KKA, KKU ! near ground and uppest atmosphere array indexes
+INTEGER, INTENT(IN),OPTIONAL :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the W point
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
!
@@ -19,8 +21,10 @@ REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PGZ_W_M ! result mass point
!
END FUNCTION GZ_W_M
!
-FUNCTION GX_W_UW(PA,PDXX,PDZZ,PDZX) RESULT(PGX_W_UW)
+FUNCTION GX_W_UW(PA,PDXX,PDZZ,PDZX, KKA, KKU, KL) RESULT(PGX_W_UW)
!
+INTEGER, INTENT(IN),OPTIONAL :: KKA, KKU ! near ground and uppest atmosphere array indexes
+INTEGER, INTENT(IN),OPTIONAL :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the W point
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX ! metric coefficient dxx
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
@@ -31,8 +35,10 @@ REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PGX_W_UW ! result UW point
END FUNCTION GX_W_UW
!
!
-FUNCTION GY_W_VW(PA,PDYY,PDZZ,PDZY) RESULT(PGY_W_VW)
+FUNCTION GY_W_VW(PA,PDYY,PDZZ,PDZY, KKA, KKU, KL) RESULT(PGY_W_VW)
!
+INTEGER, INTENT(IN),OPTIONAL :: KKA, KKU ! near ground and uppest atmosphere array indexes
+INTEGER, INTENT(IN),OPTIONAL :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the W point
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDYY ! metric coefficient dyy
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
@@ -50,7 +56,7 @@ END MODULE MODI_GRADIENT_W
!
!
! #######################################################
- FUNCTION GZ_W_M(PA,PDZZ) RESULT(PGZ_W_M)
+ FUNCTION GZ_W_M(PA,PDZZ, KKA, KKU, KL) RESULT(PGZ_W_M)
! #######################################################
!
!!**** *GZ_W_M* - Cartesian Gradient operator:
@@ -103,6 +109,8 @@ IMPLICIT NONE
!
!* 0.1 declarations of arguments and result
!
+INTEGER, INTENT(IN),OPTIONAL :: KKA, KKU ! near ground and uppest atmosphere array indexes
+INTEGER, INTENT(IN),OPTIONAL :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the W point
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
!
@@ -126,7 +134,7 @@ END FUNCTION GZ_W_M
!
!
! #########################################################
- FUNCTION GX_W_UW(PA,PDXX,PDZZ,PDZX) RESULT(PGX_W_UW)
+ FUNCTION GX_W_UW(PA,PDXX,PDZZ,PDZX, KKA, KKU, KL) RESULT(PGX_W_UW)
! #########################################################
!
!!**** *GX_W_UW* - Cartesian Gradient operator:
@@ -181,6 +189,8 @@ IMPLICIT NONE
!
!* 0.1 declarations of arguments and result
!
+INTEGER, INTENT(IN),OPTIONAL :: KKA, KKU ! near ground and uppest atmosphere array indexes
+INTEGER, INTENT(IN),OPTIONAL :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the W point
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX ! metric coefficient dxx
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
@@ -212,7 +222,7 @@ END FUNCTION GX_W_UW
!
!
! #########################################################
- FUNCTION GY_W_VW(PA,PDYY,PDZZ,PDZY) RESULT(PGY_W_VW)
+ FUNCTION GY_W_VW(PA,PDYY,PDZZ,PDZY, KKA, KKU, KL) RESULT(PGY_W_VW)
! #########################################################
!
!!**** *GY_W_VW* - Cartesian Gradient operator:
@@ -267,6 +277,8 @@ IMPLICIT NONE
!
!* 0.1 declarations of arguments and result
!
+INTEGER, INTENT(IN),OPTIONAL :: KKA, KKU ! near ground and uppest atmosphere array indexes
+INTEGER, INTENT(IN),OPTIONAL :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the W point
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDYY ! metric coefficient dxx
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
diff --git a/src/mesonh/aux/shuman.f90 b/src/mesonh/aux/shuman.f90
index 0a0b3711c..f0a1e3f12 100644
--- a/src/mesonh/aux/shuman.f90
+++ b/src/mesonh/aux/shuman.f90
@@ -41,18 +41,22 @@ REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PDYM ! result at flux
! side
END FUNCTION DYM
!
-FUNCTION DZF(PA) RESULT(PDZF)
+FUNCTION DZF(PA, KKA, KKU, KL) RESULT(PDZF)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at flux
! side
REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PDZF ! result at mass
- ! localization
+ ! localization
+INTEGER, INTENT(IN),OPTIONAL :: KKA, KKU ! near ground and uppest atmosphere array indexes (AROME)
+INTEGER, INTENT(IN),OPTIONAL :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise (AROME)
END FUNCTION DZF
!
-FUNCTION DZM(PA) RESULT(PDZM)
+FUNCTION DZM(PA, KKA, KKU, KL) RESULT(PDZM)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at mass
! localization
REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PDZM ! result at flux
! side
+INTEGER, INTENT(IN),OPTIONAL :: KKA, KKU ! near ground and uppest atmosphere array indexes (AROME)
+INTEGER, INTENT(IN),OPTIONAL :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise (AROME)
END FUNCTION DZM
!
FUNCTION MXF(PA) RESULT(PMXF)
@@ -84,16 +88,15 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at flux
! side
REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PMZF ! result at mass
! localization
-INTEGER, INTENT(IN),OPTIONAL :: KKA, KKU ! near ground and uppest atmosphere array indexes (for AROME only)
-INTEGER, INTENT(IN),OPTIONAL :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise (for AROME only)
-
+INTEGER, INTENT(IN),OPTIONAL :: KKA, KKU ! near ground and uppest atmosphere array indexes (AROME)
+INTEGER, INTENT(IN),OPTIONAL :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise (AROME)
END FUNCTION MZF
!
FUNCTION MZM(PA,KKA,KKU,KL) RESULT(PMZM)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at mass localization
REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PMZM ! result at flux localization
-INTEGER, INTENT(IN),OPTIONAL :: KKA, KKU ! near ground and uppest atmosphere array indexes (for AROME only)
-INTEGER, INTENT(IN),OPTIONAL :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise (for AROME only)
+INTEGER, INTENT(IN),OPTIONAL :: KKA, KKU ! near ground and uppest atmosphere array indexes (AROME)
+INTEGER, INTENT(IN),OPTIONAL :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise (AROME)
END FUNCTION MZM
!
END INTERFACE
@@ -1095,7 +1098,7 @@ END DO
!
END FUNCTION DYM
! ###############################
- FUNCTION DZF(PA) RESULT(PDZF)
+ FUNCTION DZF(PA, KKA, KKU, KL) RESULT(PDZF)
! ###############################
!
!!**** *DZF* - Shuman operator : finite difference operator in z direction
@@ -1149,6 +1152,8 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at flux
! side
REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PDZF ! result at mass
! localization
+INTEGER, INTENT(IN),OPTIONAL :: KKA, KKU ! near ground and uppest atmosphere array indexes (AROME)
+INTEGER, INTENT(IN),OPTIONAL :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise (AROME)
!
!* 0.2 Declarations of local variables
! -------------------------------
@@ -1189,7 +1194,7 @@ END DO
!
END FUNCTION DZF
! ###############################
- FUNCTION DZM(PA) RESULT(PDZM)
+ FUNCTION DZM(PA, KKA, KKU, KL) RESULT(PDZM)
! ###############################
!
!!**** *DZM* - Shuman operator : finite difference operator in z direction
@@ -1243,6 +1248,8 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at mass
! localization
REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PDZM ! result at flux
! side
+INTEGER, INTENT(IN),OPTIONAL :: KKA, KKU ! near ground and uppest atmosphere array indexes (AROME)
+INTEGER, INTENT(IN),OPTIONAL :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise (AROME)
!
!* 0.2 Declarations of local variables
! -------------------------------
diff --git a/src/mesonh/ext/phys_paramn.f90 b/src/mesonh/ext/phys_paramn.f90
index 327f252f0..c335a4652 100644
--- a/src/mesonh/ext/phys_paramn.f90
+++ b/src/mesonh/ext/phys_paramn.f90
@@ -453,6 +453,8 @@ REAL :: ZSWA,TINTSW ! index for SW interpolation and int time betwenn forcin
REAL, DIMENSION(:), ALLOCATABLE :: ZIZOCE(:) ! Solar flux penetrating in ocean
REAL, DIMENSION(:), ALLOCATABLE :: ZPROSOL1(:),ZPROSOL2(:) ! Funtions for penetrating solar flux
!
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZLENGTHM, ZLENGTHH, ZMFMOIST !LHARAT turb option from AROME
+!
!-----------------------------------------------------------------------------
NULLIFY(TZFIELDS_ll)
@@ -1488,11 +1490,14 @@ END IF
XDIRCOSXW, XDIRCOSYW, XDIRCOSZW, XCOSSLOPE, XSINSLOPE, &
XRHODJ, XTHVREF, &
ZSFTH, ZSFRV, ZSFSV, ZSFU, ZSFV, &
- XPABST, XUT, XVT, XWT, XTKET, XSVT, XSRCT, XBL_DEPTH, XSBL_DEPTH, &
+ XPABST, XUT, XVT, XWT, XTKET, XSVT, XSRCT, &
+ ZLENGTHM, ZLENGTHH, ZMFMOIST, &
+ XBL_DEPTH, XSBL_DEPTH, &
XCEI, XCEI_MIN, XCEI_MAX, XCOEF_AMPL_SAT, &
XTHT, XRT, &
XRUS, XRVS, XRWS, XRTHS, XRRS, XRSVS, XRTKES, XRTKEMS, XSIGS, XWTHVMF, &
- XTHW_FLUX, XRCW_FLUX, XSVW_FLUX,XDYP, XTHP, XTR, XDISS, XLEM )
+ XTHW_FLUX, XRCW_FLUX, XSVW_FLUX,XDYP, XTHP, XTR, XDISS, XLEM, &
+ TBUDGETS, KBUDGETS=SIZE(TBUDGETS) )
!
IF (LRMC01) THEN
CALL ADD2DFIELD_ll( TZFIELDS_ll, XSBL_DEPTH, 'PHYS_PARAM_n::XSBL_DEPTH' )
diff --git a/src/mesonh/ext/resolved_cloud.f90 b/src/mesonh/ext/resolved_cloud.f90
index 61d4a38a8..fe77e35d3 100644
--- a/src/mesonh/ext/resolved_cloud.f90
+++ b/src/mesonh/ext/resolved_cloud.f90
@@ -477,6 +477,8 @@ REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2)):: ZINPRI
REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)):: ZICEFR
REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)):: ZPRCFR
REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)):: ZTM
+REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2)) :: ZSIGQSAT2D
+ZSIGQSAT2D(:,:) = PSIGQSAT
!
!------------------------------------------------------------------------------
!
@@ -741,8 +743,8 @@ SELECT CASE ( HCLOUD )
ZZZ = MZF( PZZ )
IF(LRED .AND. LADJ_BEFORE) THEN
CALL ICE_ADJUST (1, IKU, 1, KRR, CFRAC_ICE_ADJUST, CCONDENS, CLAMBDA3, &
- 'ADJU', OSUBG_COND, OSIGMAS, CSUBG_MF_PDF, &
- PTSTEP, PSIGQSAT, &
+ 'ADJU', OSUBG_COND, OSIGMAS, .FALSE., CSUBG_MF_PDF, &
+ PTSTEP, ZSIGQSAT2D, &
PRHODJ, PEXNREF, PRHODREF, PSIGS, PMFCONV, PPABST, ZZZ, &
ZEXN, PCF_MF, PRC_MF, PRI_MF, &
PRV=PRS(:,:,:,1)*PTSTEP, PRC=PRS(:,:,:,2)*PTSTEP, &
@@ -752,6 +754,7 @@ SELECT CASE ( HCLOUD )
PRI=PRS(:,:,:,4)*PTSTEP, PRIS=PRS(:,:,:,4), &
PRS=PRS(:,:,:,5)*PTSTEP, &
PRG=PRS(:,:,:,6)*PTSTEP, &
+ TBUDGETS=TBUDGETS,KBUDGETS=SIZE(TBUDGETS), &
PHLC_HRC=PHLC_HRC, PHLC_HCF=PHLC_HCF, &
PHLI_HRI=PHLI_HRI, PHLI_HCF=PHLI_HCF )
ENDIF
@@ -781,7 +784,7 @@ SELECT CASE ( HCLOUD )
PRS(:,:,:,4), PRS(:,:,:,5), PRS(:,:,:,6), &
PINPRC,PINPRR, PEVAP3D, &
PINPRS, PINPRG, PINDEP, PRAINFR, PSIGS, &
- TBUDGETS,SIZE(TBUDGETS), &
+ TBUDGETS,SIZE(TBUDGETS), &
PSEA,PTOWN, PFPR=ZFPR )
ELSE
CALL RAIN_ICE_RED (COUNT(LLMICRO), SIZE(PTHT, 1), SIZE(PTHT, 2), &
@@ -798,7 +801,7 @@ SELECT CASE ( HCLOUD )
PRS(:,:,:,4), PRS(:,:,:,5), PRS(:,:,:,6), &
PINPRC,PINPRR, PEVAP3D, &
PINPRS, PINPRG, PINDEP, PRAINFR, PSIGS, &
- TBUDGETS,SIZE(TBUDGETS), &
+ TBUDGETS,SIZE(TBUDGETS), &
PSEA,PTOWN, PFPR=ZFPR )
END IF
!
@@ -807,8 +810,8 @@ SELECT CASE ( HCLOUD )
!
IF (.NOT. LRED .OR. (LRED .AND. LADJ_AFTER) ) THEN
CALL ICE_ADJUST (1, IKU, 1, KRR, CFRAC_ICE_ADJUST, CCONDENS, CLAMBDA3, &
- 'DEPI', OSUBG_COND, OSIGMAS, CSUBG_MF_PDF, &
- PTSTEP, PSIGQSAT, &
+ 'DEPI', OSUBG_COND, OSIGMAS, .FALSE.,CSUBG_MF_PDF, &
+ PTSTEP, ZSIGQSAT2D, &
PRHODJ, PEXNREF, PRHODREF, PSIGS, PMFCONV, PPABST, ZZZ, &
ZEXN, PCF_MF, PRC_MF, PRI_MF, &
PRV=PRS(:,:,:,1)*PTSTEP, PRC=PRS(:,:,:,2)*PTSTEP, &
@@ -818,6 +821,7 @@ SELECT CASE ( HCLOUD )
PRI=PRS(:,:,:,4)*PTSTEP, PRIS=PRS(:,:,:,4), &
PRS=PRS(:,:,:,5)*PTSTEP, &
PRG=PRS(:,:,:,6)*PTSTEP, &
+ TBUDGETS=TBUDGETS,KBUDGETS=SIZE(TBUDGETS), &
PHLC_HRC=PHLC_HRC, PHLC_HCF=PHLC_HCF, &
PHLI_HRI=PHLI_HRI, PHLI_HCF=PHLI_HCF )
END IF
@@ -841,8 +845,8 @@ SELECT CASE ( HCLOUD )
ZZZ = MZF( PZZ )
IF(LRED .AND. LADJ_BEFORE) THEN
CALL ICE_ADJUST (1, IKU, 1, KRR, CFRAC_ICE_ADJUST, CCONDENS, CLAMBDA3, &
- 'ADJU', OSUBG_COND, OSIGMAS, CSUBG_MF_PDF, &
- PTSTEP, PSIGQSAT, &
+ 'ADJU', OSUBG_COND, OSIGMAS, .FALSE., CSUBG_MF_PDF, &
+ PTSTEP, ZSIGQSAT2D, &
PRHODJ, PEXNREF, PRHODREF, PSIGS, PMFCONV, PPABST, ZZZ, &
ZEXN, PCF_MF, PRC_MF, PRI_MF, &
PRV=PRS(:,:,:,1)*PTSTEP, PRC=PRS(:,:,:,2)*PTSTEP, &
@@ -852,6 +856,7 @@ SELECT CASE ( HCLOUD )
PRI=PRS(:,:,:,4)*PTSTEP, PRIS=PRS(:,:,:,4), &
PRS=PRS(:,:,:,5)*PTSTEP, &
PRG=PRS(:,:,:,6)*PTSTEP, &
+ TBUDGETS=TBUDGETS,KBUDGETS=SIZE(TBUDGETS), &
PRH=PRS(:,:,:,7)*PTSTEP, &
PHLC_HRC=PHLC_HRC, PHLC_HCF=PHLC_HCF, &
PHLI_HRI=PHLI_HRI, PHLI_HCF=PHLI_HCF )
@@ -912,8 +917,8 @@ SELECT CASE ( HCLOUD )
!
IF (.NOT. LRED .OR. (LRED .AND. LADJ_AFTER) ) THEN
CALL ICE_ADJUST (1, IKU, 1, KRR, CFRAC_ICE_ADJUST, CCONDENS, CLAMBDA3, &
- 'DEPI', OSUBG_COND, OSIGMAS, CSUBG_MF_PDF, &
- PTSTEP, PSIGQSAT, &
+ 'DEPI', OSUBG_COND, OSIGMAS, .FALSE., CSUBG_MF_PDF, &
+ PTSTEP, ZSIGQSAT2D, &
PRHODJ, PEXNREF, PRHODREF, PSIGS, PMFCONV, PPABST, ZZZ, &
ZEXN, PCF_MF, PRC_MF, PRI_MF, &
PRV=PRS(:,:,:,1)*PTSTEP, PRC=PRS(:,:,:,2)*PTSTEP, &
@@ -923,6 +928,7 @@ SELECT CASE ( HCLOUD )
PRI=PRS(:,:,:,4)*PTSTEP, PRIS=PRS(:,:,:,4), &
PRS=PRS(:,:,:,5)*PTSTEP, &
PRG=PRS(:,:,:,6)*PTSTEP, &
+ TBUDGETS=TBUDGETS,KBUDGETS=SIZE(TBUDGETS), &
PRH=PRS(:,:,:,7)*PTSTEP, &
PHLC_HRC=PHLC_HRC, PHLC_HCF=PHLC_HCF, &
PHLI_HRI=PHLI_HRI, PHLI_HCF=PHLI_HCF )
diff --git a/src/mesonh/turb/modd_cturb.f90 b/src/mesonh/turb/modd_cturb.f90
index db23e955b..67ca557fa 100644
--- a/src/mesonh/turb/modd_cturb.f90
+++ b/src/mesonh/turb/modd_cturb.f90
@@ -87,5 +87,6 @@ REAL,SAVE :: XCTP ! Constant for temperature and vapor pressure-correlat
REAL,SAVE :: XPHI_LIM ! Threshold value for Phi3 and Psi3
REAL,SAVE :: XSBL_O_BL ! SBL height / BL height ratio
REAL,SAVE :: XFTOP_O_FSURF! Fraction of surface (heat or momentum) flux used to define top of BL
+LOGICAL,SAVE :: LHARAT ! SWITCH HARATU
!
END MODULE MODD_CTURB
diff --git a/src/mesonh/turb/mode_prandtl.f90 b/src/mesonh/turb/mode_prandtl.f90
index 04dfe6155..964d66938 100644
--- a/src/mesonh/turb/mode_prandtl.f90
+++ b/src/mesonh/turb/mode_prandtl.f90
@@ -5,6 +5,8 @@
!-----------------------------------------------------------------
! ####################
MODULE MODE_PRANDTL
+ USE PARKIND1, ONLY : JPRB
+ USE YOMHOOK , ONLY : LHOOK, DR_HOOK
! ####################
!
!* modification 08/2010 V. Masson smoothing of the discontinuity in functions
@@ -14,11 +16,543 @@
USE MODD_CTURB, ONLY : XCTV, XCSHF, XCTD, XPHI_LIM, XCPR3, XCPR4, XCPR5
USE MODD_PARAMETERS, ONLY : JPVEXT_TURB
!
-USE MODI_SHUMAN
+USE MODI_SHUMAN, ONLY: MZM, MZF
IMPLICIT NONE
!----------------------------------------------------------------------------
CONTAINS
!----------------------------------------------------------------------------
+ SUBROUTINE PRANDTL(KKA,KKU,KKL,KRR,KRRI,OTURB_DIAG, &
+ HTURBDIM, &
+ TPFILE, &
+ PDXX,PDYY,PDZZ,PDZX,PDZY, &
+ PTHVREF,PLOCPEXNM,PATHETA,PAMOIST, &
+ PLM,PLEPS,PTKEM,PTHLM,PRM,PSVM,PSRCM, &
+ PREDTH1,PREDR1, &
+ PRED2TH3, PRED2R3, PRED2THR3, &
+ PREDS1,PRED2THS3, PRED2RS3, &
+ PBLL_O_E, &
+ PETHETA, PEMOIST )
+! ###########################################################
+!
+!
+!!**** *PRANDTL* - routine to compute the Prandtl turbulent numbers
+!!
+!! PURPOSE
+!! -------
+! The purpose of this routine is to compute the Redelsperger
+! numbers and then get the turbulent Prandtl and Schmidt numbers:
+! * for the heat fluxes - PHI3 = 1/ Prandtl
+! * for the moisture fluxes - PSI3 = 1/ Schmidt
+!
+!!** METHOD
+!! ------
+!! The following steps are performed:
+!!
+!! 1 - default values of 1 are taken for phi3 and psi3 and different masks
+!! are defined depending on the presence of turbulence, stratification and
+!! humidity. The 1D Redelsperger numbers are computed
+!! * ZREDTH1 : (g / THVREF ) (LT**2 / TKE ) ETHETA (D Theta / Dz)
+!! * ZREDR1 : (g / THVREF ) (LT**2 / TKE ) EMOIST (D TW / Dz)
+!! 2 - 3D Redelsperger numbers are computed only for turbulent
+!! grid points where ZREDTH1 or ZREDR1 are > 0.
+!! 3 - PHI3 is computed only for turbulent grid points where ZREDTH1 > 0
+!! (turbulent thermally stratified points)
+!! 4 - PSI3 is computed only for turbulent grid points where ZREDR1 > 0
+!! (turbulent moist points)
+!!
+!!
+!! EXTERNAL
+!! --------
+!! FUNCTIONs ETHETA and EMOIST :
+!! allows to compute the coefficients
+!! for the turbulent correlation between any variable
+!! and the virtual potential temperature, of its correlations
+!! with the conservative potential temperature and the humidity
+!! conservative variable:
+!! ------- ------- -------
+!! A' Thv' = ETHETA A' Thl' + EMOIST A' Rnp'
+!!
+!! GX_M_M, GY_M_M, GZ_M_M : Cartesian gradient operators
+!! MZM : Shuman function (mean operator in the z direction)
+!! Module MODI_ETHETA : interface module for ETHETA
+!! Module MODI_EMOIST : interface module for EMOIST
+!! Module MODI_SHUMAN : interface module for Shuman operators
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_CST : contains physical constants
+!! XG : gravity constant
+!!
+!! Module MODD_CTURB: contains the set of constants for
+!! the turbulence scheme
+!! XCTV,XCPR2 : constants for the turbulent prandtl numbers
+!! XTKEMIN : minimum value allowed for the TKE
+!!
+!! Module MODD_PARAMETERS
+!! JPVEXT_TURB : number of vertical marginal points
+!!
+!! REFERENCE
+!! ---------
+!! Book 2 of documentation (routine PRANDTL)
+!! Book 1 of documentation (Chapter: Turbulence)
+!!
+!! AUTHOR
+!! ------
+!! Joan Cuxart * INM and Meteo-France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 18/10/94
+!! Modifications: Feb 14, 1995 (J.Cuxart and J.Stein)
+!! Doctorization and Optimization
+!! Modifications: March 21, 1995 (J.M. Carriere)
+!! Introduction of cloud water
+!! Modifications: March 21, 1995 (J. Cuxart and J.Stein)
+!! Phi3 and Psi3 at w point + cleaning
+!! Modifications: July 2, 1995 (J.Cuxart and Ph.Bougeault)
+!! change the value of Phi3 and Psi3 if negative
+!! Modifications: Sept 20, 1995 (J. Stein, J. Cuxart, J.L. Redelsperger)
+!! remove the Where + use REDTH1+REDR1 for the tests
+!! Modifications: October 10, 1995 (J. Cuxart and J.Stein)
+!! Psi3 for tPREDS1he scalar variables
+!! Modifications: February 27, 1996 (J.Stein) optimization
+!! Modifications: June 15, 1996 (P.Jabouille) return to the previous
+!! computation of Phi3 and Psi3
+!! Modifications: October 10, 1996 (J. Stein) change the temporal
+!! discretization
+!! Modifications: May 23, 1997 (J. Stein) bug in 3D Redels number at ground
+!! with orography
+!! Modifications: Feb 20, 1998 (J. Stein) bug in all the 3D cases due to
+!! the use of ZW1 instead of ZW2
+!! Feb 20, 2003 (JP Pinty) Add PFRAC_ICE
+!! July 2005 (Tomas, Masson) implicitation of PHI3 and PSI3
+!! October 2009 (G. Tanguy) add ILENCH=LEN(YCOMMENT) after
+!! change of YCOMMENT
+!! 2012-02 Y. Seity, add possibility to run with reversed
+!! vertical levels
+!! Modifications: July 2015 (Wim de Rooy) LHARAT (Racmo turbulence) switch
+!! 2017-09 J.Escobar, use epsilon XMNH_TINY_12 for R*4
+!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+!! JL Redelsperger 03/2021 : adding Ocean case for temperature only
+!! --------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE PARKIND1, ONLY : JPRB
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK
+!
+USE MODD_CST
+USE MODD_CONF
+USE MODD_CTURB
+USE MODD_FIELD, ONLY: TFIELDDATA, TYPEREAL
+USE MODD_IO, ONLY: TFILEDATA
+USE MODD_PARAMETERS
+!
+USE MODI_GRADIENT_M
+USE MODI_EMOIST
+USE MODI_ETHETA
+USE MODI_SHUMAN, ONLY: MZM
+USE MODE_IO_FIELD_WRITE, ONLY: IO_FIELD_WRITE
+!
+IMPLICIT NONE
+!
+!
+!* 0.1 declarations of arguments
+!
+INTEGER, INTENT(IN) :: KKA !near ground array index
+INTEGER, INTENT(IN) :: KKU !uppest atmosphere array index
+INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=ARO
+
+INTEGER, INTENT(IN) :: KRR ! number of moist var.
+INTEGER, INTENT(IN) :: KRRI ! number of ice var.
+!
+LOGICAL, INTENT(IN) :: OTURB_DIAG ! switch to write some
+ ! diagnostic fields in the syncronous FM-file
+CHARACTER(LEN=4), INTENT(IN) :: HTURBDIM ! Kind of turbulence param.
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX,PDYY,PDZZ,PDZX,PDZY
+ ! metric coefficients
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHVREF ! Virtual Potential Temp.
+ ! of the reference state
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLOCPEXNM ! Lv(T)/Cp/Exner at t-1
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PATHETA ! coefficients between
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PAMOIST ! s and Thetal and Rnp
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLM ! Turbulent Mixing length
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLEPS ! Dissipative length
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHLM,PTKEM! Conservative Potential
+ ! Temperature and TKE at t-1
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRM ! Mixing ratios at t-1
+ ! with PRM(:,:,:,1) = cons.
+ ! mixing ratio
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVM ! Scalars at t-1
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRCM
+ ! s'r'c/2Sigma_s2 at t-1 multiplied by Lambda_3
+!
+!
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PREDTH1 ! Redelsperger number R_theta
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PREDR1 ! Redelsperger number R_q
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRED2TH3 ! Redelsperger number R*2_theta
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRED2R3 ! Redelsperger number R*2_q
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRED2THR3! Redelsperger number R*2_thq
+REAL, DIMENSION(:,:,:,:), INTENT(OUT):: PREDS1 ! Redelsperger number R_s
+REAL, DIMENSION(:,:,:,:), INTENT(OUT):: PRED2THS3! Redelsperger number R*2_thsv
+REAL, DIMENSION(:,:,:,:), INTENT(OUT):: PRED2RS3 ! Redelsperger number R*2_qsv
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PBLL_O_E! beta*Lk*Leps/tke
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PETHETA ! coefficient E_theta
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PEMOIST ! coefficient E_moist
+!
+!
+! 0.2 declaration of local variables
+!
+REAL, DIMENSION(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) :: &
+ ZW1, ZW2, ZW3
+! working variables
+!
+INTEGER :: IKB ! vertical index value for the first inner mass point
+INTEGER :: IKE ! vertical index value for the last inner mass point
+INTEGER :: IRESP ! Return code of FM routines
+INTEGER :: ILENG ! Length of the data field in LFIFM file
+INTEGER :: IGRID ! C-grid indicator in LFIFM file
+INTEGER :: ILENCH ! Length of comment string in LFIFM file
+CHARACTER (LEN=100) :: YCOMMENT ! comment string in LFIFM file
+CHARACTER (LEN=16) :: YRECFM ! Name of the desired field in LFIFM file
+INTEGER:: ISV ! number of scalar variables
+INTEGER:: JSV ! loop index for the scalar variables
+
+INTEGER :: JLOOP
+REAL :: ZMINVAL
+TYPE(TFIELDDATA) :: TZFIELD
+! ---------------------------------------------------------------------------
+!
+!* 1. DEFAULT VALUES, 1D REDELSPERGER NUMBERS
+! ----------------------------------------
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('PRANDTL',0,ZHOOK_HANDLE)
+
+IF (LHARAT) THEN
+PREDTH1(:,:,:)=0.
+PREDR1(:,:,:)=0.
+PRED2TH3(:,:,:)=0.
+PRED2R3(:,:,:)=0.
+PRED2THR3(:,:,:)=0.
+PREDS1(:,:,:,:)=0.
+PRED2THS3(:,:,:,:)=0.
+PRED2RS3(:,:,:,:)=0.
+PBLL_O_E(:,:,:)=0.
+ENDIF
+!
+IKB = KKA+JPVEXT_TURB*KKL
+IKE = KKU-JPVEXT_TURB*KKL
+ILENG=SIZE(PTHLM,1)*SIZE(PTHLM,2)*SIZE(PTHLM,3)
+ISV =SIZE(PSVM,4)
+!
+PETHETA(:,:,:) = MZM(ETHETA(KRR,KRRI,PTHLM,PRM,PLOCPEXNM,PATHETA,PSRCM), KKA, KKU, KKL)
+PEMOIST(:,:,:) = MZM(EMOIST(KRR,KRRI,PTHLM,PRM,PLOCPEXNM,PAMOIST,PSRCM), KKA, KKU, KKL)
+PETHETA(:,:,KKA) = 2.*PETHETA(:,:,IKB) - PETHETA(:,:,IKB+KKL)
+PEMOIST(:,:,KKA) = 2.*PEMOIST(:,:,IKB) - PEMOIST(:,:,IKB+KKL)
+!
+!---------------------------------------------------------------------------
+IF (.NOT. LHARAT) THEN
+!
+! 1.3 1D Redelsperger numbers
+!
+PBLL_O_E(:,:,:) = MZM(XG / PTHVREF(:,:,:) * PLM(:,:,:) * PLEPS(:,:,:) / PTKEM(:,:,:), KKA, KKU, KKL)
+IF (KRR /= 0) THEN ! moist case
+ PREDTH1(:,:,:)= XCTV*PBLL_O_E(:,:,:) * PETHETA(:,:,:) * &
+ & GZ_M_W(KKA, KKU, KKL,PTHLM,PDZZ)
+ PREDR1(:,:,:) = XCTV*PBLL_O_E(:,:,:) * PEMOIST(:,:,:) * &
+ & GZ_M_W(KKA, KKU, KKL,PRM(:,:,:,1),PDZZ)
+ELSE ! dry case
+ PREDTH1(:,:,:)= XCTV*PBLL_O_E(:,:,:) * GZ_M_W(KKA, KKU, KKL,PTHLM,PDZZ)
+ PREDR1(:,:,:) = 0.
+END IF
+!
+! 3. Limits on 1D Redelperger numbers
+! --------------------------------
+!
+ZMINVAL = (1.-1./XPHI_LIM)
+!
+ZW1 = 1.
+ZW2 = 1.
+!
+WHERE (PREDTH1+PREDR1<-ZMINVAL)
+ ZW1 = (-ZMINVAL) / (PREDTH1+PREDR1)
+END WHERE
+!
+WHERE (PREDTH1<-ZMINVAL)
+ ZW2 = (-ZMINVAL) / (PREDTH1)
+END WHERE
+ZW2 = MIN(ZW1,ZW2)
+!
+ZW1 = 1.
+WHERE (PREDR1<-ZMINVAL)
+ ZW1 = (-ZMINVAL) / (PREDR1)
+END WHERE
+ZW1 = MIN(ZW2,ZW1)
+!
+!
+! 3. Modification of Mixing length and dissipative length
+! ----------------------------------------------------
+!
+PBLL_O_E(:,:,:) = PBLL_O_E(:,:,:) * ZW1(:,:,:)
+PREDTH1 (:,:,:) = PREDTH1 (:,:,:) * ZW1(:,:,:)
+PREDR1 (:,:,:) = PREDR1 (:,:,:) * ZW1(:,:,:)
+!
+! 4. Threshold for very small (in absolute value) Redelperger numbers
+! ----------------------------------------------------------------
+!
+ZW2=SIGN(1.,PREDTH1(:,:,:))
+PREDTH1(:,:,:)= ZW2(:,:,:) * MAX(1.E-30, ZW2(:,:,:)*PREDTH1(:,:,:))
+!
+IF (KRR /= 0) THEN ! dry case
+ ZW2=SIGN(1.,PREDR1(:,:,:))
+ PREDR1(:,:,:)= ZW2(:,:,:) * MAX(1.E-30, ZW2(:,:,:)*PREDR1(:,:,:))
+END IF
+!
+!
+!---------------------------------------------------------------------------
+!
+! For the scalar variables
+DO JSV=1,ISV
+ PREDS1(:,:,:,JSV)=XCTV*PBLL_O_E(:,:,:)*GZ_M_W(KKA, KKU, KKL,PSVM(:,:,:,JSV),PDZZ)
+END DO
+!
+DO JSV=1,ISV
+ ZW2=SIGN(1.,PREDS1(:,:,:,JSV))
+ PREDS1(:,:,:,JSV)= ZW2(:,:,:) * MAX(1.E-30, ZW2(:,:,:)*PREDS1(:,:,:,JSV))
+END DO
+!
+!---------------------------------------------------------------------------
+!
+!* 2. 3D REDELSPERGER NUMBERS
+! ------------------------
+!
+IF(HTURBDIM=='1DIM') THEN ! 1D case
+!
+!
+ PRED2TH3(:,:,:) = PREDTH1(:,:,:)**2
+!
+ PRED2R3(:,:,:) = PREDR1(:,:,:) **2
+!
+ PRED2THR3(:,:,:) = PREDTH1(:,:,:) * PREDR1(:,:,:)
+!
+ELSE IF (L2D) THEN ! 3D case in a 2D model
+!
+ IF (KRR /= 0) THEN ! moist 3D case
+ PRED2TH3(:,:,:)= PREDTH1(:,:,:)**2+(XCTV*PBLL_O_E(:,:,:)*PETHETA(:,:,:) )**2 * &
+ MZM(GX_M_M(PTHLM,PDXX,PDZZ,PDZX, KKA, KKU, KKL)**2, KKA, KKU, KKL)
+ PRED2TH3(:,:,IKB)=PRED2TH3(:,:,IKB+KKL)
+!
+ PRED2R3(:,:,:)= PREDR1(:,:,:)**2 + (XCTV*PBLL_O_E(:,:,:)*PEMOIST(:,:,:))**2 * &
+ MZM(GX_M_M(PRM(:,:,:,1),PDXX,PDZZ,PDZX, KKA, KKU, KKL)**2, KKA, KKU, KKL)
+ PRED2R3(:,:,IKB)=PRED2R3(:,:,IKB+KKL)
+!
+ PRED2THR3(:,:,:)= PREDR1(:,:,:) * PREDTH1(:,:,:) + XCTV**2*PBLL_O_E(:,:,:)**2 * &
+ PEMOIST(:,:,:) * PETHETA(:,:,:) * &
+ MZM(GX_M_M(PRM(:,:,:,1),PDXX,PDZZ,PDZX, KKA, KKU, KKL)* &
+ GX_M_M(PTHLM,PDXX,PDZZ,PDZX, KKA, KKU, KKL), KKA, KKU, KKL)
+ PRED2THR3(:,:,IKB)=PRED2THR3(:,:,IKB+KKL)
+!
+ ELSE ! dry 3D case in a 2D model
+ PRED2TH3(:,:,:) = PREDTH1(:,:,:)**2 + XCTV**2*PBLL_O_E(:,:,:)**2 * &
+ MZM(GX_M_M(PTHLM,PDXX,PDZZ,PDZX, KKA, KKU, KKL)**2, KKA, KKU, KKL)
+ PRED2TH3(:,:,IKB)=PRED2TH3(:,:,IKB+KKL)
+!
+ PRED2R3(:,:,:) = 0.
+!
+ PRED2THR3(:,:,:) = 0.
+!
+ END IF
+!
+ELSE ! 3D case in a 3D model
+!
+ IF (KRR /= 0) THEN ! moist 3D case
+ PRED2TH3(:,:,:)= PREDTH1(:,:,:)**2 + ( XCTV*PBLL_O_E(:,:,:)*PETHETA(:,:,:) )**2 * &
+ MZM(GX_M_M(PTHLM,PDXX,PDZZ,PDZX, KKA, KKU, KKL)**2 &
+ + GY_M_M(PTHLM,PDYY,PDZZ,PDZY, KKA, KKU, KKL)**2, KKA, KKU, KKL)
+ PRED2TH3(:,:,IKB)=PRED2TH3(:,:,IKB+KKL)
+!
+ PRED2R3(:,:,:)= PREDR1(:,:,:)**2 + (XCTV*PBLL_O_E(:,:,:)*PEMOIST(:,:,:))**2 * &
+ MZM(GX_M_M(PRM(:,:,:,1),PDXX,PDZZ,PDZX, KKA, KKU, KKL)**2 + &
+ GY_M_M(PRM(:,:,:,1),PDYY,PDZZ,PDZY, KKA, KKU, KKL)**2, KKA, KKU, KKL)
+ PRED2R3(:,:,IKB)=PRED2R3(:,:,IKB+KKL)
+!
+ PRED2THR3(:,:,:)= PREDR1(:,:,:) * PREDTH1(:,:,:) + XCTV**2*PBLL_O_E(:,:,:)**2 * &
+ PEMOIST(:,:,:) * PETHETA(:,:,:) * &
+ MZM(GX_M_M(PRM(:,:,:,1),PDXX,PDZZ,PDZX, KKA, KKU, KKL)* &
+ GX_M_M(PTHLM,PDXX,PDZZ,PDZX, KKA, KKU, KKL)+ &
+ GY_M_M(PRM(:,:,:,1),PDYY,PDZZ,PDZY, KKA, KKU, KKL)* &
+ GY_M_M(PTHLM,PDYY,PDZZ,PDZY, KKA, KKU, KKL), KKA, KKU, KKL)
+ PRED2THR3(:,:,IKB)=PRED2THR3(:,:,IKB+KKL)
+!
+ ELSE ! dry 3D case in a 3D model
+ PRED2TH3(:,:,:) = PREDTH1(:,:,:)**2 + XCTV**2*PBLL_O_E(:,:,:)**2 * &
+ MZM(GX_M_M(PTHLM,PDXX,PDZZ,PDZX, KKA, KKU, KKL)**2 &
+ + GY_M_M(PTHLM,PDYY,PDZZ,PDZY, KKA, KKU, KKL)**2, KKA, KKU, KKL)
+ PRED2TH3(:,:,IKB)=PRED2TH3(:,:,IKB+KKL)
+!
+ PRED2R3(:,:,:) = 0.
+!
+ PRED2THR3(:,:,:) = 0.
+!
+ END IF
+!
+END IF ! end of the if structure on the turbulence dimensionnality
+!
+!
+!---------------------------------------------------------------------------
+!
+! 5. Prandtl numbers for scalars
+! ---------------------------
+DO JSV=1,ISV
+!
+ IF(HTURBDIM=='1DIM') THEN
+! 1D case
+ PRED2THS3(:,:,:,JSV) = PREDS1(:,:,:,JSV) * PREDTH1(:,:,:)
+ IF (KRR /= 0) THEN
+ PRED2RS3(:,:,:,JSV) = PREDR1(:,:,:) *PREDS1(:,:,:,JSV)
+ ELSE
+ PRED2RS3(:,:,:,JSV) = 0.
+ END IF
+!
+ ELSE IF (L2D) THEN ! 3D case in a 2D model
+!
+ IF (KRR /= 0) THEN
+ ZW1 = MZM((XG / PTHVREF * PLM * PLEPS / PTKEM)**2, KKA, KKU, KKL) *PETHETA
+ ELSE
+ ZW1 = MZM((XG / PTHVREF * PLM * PLEPS / PTKEM)**2, KKA, KKU, KKL)
+ END IF
+ PRED2THS3(:,:,:,JSV) = PREDTH1(:,:,:) * PREDS1(:,:,:,JSV) + &
+ ZW1* &
+ MZM(GX_M_M(PSVM(:,:,:,JSV),PDXX,PDZZ,PDZX, KKA, KKU, KKL)* &
+ GX_M_M(PTHLM,PDXX,PDZZ,PDZX, KKA, KKU, KKL), &
+ KKA, KKU, KKL)
+!
+ IF (KRR /= 0) THEN
+ PRED2RS3(:,:,:,JSV) = PREDR1(:,:,:) * PREDS1(:,:,:,JSV) + &
+ ZW1 * PEMOIST * &
+ MZM(GX_M_M(PSVM(:,:,:,JSV),PDXX,PDZZ,PDZX, KKA, KKU, KKL)* &
+ GX_M_M(PRM(:,:,:,1),PDXX,PDZZ,PDZX, KKA, KKU, KKL), &
+ KKA, KKU, KKL)
+ ELSE
+ PRED2RS3(:,:,:,JSV) = 0.
+ END IF
+!
+ ELSE ! 3D case in a 3D model
+!
+ IF (KRR /= 0) THEN
+ ZW1 = MZM((XG / PTHVREF * PLM * PLEPS / PTKEM)**2, KKA, KKU, KKL) *PETHETA
+ ELSE
+ ZW1 = MZM((XG / PTHVREF * PLM * PLEPS / PTKEM)**2, KKA, KKU, KKL)
+ END IF
+ PRED2THS3(:,:,:,JSV) = PREDTH1(:,:,:) * PREDS1(:,:,:,JSV) + &
+ ZW1* &
+ MZM(GX_M_M(PSVM(:,:,:,JSV),PDXX,PDZZ,PDZX, KKA, KKU, KKL)* &
+ GX_M_M(PTHLM,PDXX,PDZZ,PDZX, KKA, KKU, KKL) &
+ +GY_M_M(PSVM(:,:,:,JSV),PDYY,PDZZ,PDZY, KKA, KKU, KKL)* &
+ GY_M_M(PTHLM,PDYY,PDZZ,PDZY, KKA, KKU, KKL), &
+ KKA, KKU, KKL)
+!
+ IF (KRR /= 0) THEN
+ PRED2RS3(:,:,:,JSV) = PREDR1(:,:,:) * PREDS1(:,:,:,JSV) + &
+ ZW1 * PEMOIST * &
+ MZM(GX_M_M(PSVM(:,:,:,JSV),PDXX,PDZZ,PDZX, KKA, KKU, KKL)* &
+ GX_M_M(PRM(:,:,:,1),PDXX,PDZZ,PDZX, KKA, KKU, KKL) &
+ +GY_M_M(PSVM(:,:,:,JSV),PDYY,PDZZ,PDZY, KKA, KKU, KKL)* &
+ GY_M_M(PRM(:,:,:,1),PDYY,PDZZ,PDZY, KKA, KKU, KKL), &
+ KKA, KKU, KKL)
+ ELSE
+ PRED2RS3(:,:,:,JSV) = 0.
+ END IF
+!
+ END IF ! end of HTURBDIM if-block
+!
+END DO
+!
+!---------------------------------------------------------------------------
+!
+!* 6. SAVES THE REDELSPERGER NUMBERS
+! ------------------------------
+!
+IF ( OTURB_DIAG .AND. TPFILE%LOPENED ) THEN
+ !
+ ! stores the RED_TH1
+ TZFIELD%CMNHNAME = 'RED_TH1'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = 'RED_TH1'
+ TZFIELD%CUNITS = '1'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%CCOMMENT = 'X_Y_Z_RED_TH1'
+ TZFIELD%NGRID = 4
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ CALL IO_Field_write(TPFILE,TZFIELD,PREDTH1)
+ !
+ ! stores the RED_R1
+ TZFIELD%CMNHNAME = 'RED_R1'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = 'RED_R1'
+ TZFIELD%CUNITS = '1'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%CCOMMENT = 'X_Y_Z_RED_R1'
+ TZFIELD%NGRID = 4
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ CALL IO_Field_write(TPFILE,TZFIELD,PREDR1)
+ !
+ ! stores the RED2_TH3
+ TZFIELD%CMNHNAME = 'RED2_TH3'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = 'RED2_TH3'
+ TZFIELD%CUNITS = '1'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%CCOMMENT = 'X_Y_Z_RED2_TH3'
+ TZFIELD%NGRID = 4
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ CALL IO_Field_write(TPFILE,TZFIELD,PRED2TH3)
+ !
+ ! stores the RED2_R3
+ TZFIELD%CMNHNAME = 'RED2_R3'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = 'RED2_R3'
+ TZFIELD%CUNITS = '1'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%CCOMMENT = 'X_Y_Z_RED2_R3'
+ TZFIELD%NGRID = 4
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ CALL IO_Field_write(TPFILE,TZFIELD,PRED2R3)
+ !
+ ! stores the RED2_THR3
+ TZFIELD%CMNHNAME = 'RED2_THR3'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = 'RED2_THR3'
+ TZFIELD%CUNITS = '1'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%CCOMMENT = 'X_Y_Z_RED2_THR3'
+ TZFIELD%NGRID = 4
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ CALL IO_Field_write(TPFILE,TZFIELD,PRED2THR3)
+ !
+END IF
+!
+!---------------------------------------------------------------------------
+ENDIF ! (Done only if LHARAT is FALSE)
+!
+IF (LHOOK) CALL DR_HOOK('PRANDTL',1,ZHOOK_HANDLE)
+END SUBROUTINE PRANDTL
+!
SUBROUTINE SMOOTH_TURB_FUNCT(PPHI3,PF_LIM,PF)
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PPHI3 ! Phi3
@@ -54,6 +588,8 @@ FUNCTION PHI3(PREDTH1,PREDR1,PRED2TH3,PRED2R3,PRED2THR3,HTURBDIM,OUSERV)
REAL, DIMENSION(SIZE(PREDTH1,1),SIZE(PREDTH1,2),SIZE(PREDTH1,3)) :: ZW1, ZW2
INTEGER :: IKB, IKE
!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:PHI3',0,ZHOOK_HANDLE)
IKB = 1+JPVEXT_TURB
IKE = SIZE(PREDTH1,3)-JPVEXT_TURB
!
@@ -97,6 +633,7 @@ END IF
PHI3(:,:,IKB-1)=PHI3(:,:,IKB)
PHI3(:,:,IKE+1)=PHI3(:,:,IKE)
!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:PHI3',1,ZHOOK_HANDLE)
END FUNCTION PHI3
!----------------------------------------------------------------------------
FUNCTION PSI_SV(PREDTH1,PREDR1,PREDS1,PRED2THS,PRED2RS,PPHI3,PPSI3)
@@ -112,6 +649,8 @@ FUNCTION PSI_SV(PREDTH1,PREDR1,PREDS1,PRED2THS,PRED2RS,PPHI3,PPSI3)
INTEGER :: IKB, IKE
INTEGER :: JSV
!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:PSI_SV',0,ZHOOK_HANDLE)
IKB = 1+JPVEXT_TURB
IKE = SIZE(PREDTH1,3)-JPVEXT_TURB
!
@@ -132,6 +671,7 @@ DO JSV=1,SIZE(PSI_SV,4)
PSI_SV(:,:,IKE+1,JSV)=PSI_SV(:,:,IKE,JSV)
END DO
!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:PSI_SV',1,ZHOOK_HANDLE)
END FUNCTION PSI_SV
!----------------------------------------------------------------------------
FUNCTION D_PHI3DTDZ_O_DDTDZ(PPHI3,PREDTH1,PREDR1,PRED2TH3,PRED2THR3,HTURBDIM,OUSERV)
@@ -145,6 +685,8 @@ FUNCTION D_PHI3DTDZ_O_DDTDZ(PPHI3,PREDTH1,PREDR1,PRED2TH3,PRED2THR3,HTURBDIM,OUS
REAL, DIMENSION(SIZE(PREDTH1,1),SIZE(PREDTH1,2),SIZE(PREDTH1,3)) :: D_PHI3DTDZ_O_DDTDZ
INTEGER :: IKB, IKE,JL,JK,JJ
!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_PHI3DTDZ_O_DDTDZ',0,ZHOOK_HANDLE)
IKB = 1+JPVEXT_TURB
IKE = SIZE(PREDTH1,3)-JPVEXT_TURB
!
@@ -204,6 +746,7 @@ CALL SMOOTH_TURB_FUNCT(PPHI3,PPHI3,D_PHI3DTDZ_O_DDTDZ)
D_PHI3DTDZ_O_DDTDZ(:,:,IKB-1)=D_PHI3DTDZ_O_DDTDZ(:,:,IKB)
D_PHI3DTDZ_O_DDTDZ(:,:,IKE+1)=D_PHI3DTDZ_O_DDTDZ(:,:,IKE)
!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_PHI3DTDZ_O_DDTDZ',1,ZHOOK_HANDLE)
END FUNCTION D_PHI3DTDZ_O_DDTDZ
!----------------------------------------------------------------------------
FUNCTION D_PHI3DRDZ_O_DDRDZ(PPHI3,PREDTH1,PREDR1,PRED2TH3,PRED2THR3,HTURBDIM,OUSERV)
@@ -217,6 +760,8 @@ FUNCTION D_PHI3DRDZ_O_DDRDZ(PPHI3,PREDTH1,PREDR1,PRED2TH3,PRED2THR3,HTURBDIM,OUS
REAL, DIMENSION(SIZE(PREDTH1,1),SIZE(PREDTH1,2),SIZE(PREDTH1,3)) :: D_PHI3DRDZ_O_DDRDZ
INTEGER :: IKB, IKE
!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_PHI3DRDZ_O_DDRDZ',0,ZHOOK_HANDLE)
IKB = 1+JPVEXT_TURB
IKE = SIZE(PREDTH1,3)-JPVEXT_TURB
!
@@ -254,6 +799,7 @@ CALL SMOOTH_TURB_FUNCT(PPHI3,PPHI3,D_PHI3DRDZ_O_DDRDZ)
D_PHI3DRDZ_O_DDRDZ(:,:,IKB-1)=D_PHI3DRDZ_O_DDRDZ(:,:,IKB)
D_PHI3DRDZ_O_DDRDZ(:,:,IKE+1)=D_PHI3DRDZ_O_DDRDZ(:,:,IKE)
!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_PHI3DRDZ_O_DDRDZ',1,ZHOOK_HANDLE)
END FUNCTION D_PHI3DRDZ_O_DDRDZ
!----------------------------------------------------------------------------
FUNCTION D_PHI3DTDZ2_O_DDTDZ(PPHI3,PREDTH1,PREDR1,PRED2TH3,PRED2THR3,PDTDZ,HTURBDIM,OUSERV)
@@ -268,6 +814,8 @@ FUNCTION D_PHI3DTDZ2_O_DDTDZ(PPHI3,PREDTH1,PREDR1,PRED2TH3,PRED2THR3,PDTDZ,HTURB
REAL, DIMENSION(SIZE(PREDTH1,1),SIZE(PREDTH1,2),SIZE(PREDTH1,3)) :: D_PHI3DTDZ2_O_DDTDZ
INTEGER :: IKB, IKE
!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_PHI3DTDZ2_O_DDTDZ',0,ZHOOK_HANDLE)
IKB = 1+JPVEXT_TURB
IKE = SIZE(PREDTH1,3)-JPVEXT_TURB
!
@@ -320,6 +868,7 @@ CALL SMOOTH_TURB_FUNCT(PPHI3,PPHI3*2.*PDTDZ,D_PHI3DTDZ2_O_DDTDZ)
D_PHI3DTDZ2_O_DDTDZ(:,:,IKB-1)=D_PHI3DTDZ2_O_DDTDZ(:,:,IKB)
D_PHI3DTDZ2_O_DDTDZ(:,:,IKE+1)=D_PHI3DTDZ2_O_DDTDZ(:,:,IKE)
!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_PHI3DTDZ2_O_DDTDZ',1,ZHOOK_HANDLE)
END FUNCTION D_PHI3DTDZ2_O_DDTDZ
!----------------------------------------------------------------------------
FUNCTION M3_WTH_WTH2(PREDTH1,PREDR1,PD,PBLL_O_E,PETHETA)
@@ -331,6 +880,8 @@ FUNCTION M3_WTH_WTH2(PREDTH1,PREDR1,PD,PBLL_O_E,PETHETA)
REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: M3_WTH_WTH2
INTEGER :: IKB, IKE
!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_WTH_WTH2',0,ZHOOK_HANDLE)
IKB = 1+JPVEXT_TURB
IKE = SIZE(PD,3)-JPVEXT_TURB
@@ -339,6 +890,7 @@ M3_WTH_WTH2(:,:,:) = XCSHF*PBLL_O_E*PETHETA*0.5/XCTD &
M3_WTH_WTH2(:,:,IKB-1)=M3_WTH_WTH2(:,:,IKB)
M3_WTH_WTH2(:,:,IKE+1)=M3_WTH_WTH2(:,:,IKE)
!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_WTH_WTH2',1,ZHOOK_HANDLE)
END FUNCTION M3_WTH_WTH2
!----------------------------------------------------------------------------
FUNCTION D_M3_WTH_WTH2_O_DDTDZ(PM3_WTH_WTH2,PREDTH1,PREDR1,PD,PBLL_O_E,PETHETA)
@@ -351,6 +903,8 @@ FUNCTION D_M3_WTH_WTH2_O_DDTDZ(PM3_WTH_WTH2,PREDTH1,PREDR1,PD,PBLL_O_E,PETHETA)
REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: D_M3_WTH_WTH2_O_DDTDZ
INTEGER :: IKB, IKE
!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_WTH_WTH2_O_DDTDZ',0,ZHOOK_HANDLE)
IKB = 1+JPVEXT_TURB
IKE = SIZE(PD,3)-JPVEXT_TURB
@@ -361,9 +915,13 @@ D_M3_WTH_WTH2_O_DDTDZ(:,:,:) = ( 0.5*XCSHF*PBLL_O_E*PETHETA*0.5/XCTD/PD &
D_M3_WTH_WTH2_O_DDTDZ(:,:,IKB-1)=D_M3_WTH_WTH2_O_DDTDZ(:,:,IKB)
D_M3_WTH_WTH2_O_DDTDZ(:,:,IKE+1)=D_M3_WTH_WTH2_O_DDTDZ(:,:,IKE)
!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_WTH_WTH2_O_DDTDZ',1,ZHOOK_HANDLE)
END FUNCTION D_M3_WTH_WTH2_O_DDTDZ
!----------------------------------------------------------------------------
-FUNCTION M3_WTH_W2TH(PREDTH1,PREDR1,PD,PKEFF,PTKE)
+FUNCTION M3_WTH_W2TH(KKA,KKU,KKL,PREDTH1,PREDR1,PD,PKEFF,PTKE)
+ INTEGER, INTENT(IN) :: KKA
+ INTEGER, INTENT(IN) :: KKU
+ INTEGER, INTENT(IN) :: KKL
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
@@ -372,18 +930,24 @@ FUNCTION M3_WTH_W2TH(PREDTH1,PREDR1,PD,PKEFF,PTKE)
REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: M3_WTH_W2TH
INTEGER :: IKB, IKE
!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_WTH_W2TH',0,ZHOOK_HANDLE)
IKB = 1+JPVEXT_TURB
IKE = SIZE(PD,3)-JPVEXT_TURB
-M3_WTH_W2TH(:,:,:) = XCSHF*PKEFF*1.5/MZM(PTKE) &
+M3_WTH_W2TH(:,:,:) = XCSHF*PKEFF*1.5/MZM(PTKE, KKA, KKU, KKL) &
* (1. - 0.5*PREDR1*(1.+PREDR1)/PD ) / (1.+PREDTH1)
!
M3_WTH_W2TH(:,:,IKB-1)=M3_WTH_W2TH(:,:,IKB)
M3_WTH_W2TH(:,:,IKE+1)=M3_WTH_W2TH(:,:,IKE)
!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_WTH_W2TH',1,ZHOOK_HANDLE)
END FUNCTION M3_WTH_W2TH
!----------------------------------------------------------------------------
-FUNCTION D_M3_WTH_W2TH_O_DDTDZ(PREDTH1,PREDR1,PD,PBLL_O_E,PETHETA,PKEFF,PTKE)
+FUNCTION D_M3_WTH_W2TH_O_DDTDZ(KKA,KKU,KKL,PREDTH1,PREDR1,PD,PBLL_O_E,PETHETA,PKEFF,PTKE)
+ INTEGER, INTENT(IN) :: KKA
+ INTEGER, INTENT(IN) :: KKU
+ INTEGER, INTENT(IN) :: KKL
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
@@ -394,19 +958,25 @@ FUNCTION D_M3_WTH_W2TH_O_DDTDZ(PREDTH1,PREDR1,PD,PBLL_O_E,PETHETA,PKEFF,PTKE)
REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: D_M3_WTH_W2TH_O_DDTDZ
INTEGER :: IKB, IKE
!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_WTH_W2TH_O_DDTDZ',0,ZHOOK_HANDLE)
IKB = 1+JPVEXT_TURB
IKE = SIZE(PD,3)-JPVEXT_TURB
D_M3_WTH_W2TH_O_DDTDZ(:,:,:) = &
- - XCSHF*PKEFF*1.5/MZM(PTKE)/(1.+PREDTH1)**2*XCTV*PBLL_O_E*PETHETA &
+ - XCSHF*PKEFF*1.5/MZM(PTKE, KKA, KKU, KKL)/(1.+PREDTH1)**2*XCTV*PBLL_O_E*PETHETA &
* (1. - 0.5*PREDR1*(1.+PREDR1)/PD*( 1.+(1.+PREDTH1)*(1.5+PREDR1+PREDTH1)/PD) )
!
D_M3_WTH_W2TH_O_DDTDZ(:,:,IKB-1)=D_M3_WTH_W2TH_O_DDTDZ(:,:,IKB)
D_M3_WTH_W2TH_O_DDTDZ(:,:,IKE+1)=D_M3_WTH_W2TH_O_DDTDZ(:,:,IKE)
!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_WTH_W2TH_O_DDTDZ',1,ZHOOK_HANDLE)
END FUNCTION D_M3_WTH_W2TH_O_DDTDZ
!----------------------------------------------------------------------------
-FUNCTION M3_WTH_W2R(PD,PKEFF,PTKE,PBLL_O_E,PEMOIST,PDTDZ)
+FUNCTION M3_WTH_W2R(KKA,KKU,KKL,PD,PKEFF,PTKE,PBLL_O_E,PEMOIST,PDTDZ)
+ INTEGER, INTENT(IN) :: KKA
+ INTEGER, INTENT(IN) :: KKU
+ INTEGER, INTENT(IN) :: KKL
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
REAL, DIMENSION(:,:,:), INTENT(IN) :: PKEFF
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKE
@@ -416,17 +986,23 @@ FUNCTION M3_WTH_W2R(PD,PKEFF,PTKE,PBLL_O_E,PEMOIST,PDTDZ)
REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: M3_WTH_W2R
INTEGER :: IKB, IKE
!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_WTH_W2R',0,ZHOOK_HANDLE)
IKB = 1+JPVEXT_TURB
IKE = SIZE(PD,3)-JPVEXT_TURB
-M3_WTH_W2R(:,:,:) = - XCSHF*PKEFF*0.75*XCTV*PBLL_O_E/MZM(PTKE)*PEMOIST*PDTDZ/PD
+M3_WTH_W2R(:,:,:) = - XCSHF*PKEFF*0.75*XCTV*PBLL_O_E/MZM(PTKE, KKA, KKU, KKL)*PEMOIST*PDTDZ/PD
!
M3_WTH_W2R(:,:,IKB-1)=M3_WTH_W2R(:,:,IKB)
M3_WTH_W2R(:,:,IKE+1)=M3_WTH_W2R(:,:,IKE)
!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_WTH_W2R',1,ZHOOK_HANDLE)
END FUNCTION M3_WTH_W2R
!----------------------------------------------------------------------------
-FUNCTION D_M3_WTH_W2R_O_DDTDZ(PREDTH1,PREDR1,PD,PKEFF,PTKE,PBLL_O_E,PEMOIST)
+FUNCTION D_M3_WTH_W2R_O_DDTDZ(KKA,KKU,KKL,PREDTH1,PREDR1,PD,PKEFF,PTKE,PBLL_O_E,PEMOIST)
+ INTEGER, INTENT(IN) :: KKA
+ INTEGER, INTENT(IN) :: KKU
+ INTEGER, INTENT(IN) :: KKL
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
@@ -437,18 +1013,24 @@ FUNCTION D_M3_WTH_W2R_O_DDTDZ(PREDTH1,PREDR1,PD,PKEFF,PTKE,PBLL_O_E,PEMOIST)
REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: D_M3_WTH_W2R_O_DDTDZ
INTEGER :: IKB, IKE
!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_WTH_W2R_O_DDTDZ',0,ZHOOK_HANDLE)
IKB = 1+JPVEXT_TURB
IKE = SIZE(PD,3)-JPVEXT_TURB
-D_M3_WTH_W2R_O_DDTDZ(:,:,:) = - XCSHF*PKEFF*0.75*XCTV*PBLL_O_E/MZM(PTKE)*PEMOIST/PD &
+D_M3_WTH_W2R_O_DDTDZ(:,:,:) = - XCSHF*PKEFF*0.75*XCTV*PBLL_O_E/MZM(PTKE, KKA, KKU, KKL)*PEMOIST/PD &
* (1. - PREDTH1*(1.5+PREDTH1+PREDR1)/PD)
!
D_M3_WTH_W2R_O_DDTDZ(:,:,IKB-1)=D_M3_WTH_W2R_O_DDTDZ(:,:,IKB)
D_M3_WTH_W2R_O_DDTDZ(:,:,IKE+1)=D_M3_WTH_W2R_O_DDTDZ(:,:,IKE)
!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_WTH_W2R_O_DDTDZ',1,ZHOOK_HANDLE)
END FUNCTION D_M3_WTH_W2R_O_DDTDZ
!----------------------------------------------------------------------------
-FUNCTION M3_WTH_WR2(PD,PKEFF,PTKE,PSQRT_TKE,PBLL_O_E,PBETA,PLEPS,PEMOIST,PDTDZ)
+FUNCTION M3_WTH_WR2(KKA,KKU,KKL,PD,PKEFF,PTKE,PSQRT_TKE,PBLL_O_E,PBETA,PLEPS,PEMOIST,PDTDZ)
+ INTEGER, INTENT(IN) :: KKA
+ INTEGER, INTENT(IN) :: KKU
+ INTEGER, INTENT(IN) :: KKL
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
REAL, DIMENSION(:,:,:), INTENT(IN) :: PKEFF
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKE
@@ -461,18 +1043,24 @@ FUNCTION M3_WTH_WR2(PD,PKEFF,PTKE,PSQRT_TKE,PBLL_O_E,PBETA,PLEPS,PEMOIST,PDTDZ)
REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: M3_WTH_WR2
INTEGER :: IKB, IKE
!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_WTH_WR2',0,ZHOOK_HANDLE)
IKB = 1+JPVEXT_TURB
IKE = SIZE(PD,3)-JPVEXT_TURB
M3_WTH_WR2(:,:,:) = - XCSHF*PKEFF*0.25*PBLL_O_E*XCTV*PEMOIST**2 &
- *MZM(PBETA*PLEPS/(PSQRT_TKE*PTKE))/XCTD*PDTDZ/PD
+ *MZM(PBETA*PLEPS/(PSQRT_TKE*PTKE), KKA, KKU, KKL)/XCTD*PDTDZ/PD
!
M3_WTH_WR2(:,:,IKB-1)=M3_WTH_WR2(:,:,IKB)
M3_WTH_WR2(:,:,IKE+1)=M3_WTH_WR2(:,:,IKE)
!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_WTH_WR2',1,ZHOOK_HANDLE)
END FUNCTION M3_WTH_WR2
!----------------------------------------------------------------------------
-FUNCTION D_M3_WTH_WR2_O_DDTDZ(PREDTH1,PREDR1,PD,PKEFF,PTKE,PSQRT_TKE,PBLL_O_E,PBETA,PLEPS,PEMOIST)
+FUNCTION D_M3_WTH_WR2_O_DDTDZ(KKA,KKU,KKL,PREDTH1,PREDR1,PD,PKEFF,PTKE,PSQRT_TKE,PBLL_O_E,PBETA,PLEPS,PEMOIST)
+ INTEGER, INTENT(IN) :: KKA
+ INTEGER, INTENT(IN) :: KKU
+ INTEGER, INTENT(IN) :: KKL
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
@@ -486,19 +1074,25 @@ FUNCTION D_M3_WTH_WR2_O_DDTDZ(PREDTH1,PREDR1,PD,PKEFF,PTKE,PSQRT_TKE,PBLL_O_E,PB
REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: D_M3_WTH_WR2_O_DDTDZ
INTEGER :: IKB, IKE
!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_WTH_WR2_O_DDTDZ',0,ZHOOK_HANDLE)
IKB = 1+JPVEXT_TURB
IKE = SIZE(PD,3)-JPVEXT_TURB
D_M3_WTH_WR2_O_DDTDZ(:,:,:) = - XCSHF*PKEFF*0.25*PBLL_O_E*XCTV*PEMOIST**2 &
- *MZM(PBETA*PLEPS/(PSQRT_TKE*PTKE))/XCTD/PD &
+ *MZM(PBETA*PLEPS/(PSQRT_TKE*PTKE), KKA, KKU, KKL)/XCTD/PD &
* (1. - PREDTH1*(1.5+PREDTH1+PREDR1)/PD)
!
D_M3_WTH_WR2_O_DDTDZ(:,:,IKB-1)=D_M3_WTH_WR2_O_DDTDZ(:,:,IKB)
D_M3_WTH_WR2_O_DDTDZ(:,:,IKE+1)=D_M3_WTH_WR2_O_DDTDZ(:,:,IKE)
!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_WTH_WR2_O_DDTDZ',1,ZHOOK_HANDLE)
END FUNCTION D_M3_WTH_WR2_O_DDTDZ
!----------------------------------------------------------------------------
-FUNCTION M3_WTH_WTHR(PREDR1,PD,PKEFF,PTKE,PSQRT_TKE,PBETA,PLEPS,PEMOIST)
+FUNCTION M3_WTH_WTHR(KKA,KKU,KKL,PREDR1,PD,PKEFF,PTKE,PSQRT_TKE,PBETA,PLEPS,PEMOIST)
+ INTEGER, INTENT(IN) :: KKA
+ INTEGER, INTENT(IN) :: KKU
+ INTEGER, INTENT(IN) :: KKL
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
REAL, DIMENSION(:,:,:), INTENT(IN) :: PKEFF
@@ -510,17 +1104,20 @@ FUNCTION M3_WTH_WTHR(PREDR1,PD,PKEFF,PTKE,PSQRT_TKE,PBETA,PLEPS,PEMOIST)
REAL, DIMENSION(SIZE(PREDR1,1),SIZE(PREDR1,2),SIZE(PREDR1,3)) :: M3_WTH_WTHR
INTEGER :: IKB, IKE
!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_WTH_WTHR',0,ZHOOK_HANDLE)
IKB = 1+JPVEXT_TURB
IKE = SIZE(PD,3)-JPVEXT_TURB
-!M3_WTH_WTHR(:,:,:) = XCSHF*PKEFF*PEMOIST/MZM(PBETA*PTKE*PSQRT_TKE) &
+!M3_WTH_WTHR(:,:,:) = XCSHF*PKEFF*PEMOIST/MZM(PBETA*PTKE*PSQRT_TKE, KKA, KKU, KKL) &
! *0.5*PLEPS/XCTD*(1+PREDR1)/PD
-M3_WTH_WTHR(:,:,:) = XCSHF*PKEFF*PEMOIST*MZM(PBETA/PTKE*PSQRT_TKE) &
+M3_WTH_WTHR(:,:,:) = XCSHF*PKEFF*PEMOIST*MZM(PBETA/PTKE*PSQRT_TKE, KKA, KKU, KKL) &
*0.5*PLEPS/XCTD*(1+PREDR1)/PD
!
M3_WTH_WTHR(:,:,IKB-1)=M3_WTH_WTHR(:,:,IKB)
M3_WTH_WTHR(:,:,IKE+1)=M3_WTH_WTHR(:,:,IKE)
!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_WTH_WTHR',1,ZHOOK_HANDLE)
END FUNCTION M3_WTH_WTHR
!----------------------------------------------------------------------------
FUNCTION D_M3_WTH_WTHR_O_DDTDZ(PM3_WTH_WTHR,PREDTH1,PREDR1,PD,PBLL_O_E,PETHETA)
@@ -533,6 +1130,8 @@ FUNCTION D_M3_WTH_WTHR_O_DDTDZ(PM3_WTH_WTHR,PREDTH1,PREDR1,PD,PBLL_O_E,PETHETA)
REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: D_M3_WTH_WTHR_O_DDTDZ
INTEGER :: IKB, IKE
!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_WTH_WTHR_O_DDTDZ',0,ZHOOK_HANDLE)
IKB = 1+JPVEXT_TURB
IKE = SIZE(PD,3)-JPVEXT_TURB
@@ -541,9 +1140,13 @@ D_M3_WTH_WTHR_O_DDTDZ(:,:,:) = - PM3_WTH_WTHR * (1.5+PREDTH1+PREDR1)/PD*XCTV*PBL
D_M3_WTH_WTHR_O_DDTDZ(:,:,IKB-1)=D_M3_WTH_WTHR_O_DDTDZ(:,:,IKB)
D_M3_WTH_WTHR_O_DDTDZ(:,:,IKE+1)=D_M3_WTH_WTHR_O_DDTDZ(:,:,IKE)
!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_WTH_WTHR_O_DDTDZ',1,ZHOOK_HANDLE)
END FUNCTION D_M3_WTH_WTHR_O_DDTDZ
!----------------------------------------------------------------------------
-FUNCTION M3_TH2_W2TH(PREDTH1,PREDR1,PD,PDTDZ,PLM,PLEPS,PTKE)
+FUNCTION M3_TH2_W2TH(KKA,KKU,KKL,PREDTH1,PREDR1,PD,PDTDZ,PLM,PLEPS,PTKE)
+ INTEGER, INTENT(IN) :: KKA
+ INTEGER, INTENT(IN) :: KKU
+ INTEGER, INTENT(IN) :: KKL
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
@@ -554,18 +1157,24 @@ FUNCTION M3_TH2_W2TH(PREDTH1,PREDR1,PD,PDTDZ,PLM,PLEPS,PTKE)
REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: M3_TH2_W2TH
INTEGER :: IKB, IKE
!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_TH2_W2TH',0,ZHOOK_HANDLE)
IKB = 1+JPVEXT_TURB
IKE = SIZE(PD,3)-JPVEXT_TURB
-M3_TH2_W2TH(:,:,:) = - MZF((1.-0.5*PREDR1*(1.+PREDR1)/PD)/(1.+PREDTH1)*PDTDZ) &
+M3_TH2_W2TH(:,:,:) = - MZF((1.-0.5*PREDR1*(1.+PREDR1)/PD)/(1.+PREDTH1)*PDTDZ, KKA, KKU, KKL) &
* 1.5*PLM*PLEPS/PTKE*XCTV
!
M3_TH2_W2TH(:,:,IKB-1)=M3_TH2_W2TH(:,:,IKB)
M3_TH2_W2TH(:,:,IKE+1)=M3_TH2_W2TH(:,:,IKE)
!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_TH2_W2TH',1,ZHOOK_HANDLE)
END FUNCTION M3_TH2_W2TH
!----------------------------------------------------------------------------
-FUNCTION D_M3_TH2_W2TH_O_DDTDZ(PREDTH1,PREDR1,PD,PLM,PLEPS,PTKE,OUSERV)
+FUNCTION D_M3_TH2_W2TH_O_DDTDZ(KKA,KKU,KKL,PREDTH1,PREDR1,PD,PLM,PLEPS,PTKE,OUSERV)
+ INTEGER, INTENT(IN) :: KKA
+ INTEGER, INTENT(IN) :: KKU
+ INTEGER, INTENT(IN) :: KKL
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
@@ -576,27 +1185,33 @@ FUNCTION D_M3_TH2_W2TH_O_DDTDZ(PREDTH1,PREDR1,PD,PLM,PLEPS,PTKE,OUSERV)
REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: D_M3_TH2_W2TH_O_DDTDZ
INTEGER :: IKB, IKE
!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_TH2_W2TH_O_DDTDZ',0,ZHOOK_HANDLE)
IKB = 1+JPVEXT_TURB
IKE = SIZE(PD,3)-JPVEXT_TURB
IF (OUSERV) THEN
! D_M3_TH2_W2TH_O_DDTDZ(:,:,:) = - 1.5*PLM*PLEPS/PTKE*XCTV * MZF( &
! (1.-0.5*PREDR1*(1.+PREDR1)/PD)*(1.-(1.5+PREDTH1+PREDR1)*(1.+PREDTH1)/PD ) &
-! / (1.+PREDTH1)**2 )
- D_M3_TH2_W2TH_O_DDTDZ(:,:,:) = - 1.5*PLM*PLEPS/PTKE*XCTV * MZF( &
+! / (1.+PREDTH1)**2, KKA, KKU, KKL)
+ D_M3_TH2_W2TH_O_DDTDZ(:,:,:) = - 1.5*PLM*PLEPS/PTKE*XCTV * MZF( &
(1.-0.5*PREDR1*(1.+PREDR1)/PD)*(1.-(1.5+PREDTH1+PREDR1)* &
- PREDTH1*(1.+PREDTH1)/PD ) / (1.+PREDTH1)**2 )
+ PREDTH1*(1.+PREDTH1)/PD ) / (1.+PREDTH1)**2, KKA, KKU, KKL)
ELSE
- D_M3_TH2_W2TH_O_DDTDZ(:,:,:) = - 1.5*PLM*PLEPS/PTKE*XCTV * MZF(1./(1.+PREDTH1)**2)
+ D_M3_TH2_W2TH_O_DDTDZ(:,:,:) = - 1.5*PLM*PLEPS/PTKE*XCTV * MZF(1./(1.+PREDTH1)**2, KKA, KKU, KKL)
END IF
!
D_M3_TH2_W2TH_O_DDTDZ(:,:,IKB-1)=D_M3_TH2_W2TH_O_DDTDZ(:,:,IKB)
D_M3_TH2_W2TH_O_DDTDZ(:,:,IKE+1)=D_M3_TH2_W2TH_O_DDTDZ(:,:,IKE)
!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_TH2_W2TH_O_DDTDZ',1,ZHOOK_HANDLE)
END FUNCTION D_M3_TH2_W2TH_O_DDTDZ
!----------------------------------------------------------------------------
-FUNCTION M3_TH2_WTH2(PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE)
+FUNCTION M3_TH2_WTH2(KKA,KKU,KKL,PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE)
+ INTEGER, INTENT(IN) :: KKA
+ INTEGER, INTENT(IN) :: KKU
+ INTEGER, INTENT(IN) :: KKL
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
@@ -605,18 +1220,24 @@ FUNCTION M3_TH2_WTH2(PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE)
REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: M3_TH2_WTH2
INTEGER :: IKB, IKE
!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_TH2_WTH2',0,ZHOOK_HANDLE)
IKB = 1+JPVEXT_TURB
IKE = SIZE(PD,3)-JPVEXT_TURB
M3_TH2_WTH2(:,:,:) = PLEPS*0.5/XCTD/PSQRT_TKE &
- * MZF( (1.+0.5*PREDTH1+1.5*PREDR1+0.5*PREDR1**2)/PD )
+ * MZF((1.+0.5*PREDTH1+1.5*PREDR1+0.5*PREDR1**2)/PD, KKA, KKU, KKL)
!
M3_TH2_WTH2(:,:,IKB-1)=M3_TH2_WTH2(:,:,IKB)
M3_TH2_WTH2(:,:,IKE+1)=M3_TH2_WTH2(:,:,IKE)
!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_TH2_WTH2',1,ZHOOK_HANDLE)
END FUNCTION M3_TH2_WTH2
!----------------------------------------------------------------------------
-FUNCTION D_M3_TH2_WTH2_O_DDTDZ(PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA)
+FUNCTION D_M3_TH2_WTH2_O_DDTDZ(KKA,KKU,KKL,PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA)
+ INTEGER, INTENT(IN) :: KKA
+ INTEGER, INTENT(IN) :: KKU
+ INTEGER, INTENT(IN) :: KKL
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
@@ -627,20 +1248,26 @@ FUNCTION D_M3_TH2_WTH2_O_DDTDZ(PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHET
REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: D_M3_TH2_WTH2_O_DDTDZ
INTEGER :: IKB, IKE
!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_TH2_WTH2_O_DDTDZ',0,ZHOOK_HANDLE)
IKB = 1+JPVEXT_TURB
IKE = SIZE(PD,3)-JPVEXT_TURB
D_M3_TH2_WTH2_O_DDTDZ(:,:,:) = PLEPS*0.5/XCTD/PSQRT_TKE*XCTV &
- * MZF( PBLL_O_E*PETHETA* (0.5/PD &
+ * MZF(PBLL_O_E*PETHETA* (0.5/PD &
- (1.5+PREDTH1+PREDR1)*(1.+0.5*PREDTH1+1.5*PREDR1+0.5*PREDR1**2)/PD**2 &
- ) )
+ ), KKA, KKU, KKL)
!
D_M3_TH2_WTH2_O_DDTDZ(:,:,IKB-1)=D_M3_TH2_WTH2_O_DDTDZ(:,:,IKB)
D_M3_TH2_WTH2_O_DDTDZ(:,:,IKE+1)=D_M3_TH2_WTH2_O_DDTDZ(:,:,IKE)
!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_TH2_WTH2_O_DDTDZ',1,ZHOOK_HANDLE)
END FUNCTION D_M3_TH2_WTH2_O_DDTDZ
!----------------------------------------------------------------------------
-FUNCTION M3_TH2_W2R(PD,PLM,PLEPS,PTKE,PBLL_O_E,PEMOIST,PDTDZ)
+FUNCTION M3_TH2_W2R(KKA,KKU,KKL,PD,PLM,PLEPS,PTKE,PBLL_O_E,PEMOIST,PDTDZ)
+ INTEGER, INTENT(IN) :: KKA
+ INTEGER, INTENT(IN) :: KKU
+ INTEGER, INTENT(IN) :: KKL
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
REAL, DIMENSION(:,:,:), INTENT(IN) :: PLM
REAL, DIMENSION(:,:,:), INTENT(IN) :: PLEPS
@@ -651,17 +1278,23 @@ FUNCTION M3_TH2_W2R(PD,PLM,PLEPS,PTKE,PBLL_O_E,PEMOIST,PDTDZ)
REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: M3_TH2_W2R
INTEGER :: IKB, IKE
!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_TH2_W2R',0,ZHOOK_HANDLE)
IKB = 1+JPVEXT_TURB
IKE = SIZE(PD,3)-JPVEXT_TURB
-M3_TH2_W2R(:,:,:) = 0.75*XCTV**2*MZF(PBLL_O_E*PEMOIST/PD*PDTDZ**2)*PLM*PLEPS/PTKE
+M3_TH2_W2R(:,:,:) = 0.75*XCTV**2*MZF(PBLL_O_E*PEMOIST/PD*PDTDZ**2, KKA, KKU, KKL)*PLM*PLEPS/PTKE
!
M3_TH2_W2R(:,:,IKB-1)=M3_TH2_W2R(:,:,IKB)
M3_TH2_W2R(:,:,IKE+1)=M3_TH2_W2R(:,:,IKE)
!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_TH2_W2R',1,ZHOOK_HANDLE)
END FUNCTION M3_TH2_W2R
!----------------------------------------------------------------------------
-FUNCTION D_M3_TH2_W2R_O_DDTDZ(PREDTH1,PREDR1,PD,PLM,PLEPS,PTKE,PBLL_O_E,PEMOIST,PDTDZ)
+FUNCTION D_M3_TH2_W2R_O_DDTDZ(KKA,KKU,KKL,PREDTH1,PREDR1,PD,PLM,PLEPS,PTKE,PBLL_O_E,PEMOIST,PDTDZ)
+ INTEGER, INTENT(IN) :: KKA
+ INTEGER, INTENT(IN) :: KKU
+ INTEGER, INTENT(IN) :: KKL
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
@@ -674,18 +1307,24 @@ FUNCTION D_M3_TH2_W2R_O_DDTDZ(PREDTH1,PREDR1,PD,PLM,PLEPS,PTKE,PBLL_O_E,PEMOIST,
REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: D_M3_TH2_W2R_O_DDTDZ
INTEGER :: IKB, IKE
!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_TH2_W2R_O_DDTDZ',0,ZHOOK_HANDLE)
IKB = 1+JPVEXT_TURB
IKE = SIZE(PD,3)-JPVEXT_TURB
D_M3_TH2_W2R_O_DDTDZ(:,:,:) = 0.75*XCTV**2*PLM*PLEPS/PTKE &
- * MZF( PBLL_O_E*PEMOIST/PD*PDTDZ*(2.-PREDTH1*(1.5+PREDTH1+PREDR1)/PD) )
+ * MZF(PBLL_O_E*PEMOIST/PD*PDTDZ*(2.-PREDTH1*(1.5+PREDTH1+PREDR1)/PD), KKA, KKU, KKL)
!
D_M3_TH2_W2R_O_DDTDZ(:,:,IKB-1)=D_M3_TH2_W2R_O_DDTDZ(:,:,IKB)
D_M3_TH2_W2R_O_DDTDZ(:,:,IKE+1)=D_M3_TH2_W2R_O_DDTDZ(:,:,IKE)
!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_TH2_W2R_O_DDTDZ',1,ZHOOK_HANDLE)
END FUNCTION D_M3_TH2_W2R_O_DDTDZ
!----------------------------------------------------------------------------
-FUNCTION M3_TH2_WR2(PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PDTDZ)
+FUNCTION M3_TH2_WR2(KKA,KKU,KKL,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PDTDZ)
+ INTEGER, INTENT(IN) :: KKA
+ INTEGER, INTENT(IN) :: KKU
+ INTEGER, INTENT(IN) :: KKL
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
REAL, DIMENSION(:,:,:), INTENT(IN) :: PLEPS
REAL, DIMENSION(:,:,:), INTENT(IN) :: PSQRT_TKE
@@ -695,17 +1334,23 @@ FUNCTION M3_TH2_WR2(PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PDTDZ)
REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: M3_TH2_WR2
INTEGER :: IKB, IKE
!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_TH2_WR2',0,ZHOOK_HANDLE)
IKB = 1+JPVEXT_TURB
IKE = SIZE(PD,3)-JPVEXT_TURB
-M3_TH2_WR2(:,:,:) = 0.25*XCTV**2*MZF((PBLL_O_E*PEMOIST*PDTDZ)**2/PD)*PLEPS/PSQRT_TKE/XCTD
+M3_TH2_WR2(:,:,:) = 0.25*XCTV**2*MZF((PBLL_O_E*PEMOIST*PDTDZ)**2/PD, KKA, KKU, KKL)*PLEPS/PSQRT_TKE/XCTD
!
M3_TH2_WR2(:,:,IKB-1)=M3_TH2_WR2(:,:,IKB)
M3_TH2_WR2(:,:,IKE+1)=M3_TH2_WR2(:,:,IKE)
!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_TH2_WR2',1,ZHOOK_HANDLE)
END FUNCTION M3_TH2_WR2
!----------------------------------------------------------------------------
-FUNCTION D_M3_TH2_WR2_O_DDTDZ(PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PDTDZ)
+FUNCTION D_M3_TH2_WR2_O_DDTDZ(KKA,KKU,KKL,PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PDTDZ)
+ INTEGER, INTENT(IN) :: KKA
+ INTEGER, INTENT(IN) :: KKU
+ INTEGER, INTENT(IN) :: KKL
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
@@ -717,18 +1362,24 @@ FUNCTION D_M3_TH2_WR2_O_DDTDZ(PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST
REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: D_M3_TH2_WR2_O_DDTDZ
INTEGER :: IKB, IKE
!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_TH2_WR2_O_DDTDZ',0,ZHOOK_HANDLE)
IKB = 1+JPVEXT_TURB
IKE = SIZE(PD,3)-JPVEXT_TURB
D_M3_TH2_WR2_O_DDTDZ(:,:,:) = 0.25*XCTV**2*PLEPS/PSQRT_TKE/XCTD &
- * MZF( (PBLL_O_E*PEMOIST)**2*PDTDZ/PD*(2.-PREDTH1*(1.5+PREDTH1+PREDR1)/PD) )
+ * MZF((PBLL_O_E*PEMOIST)**2*PDTDZ/PD*(2.-PREDTH1*(1.5+PREDTH1+PREDR1)/PD), KKA, KKU, KKL)
!
D_M3_TH2_WR2_O_DDTDZ(:,:,IKB-1)=D_M3_TH2_WR2_O_DDTDZ(:,:,IKB)
D_M3_TH2_WR2_O_DDTDZ(:,:,IKE+1)=D_M3_TH2_WR2_O_DDTDZ(:,:,IKE)
!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_TH2_WR2_O_DDTDZ',1,ZHOOK_HANDLE)
END FUNCTION D_M3_TH2_WR2_O_DDTDZ
!----------------------------------------------------------------------------
-FUNCTION M3_TH2_WTHR(PREDR1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PDTDZ)
+FUNCTION M3_TH2_WTHR(KKA,KKU,KKL,PREDR1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PDTDZ)
+ INTEGER, INTENT(IN) :: KKA
+ INTEGER, INTENT(IN) :: KKU
+ INTEGER, INTENT(IN) :: KKL
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
REAL, DIMENSION(:,:,:), INTENT(IN) :: PLEPS
@@ -739,18 +1390,24 @@ FUNCTION M3_TH2_WTHR(PREDR1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PDTDZ)
REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: M3_TH2_WTHR
INTEGER :: IKB, IKE
!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_TH2_WTHR',0,ZHOOK_HANDLE)
IKB = 1+JPVEXT_TURB
IKE = SIZE(PD,3)-JPVEXT_TURB
M3_TH2_WTHR(:,:,:) = - 0.5*XCTV*PLEPS/PSQRT_TKE/XCTD &
- * MZF( PBLL_O_E*PEMOIST*PDTDZ*(1.+PREDR1)/PD )
+ * MZF(PBLL_O_E*PEMOIST*PDTDZ*(1.+PREDR1)/PD, KKA, KKU, KKL)
!
M3_TH2_WTHR(:,:,IKB-1)=M3_TH2_WTHR(:,:,IKB)
M3_TH2_WTHR(:,:,IKE+1)=M3_TH2_WTHR(:,:,IKE)
!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_TH2_WTHR',1,ZHOOK_HANDLE)
END FUNCTION M3_TH2_WTHR
!----------------------------------------------------------------------------
-FUNCTION D_M3_TH2_WTHR_O_DDTDZ(PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PDTDZ)
+FUNCTION D_M3_TH2_WTHR_O_DDTDZ(KKA,KKU,KKL,PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PDTDZ)
+ INTEGER, INTENT(IN) :: KKA
+ INTEGER, INTENT(IN) :: KKU
+ INTEGER, INTENT(IN) :: KKL
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
@@ -762,18 +1419,24 @@ FUNCTION D_M3_TH2_WTHR_O_DDTDZ(PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIS
REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: D_M3_TH2_WTHR_O_DDTDZ
INTEGER :: IKB, IKE
!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_TH2_WTHR_O_DDTDZ',0,ZHOOK_HANDLE)
IKB = 1+JPVEXT_TURB
IKE = SIZE(PD,3)-JPVEXT_TURB
D_M3_TH2_WTHR_O_DDTDZ(:,:,:) = - 0.5*XCTV*PLEPS/PSQRT_TKE/XCTD &
- * MZF( PBLL_O_E*PEMOIST*(1.+PREDR1)/PD * (1. -PREDTH1*(1.5+PREDTH1+PREDR1)/PD) )
+ * MZF(PBLL_O_E*PEMOIST*(1.+PREDR1)/PD * (1. -PREDTH1*(1.5+PREDTH1+PREDR1)/PD), KKA, KKU, KKL)
!
D_M3_TH2_WTHR_O_DDTDZ(:,:,IKB-1)=D_M3_TH2_WTHR_O_DDTDZ(:,:,IKB)
D_M3_TH2_WTHR_O_DDTDZ(:,:,IKE+1)=D_M3_TH2_WTHR_O_DDTDZ(:,:,IKE)
!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_TH2_WTHR_O_DDTDZ',1,ZHOOK_HANDLE)
END FUNCTION D_M3_TH2_WTHR_O_DDTDZ
!----------------------------------------------------------------------------
-FUNCTION M3_THR_WTHR(PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE)
+FUNCTION M3_THR_WTHR(KKA,KKU,KKL,PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE)
+ INTEGER, INTENT(IN) :: KKA
+ INTEGER, INTENT(IN) :: KKU
+ INTEGER, INTENT(IN) :: KKL
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
@@ -782,18 +1445,24 @@ FUNCTION M3_THR_WTHR(PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE)
REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: M3_THR_WTHR
INTEGER :: IKB, IKE
!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_THR_WTHR',0,ZHOOK_HANDLE)
IKB = 1+JPVEXT_TURB
IKE = SIZE(PD,3)-JPVEXT_TURB
M3_THR_WTHR(:,:,:) = 0.5*PLEPS/PSQRT_TKE/XCTD &
- * MZF( (1.+PREDTH1)*(1.+PREDR1)/PD )
+ * MZF((1.+PREDTH1)*(1.+PREDR1)/PD, KKA, KKU, KKL)
!
M3_THR_WTHR(:,:,IKB-1)=M3_THR_WTHR(:,:,IKB)
M3_THR_WTHR(:,:,IKE+1)=M3_THR_WTHR(:,:,IKE)
!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_THR_WTHR',1,ZHOOK_HANDLE)
END FUNCTION M3_THR_WTHR
!----------------------------------------------------------------------------
-FUNCTION D_M3_THR_WTHR_O_DDTDZ(PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA)
+FUNCTION D_M3_THR_WTHR_O_DDTDZ(KKA,KKU,KKL,PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA)
+ INTEGER, INTENT(IN) :: KKA
+ INTEGER, INTENT(IN) :: KKU
+ INTEGER, INTENT(IN) :: KKL
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
@@ -804,18 +1473,24 @@ FUNCTION D_M3_THR_WTHR_O_DDTDZ(PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHET
REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: D_M3_THR_WTHR_O_DDTDZ
INTEGER :: IKB, IKE
!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_THR_WTHR_O_DDTDZ',0,ZHOOK_HANDLE)
IKB = 1+JPVEXT_TURB
IKE = SIZE(PD,3)-JPVEXT_TURB
D_M3_THR_WTHR_O_DDTDZ(:,:,:) = 0.5*PLEPS/PSQRT_TKE/XCTD * XCTV &
- * MZF( PETHETA*PBLL_O_E/PD*(1.+PREDR1)*(1.-(1.+PREDTH1)*(1.5+PREDTH1+PREDR1)/PD) )
+ * MZF(PETHETA*PBLL_O_E/PD*(1.+PREDR1)*(1.-(1.+PREDTH1)*(1.5+PREDTH1+PREDR1)/PD), KKA, KKU, KKL)
!
D_M3_THR_WTHR_O_DDTDZ(:,:,IKB-1)=D_M3_THR_WTHR_O_DDTDZ(:,:,IKB)
D_M3_THR_WTHR_O_DDTDZ(:,:,IKE+1)=D_M3_THR_WTHR_O_DDTDZ(:,:,IKE)
!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_THR_WTHR_O_DDTDZ',1,ZHOOK_HANDLE)
END FUNCTION D_M3_THR_WTHR_O_DDTDZ
!----------------------------------------------------------------------------
-FUNCTION M3_THR_WTH2(PREDR1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDRDZ)
+FUNCTION M3_THR_WTH2(KKA,KKU,KKL,PREDR1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDRDZ)
+ INTEGER, INTENT(IN) :: KKA
+ INTEGER, INTENT(IN) :: KKU
+ INTEGER, INTENT(IN) :: KKL
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
REAL, DIMENSION(:,:,:), INTENT(IN) :: PLEPS
@@ -826,18 +1501,24 @@ FUNCTION M3_THR_WTH2(PREDR1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDRDZ)
REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: M3_THR_WTH2
INTEGER :: IKB, IKE
!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_THR_WTH2',0,ZHOOK_HANDLE)
IKB = 1+JPVEXT_TURB
IKE = SIZE(PD,3)-JPVEXT_TURB
M3_THR_WTH2(:,:,:) = - 0.25*PLEPS/PSQRT_TKE/XCTD*XCTV &
- * MZF( (1.+PREDR1)*PBLL_O_E*PETHETA*PDRDZ/PD )
+ * MZF((1.+PREDR1)*PBLL_O_E*PETHETA*PDRDZ/PD, KKA, KKU, KKL)
!
M3_THR_WTH2(:,:,IKB-1)=M3_THR_WTH2(:,:,IKB)
M3_THR_WTH2(:,:,IKE+1)=M3_THR_WTH2(:,:,IKE)
!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_THR_WTH2',1,ZHOOK_HANDLE)
END FUNCTION M3_THR_WTH2
!----------------------------------------------------------------------------
-FUNCTION D_M3_THR_WTH2_O_DDTDZ(PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDRDZ)
+FUNCTION D_M3_THR_WTH2_O_DDTDZ(KKA,KKU,KKL,PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDRDZ)
+ INTEGER, INTENT(IN) :: KKA
+ INTEGER, INTENT(IN) :: KKU
+ INTEGER, INTENT(IN) :: KKL
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
@@ -849,18 +1530,24 @@ FUNCTION D_M3_THR_WTH2_O_DDTDZ(PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHET
REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: D_M3_THR_WTH2_O_DDTDZ
INTEGER :: IKB, IKE
!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_THR_WTH2_O_DDTDZ',0,ZHOOK_HANDLE)
IKB = 1+JPVEXT_TURB
IKE = SIZE(PD,3)-JPVEXT_TURB
D_M3_THR_WTH2_O_DDTDZ(:,:,:) = - 0.25*PLEPS/PSQRT_TKE/XCTD*XCTV**2 &
- * MZF( -(1.+PREDR1)*(PBLL_O_E*PETHETA/PD)**2*PDRDZ*(1.5+PREDTH1+PREDR1) )
+ * MZF(-(1.+PREDR1)*(PBLL_O_E*PETHETA/PD)**2*PDRDZ*(1.5+PREDTH1+PREDR1), KKA, KKU, KKL)
!
D_M3_THR_WTH2_O_DDTDZ(:,:,IKB-1)=D_M3_THR_WTH2_O_DDTDZ(:,:,IKB)
D_M3_THR_WTH2_O_DDTDZ(:,:,IKE+1)=D_M3_THR_WTH2_O_DDTDZ(:,:,IKE)
!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_THR_WTH2_O_DDTDZ',1,ZHOOK_HANDLE)
END FUNCTION D_M3_THR_WTH2_O_DDTDZ
!----------------------------------------------------------------------------
-FUNCTION D_M3_THR_WTH2_O_DDRDZ(PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA)
+FUNCTION D_M3_THR_WTH2_O_DDRDZ(KKA,KKU,KKL,PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA)
+ INTEGER, INTENT(IN) :: KKA
+ INTEGER, INTENT(IN) :: KKU
+ INTEGER, INTENT(IN) :: KKL
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
@@ -871,20 +1558,26 @@ FUNCTION D_M3_THR_WTH2_O_DDRDZ(PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHET
REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: D_M3_THR_WTH2_O_DDRDZ
INTEGER :: IKB, IKE
!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_THR_WTH2_O_DDRDZ',0,ZHOOK_HANDLE)
IKB = 1+JPVEXT_TURB
IKE = SIZE(PD,3)-JPVEXT_TURB
D_M3_THR_WTH2_O_DDRDZ(:,:,:) = - 0.25*PLEPS/PSQRT_TKE/XCTD*XCTV &
- * MZF( PBLL_O_E*PETHETA/PD &
- *(-(1.+PREDR1)*PREDR1/PD*(1.5+PREDTH1+PREDR1)+(1.+2.*PREDR1)) &
- )
+ * MZF(PBLL_O_E*PETHETA/PD &
+ *(-(1.+PREDR1)*PREDR1/PD*(1.5+PREDTH1+PREDR1)+(1.+2.*PREDR1)), &
+ KKA, KKU, KKL)
!
D_M3_THR_WTH2_O_DDRDZ(:,:,IKB-1)=D_M3_THR_WTH2_O_DDRDZ(:,:,IKB)
D_M3_THR_WTH2_O_DDRDZ(:,:,IKE+1)=D_M3_THR_WTH2_O_DDRDZ(:,:,IKE)
!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_THR_WTH2_O_DDRDZ',1,ZHOOK_HANDLE)
END FUNCTION D_M3_THR_WTH2_O_DDRDZ
!----------------------------------------------------------------------------
-FUNCTION M3_THR_W2TH(PREDR1,PD,PLM,PLEPS,PTKE,PDRDZ)
+FUNCTION M3_THR_W2TH(KKA,KKU,KKL,PREDR1,PD,PLM,PLEPS,PTKE,PDRDZ)
+ INTEGER, INTENT(IN) :: KKA
+ INTEGER, INTENT(IN) :: KKU
+ INTEGER, INTENT(IN) :: KKL
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
REAL, DIMENSION(:,:,:), INTENT(IN) :: PLM
@@ -894,18 +1587,24 @@ FUNCTION M3_THR_W2TH(PREDR1,PD,PLM,PLEPS,PTKE,PDRDZ)
REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: M3_THR_W2TH
INTEGER :: IKB, IKE
!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_THR_W2TH',0,ZHOOK_HANDLE)
IKB = 1+JPVEXT_TURB
IKE = SIZE(PD,3)-JPVEXT_TURB
M3_THR_W2TH(:,:,:) = - 0.75*PLM*PLEPS/PTKE * XCTV &
- * MZF( (1.+PREDR1)*PDRDZ/PD )
+ * MZF((1.+PREDR1)*PDRDZ/PD, KKA, KKU, KKL)
!
M3_THR_W2TH(:,:,IKB-1)=M3_THR_W2TH(:,:,IKB)
M3_THR_W2TH(:,:,IKE+1)=M3_THR_W2TH(:,:,IKE)
!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_THR_W2TH',1,ZHOOK_HANDLE)
END FUNCTION M3_THR_W2TH
!----------------------------------------------------------------------------
-FUNCTION D_M3_THR_W2TH_O_DDTDZ(PREDTH1,PREDR1,PD,PLM,PLEPS,PTKE,PBLL_O_E,PDRDZ,PETHETA)
+FUNCTION D_M3_THR_W2TH_O_DDTDZ(KKA,KKU,KKL,PREDTH1,PREDR1,PD,PLM,PLEPS,PTKE,PBLL_O_E,PDRDZ,PETHETA)
+ INTEGER, INTENT(IN) :: KKA
+ INTEGER, INTENT(IN) :: KKU
+ INTEGER, INTENT(IN) :: KKL
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
@@ -918,19 +1617,25 @@ FUNCTION D_M3_THR_W2TH_O_DDTDZ(PREDTH1,PREDR1,PD,PLM,PLEPS,PTKE,PBLL_O_E,PDRDZ,P
REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: D_M3_THR_W2TH_O_DDTDZ
INTEGER :: IKB, IKE
!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_THR_W2TH_O_DDTDZ',0,ZHOOK_HANDLE)
IKB = 1+JPVEXT_TURB
IKE = SIZE(PD,3)-JPVEXT_TURB
D_M3_THR_W2TH_O_DDTDZ(:,:,:) = - 0.75*PLM*PLEPS/PTKE * XCTV**2 &
- * MZF( -PETHETA*PBLL_O_E*(1.+PREDR1)*PDRDZ*(1.5+PREDTH1+PREDR1)/PD**2 )
+ * MZF(-PETHETA*PBLL_O_E*(1.+PREDR1)*PDRDZ*(1.5+PREDTH1+PREDR1)/PD**2, KKA, KKU, KKL)
!
D_M3_THR_W2TH_O_DDTDZ(:,:,IKB-1)=D_M3_THR_W2TH_O_DDTDZ(:,:,IKB)
D_M3_THR_W2TH_O_DDTDZ(:,:,IKE+1)=D_M3_THR_W2TH_O_DDTDZ(:,:,IKE)
!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_THR_W2TH_O_DDTDZ',1,ZHOOK_HANDLE)
END FUNCTION D_M3_THR_W2TH_O_DDTDZ
!----------------------------------------------------------------------------
-FUNCTION D_M3_THR_W2TH_O_DDRDZ(PREDTH1,PREDR1,PD,PLM,PLEPS,PTKE)
+FUNCTION D_M3_THR_W2TH_O_DDRDZ(KKA,KKU,KKL,PREDTH1,PREDR1,PD,PLM,PLEPS,PTKE)
+ INTEGER, INTENT(IN) :: KKA
+ INTEGER, INTENT(IN) :: KKU
+ INTEGER, INTENT(IN) :: KKL
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
@@ -940,18 +1645,21 @@ FUNCTION D_M3_THR_W2TH_O_DDRDZ(PREDTH1,PREDR1,PD,PLM,PLEPS,PTKE)
REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: D_M3_THR_W2TH_O_DDRDZ
INTEGER :: IKB, IKE
!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_THR_W2TH_O_DDRDZ',0,ZHOOK_HANDLE)
IKB = 1+JPVEXT_TURB
IKE = SIZE(PD,3)-JPVEXT_TURB
D_M3_THR_W2TH_O_DDRDZ(:,:,:) = - 0.75*PLM*PLEPS/PTKE * XCTV &
- * MZF( -(1.+PREDR1)*PREDR1*(1.5+PREDTH1+PREDR1)/PD**2 &
- +(1.+2.*PREDR1)/PD &
- )
+ * MZF(-(1.+PREDR1)*PREDR1*(1.5+PREDTH1+PREDR1)/PD**2 &
+ +(1.+2.*PREDR1)/PD, &
+ KKA, KKU, KKL)
!
D_M3_THR_W2TH_O_DDRDZ(:,:,IKB-1)=D_M3_THR_W2TH_O_DDRDZ(:,:,IKB)
D_M3_THR_W2TH_O_DDRDZ(:,:,IKE+1)=D_M3_THR_W2TH_O_DDRDZ(:,:,IKE)
!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_THR_W2TH_O_DDRDZ',1,ZHOOK_HANDLE)
END FUNCTION D_M3_THR_W2TH_O_DDRDZ
!----------------------------------------------------------------------------
!----------------------------------------------------------------------------
@@ -967,8 +1675,11 @@ FUNCTION PSI3(PREDR1,PREDTH1,PRED2R3,PRED2TH3,PRED2THR3,HTURBDIM,OUSERV)
LOGICAL, INTENT(IN) :: OUSERV ! flag to use vapor
REAL, DIMENSION(SIZE(PREDTH1,1),SIZE(PREDTH1,2),SIZE(PREDTH1,3)) :: PSI3
!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:PSI3',0,ZHOOK_HANDLE)
PSI3 = PHI3(PREDR1,PREDTH1,PRED2R3,PRED2TH3,PRED2THR3,HTURBDIM,OUSERV)
!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:PSI3',1,ZHOOK_HANDLE)
END FUNCTION PSI3
!----------------------------------------------------------------------------
FUNCTION D_PSI3DRDZ_O_DDRDZ(PPSI3,PREDR1,PREDTH1,PRED2R3,PRED2THR3,HTURBDIM,OUSERV)
@@ -981,10 +1692,13 @@ FUNCTION D_PSI3DRDZ_O_DDRDZ(PPSI3,PREDR1,PREDTH1,PRED2R3,PRED2THR3,HTURBDIM,OUSE
LOGICAL, INTENT(IN) :: OUSERV ! flag to use vapor
REAL, DIMENSION(SIZE(PREDTH1,1),SIZE(PREDTH1,2),SIZE(PREDTH1,3)) :: D_PSI3DRDZ_O_DDRDZ
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_PSI3DRDZ_O_DDRDZ',0,ZHOOK_HANDLE)
D_PSI3DRDZ_O_DDRDZ = D_PHI3DTDZ_O_DDTDZ(PPSI3,PREDR1,PREDTH1,PRED2R3,PRED2THR3,HTURBDIM,OUSERV)
!
!C'est ok?!
!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_PSI3DRDZ_O_DDRDZ',1,ZHOOK_HANDLE)
END FUNCTION D_PSI3DRDZ_O_DDRDZ
!----------------------------------------------------------------------------
FUNCTION D_PSI3DTDZ_O_DDTDZ(PPSI3,PREDR1,PREDTH1,PRED2R3,PRED2THR3,HTURBDIM,OUSERV)
@@ -997,8 +1711,11 @@ FUNCTION D_PSI3DTDZ_O_DDTDZ(PPSI3,PREDR1,PREDTH1,PRED2R3,PRED2THR3,HTURBDIM,OUSE
LOGICAL, INTENT(IN) :: OUSERV ! flag to use vapor
REAL, DIMENSION(SIZE(PREDTH1,1),SIZE(PREDTH1,2),SIZE(PREDTH1,3)) :: D_PSI3DTDZ_O_DDTDZ
!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_PSI3DTDZ_O_DDTDZ',0,ZHOOK_HANDLE)
D_PSI3DTDZ_O_DDTDZ = D_PHI3DRDZ_O_DDRDZ(PPSI3,PREDR1,PREDTH1,PRED2R3,PRED2THR3,HTURBDIM,OUSERV)
!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_PSI3DTDZ_O_DDTDZ',1,ZHOOK_HANDLE)
END FUNCTION D_PSI3DTDZ_O_DDTDZ
!----------------------------------------------------------------------------
FUNCTION D_PSI3DRDZ2_O_DDRDZ(PPSI3,PREDR1,PREDTH1,PRED2R3,PRED2THR3,PDRDZ,HTURBDIM,OUSERV)
@@ -1012,8 +1729,11 @@ FUNCTION D_PSI3DRDZ2_O_DDRDZ(PPSI3,PREDR1,PREDTH1,PRED2R3,PRED2THR3,PDRDZ,HTURBD
LOGICAL, INTENT(IN) :: OUSERV ! flag to use vapor
REAL, DIMENSION(SIZE(PREDTH1,1),SIZE(PREDTH1,2),SIZE(PREDTH1,3)) :: D_PSI3DRDZ2_O_DDRDZ
!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_PSI3DRDZ2_O_DDRDZ',0,ZHOOK_HANDLE)
D_PSI3DRDZ2_O_DDRDZ = D_PHI3DTDZ2_O_DDTDZ(PPSI3,PREDR1,PREDTH1,PRED2R3,PRED2THR3,PDRDZ,HTURBDIM,OUSERV)
!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_PSI3DRDZ2_O_DDRDZ',1,ZHOOK_HANDLE)
END FUNCTION D_PSI3DRDZ2_O_DDRDZ
!----------------------------------------------------------------------------
FUNCTION M3_WR_WR2(PREDR1,PREDTH1,PD,PBLL_O_E,PEMOIST)
@@ -1024,8 +1744,11 @@ FUNCTION M3_WR_WR2(PREDR1,PREDTH1,PD,PBLL_O_E,PEMOIST)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PEMOIST
REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: M3_WR_WR2
!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_WR_WR2',0,ZHOOK_HANDLE)
M3_WR_WR2 = M3_WTH_WTH2(PREDR1,PREDTH1,PD,PBLL_O_E,PEMOIST)
!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_WR_WR2',1,ZHOOK_HANDLE)
END FUNCTION M3_WR_WR2
!----------------------------------------------------------------------------
FUNCTION D_M3_WR_WR2_O_DDRDZ(PM3_WR_WR2,PREDR1,PREDTH1,PD,PBLL_O_E,PEMOIST)
@@ -1037,11 +1760,17 @@ FUNCTION D_M3_WR_WR2_O_DDRDZ(PM3_WR_WR2,PREDR1,PREDTH1,PD,PBLL_O_E,PEMOIST)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PEMOIST
REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: D_M3_WR_WR2_O_DDRDZ
!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_WR_WR2_O_DDRDZ',0,ZHOOK_HANDLE)
D_M3_WR_WR2_O_DDRDZ = D_M3_WTH_WTH2_O_DDTDZ(PM3_WR_WR2,PREDR1,PREDTH1,PD,PBLL_O_E,PEMOIST)
!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_WR_WR2_O_DDRDZ',1,ZHOOK_HANDLE)
END FUNCTION D_M3_WR_WR2_O_DDRDZ
!----------------------------------------------------------------------------
-FUNCTION M3_WR_W2R(PREDR1,PREDTH1,PD,PKEFF,PTKE)
+FUNCTION M3_WR_W2R(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PKEFF,PTKE)
+ INTEGER, INTENT(IN) :: KKA
+ INTEGER, INTENT(IN) :: KKU
+ INTEGER, INTENT(IN) :: KKL
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
@@ -1049,11 +1778,17 @@ FUNCTION M3_WR_W2R(PREDR1,PREDTH1,PD,PKEFF,PTKE)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKE
REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: M3_WR_W2R
!
-M3_WR_W2R = M3_WTH_W2TH(PREDR1,PREDTH1,PD,PKEFF,PTKE)
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_WR_W2R',0,ZHOOK_HANDLE)
+M3_WR_W2R = M3_WTH_W2TH(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PKEFF,PTKE)
!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_WR_W2R',1,ZHOOK_HANDLE)
END FUNCTION M3_WR_W2R
!----------------------------------------------------------------------------
-FUNCTION D_M3_WR_W2R_O_DDRDZ(PREDR1,PREDTH1,PD,PBLL_O_E,PEMOIST,PKEFF,PTKE)
+FUNCTION D_M3_WR_W2R_O_DDRDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PBLL_O_E,PEMOIST,PKEFF,PTKE)
+ INTEGER, INTENT(IN) :: KKA
+ INTEGER, INTENT(IN) :: KKU
+ INTEGER, INTENT(IN) :: KKL
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
@@ -1063,11 +1798,17 @@ FUNCTION D_M3_WR_W2R_O_DDRDZ(PREDR1,PREDTH1,PD,PBLL_O_E,PEMOIST,PKEFF,PTKE)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKE
REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: D_M3_WR_W2R_O_DDRDZ
!
-D_M3_WR_W2R_O_DDRDZ = D_M3_WTH_W2TH_O_DDTDZ(PREDR1,PREDTH1,PD,PBLL_O_E,PEMOIST,PKEFF,PTKE)
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_WR_W2R_O_DDRDZ',0,ZHOOK_HANDLE)
+D_M3_WR_W2R_O_DDRDZ = D_M3_WTH_W2TH_O_DDTDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PBLL_O_E,PEMOIST,PKEFF,PTKE)
!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_WR_W2R_O_DDRDZ',1,ZHOOK_HANDLE)
END FUNCTION D_M3_WR_W2R_O_DDRDZ
!----------------------------------------------------------------------------
-FUNCTION M3_WR_W2TH(PD,PKEFF,PTKE,PBLL_O_E,PETHETA,PDRDZ)
+FUNCTION M3_WR_W2TH(KKA,KKU,KKL,PD,PKEFF,PTKE,PBLL_O_E,PETHETA,PDRDZ)
+ INTEGER, INTENT(IN) :: KKA
+ INTEGER, INTENT(IN) :: KKU
+ INTEGER, INTENT(IN) :: KKL
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
REAL, DIMENSION(:,:,:), INTENT(IN) :: PKEFF
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKE
@@ -1076,11 +1817,17 @@ FUNCTION M3_WR_W2TH(PD,PKEFF,PTKE,PBLL_O_E,PETHETA,PDRDZ)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDRDZ
REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: M3_WR_W2TH
!
-M3_WR_W2TH = M3_WTH_W2R(PD,PKEFF,PTKE,PBLL_O_E,PETHETA,PDRDZ)
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_WR_W2TH',0,ZHOOK_HANDLE)
+M3_WR_W2TH = M3_WTH_W2R(KKA,KKU,KKL,PD,PKEFF,PTKE,PBLL_O_E,PETHETA,PDRDZ)
!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_WR_W2TH',1,ZHOOK_HANDLE)
END FUNCTION M3_WR_W2TH
!----------------------------------------------------------------------------
-FUNCTION D_M3_WR_W2TH_O_DDRDZ(PREDR1,PREDTH1,PD,PKEFF,PTKE,PBLL_O_E,PETHETA)
+FUNCTION D_M3_WR_W2TH_O_DDRDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PKEFF,PTKE,PBLL_O_E,PETHETA)
+ INTEGER, INTENT(IN) :: KKA
+ INTEGER, INTENT(IN) :: KKU
+ INTEGER, INTENT(IN) :: KKL
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
@@ -1090,11 +1837,17 @@ FUNCTION D_M3_WR_W2TH_O_DDRDZ(PREDR1,PREDTH1,PD,PKEFF,PTKE,PBLL_O_E,PETHETA)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PETHETA
REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: D_M3_WR_W2TH_O_DDRDZ
!
-D_M3_WR_W2TH_O_DDRDZ = D_M3_WTH_W2R_O_DDTDZ(PREDR1,PREDTH1,PD,PKEFF,PTKE,PBLL_O_E,PETHETA)
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_WR_W2TH_O_DDRDZ',0,ZHOOK_HANDLE)
+D_M3_WR_W2TH_O_DDRDZ = D_M3_WTH_W2R_O_DDTDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PKEFF,PTKE,PBLL_O_E,PETHETA)
!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_WR_W2TH_O_DDRDZ',1,ZHOOK_HANDLE)
END FUNCTION D_M3_WR_W2TH_O_DDRDZ
!----------------------------------------------------------------------------
-FUNCTION M3_WR_WTH2(PD,PKEFF,PTKE,PSQRT_TKE,PBLL_O_E,PBETA,PLEPS,PETHETA,PDRDZ)
+FUNCTION M3_WR_WTH2(KKA,KKU,KKL,PD,PKEFF,PTKE,PSQRT_TKE,PBLL_O_E,PBETA,PLEPS,PETHETA,PDRDZ)
+ INTEGER, INTENT(IN) :: KKA
+ INTEGER, INTENT(IN) :: KKU
+ INTEGER, INTENT(IN) :: KKL
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
REAL, DIMENSION(:,:,:), INTENT(IN) :: PKEFF
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKE
@@ -1106,11 +1859,17 @@ FUNCTION M3_WR_WTH2(PD,PKEFF,PTKE,PSQRT_TKE,PBLL_O_E,PBETA,PLEPS,PETHETA,PDRDZ)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDRDZ
REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: M3_WR_WTH2
!
-M3_WR_WTH2 = M3_WTH_WR2(PD,PKEFF,PTKE,PSQRT_TKE,PBLL_O_E,PBETA,PLEPS,PETHETA,PDRDZ)
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_WR_WTH2',0,ZHOOK_HANDLE)
+M3_WR_WTH2 = M3_WTH_WR2(KKA,KKU,KKL,PD,PKEFF,PTKE,PSQRT_TKE,PBLL_O_E,PBETA,PLEPS,PETHETA,PDRDZ)
!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_WR_WTH2',1,ZHOOK_HANDLE)
END FUNCTION M3_WR_WTH2
!----------------------------------------------------------------------------
-FUNCTION D_M3_WR_WTH2_O_DDRDZ(PREDR1,PREDTH1,PD,PKEFF,PTKE,PSQRT_TKE,PBLL_O_E,PBETA,PLEPS,PETHETA)
+FUNCTION D_M3_WR_WTH2_O_DDRDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PKEFF,PTKE,PSQRT_TKE,PBLL_O_E,PBETA,PLEPS,PETHETA)
+ INTEGER, INTENT(IN) :: KKA
+ INTEGER, INTENT(IN) :: KKU
+ INTEGER, INTENT(IN) :: KKL
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
@@ -1123,11 +1882,17 @@ FUNCTION D_M3_WR_WTH2_O_DDRDZ(PREDR1,PREDTH1,PD,PKEFF,PTKE,PSQRT_TKE,PBLL_O_E,PB
REAL, DIMENSION(:,:,:), INTENT(IN) :: PETHETA
REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: D_M3_WR_WTH2_O_DDRDZ
!
-D_M3_WR_WTH2_O_DDRDZ = D_M3_WTH_WR2_O_DDTDZ(PREDR1,PREDTH1,PD,PKEFF,PTKE,PSQRT_TKE,PBLL_O_E,PBETA,PLEPS,PETHETA)
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_WR_WTH2_O_DDRDZ',0,ZHOOK_HANDLE)
+D_M3_WR_WTH2_O_DDRDZ = D_M3_WTH_WR2_O_DDTDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PKEFF,PTKE,PSQRT_TKE,PBLL_O_E,PBETA,PLEPS,PETHETA)
!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_WR_WTH2_O_DDRDZ',1,ZHOOK_HANDLE)
END FUNCTION D_M3_WR_WTH2_O_DDRDZ
!----------------------------------------------------------------------------
-FUNCTION M3_WR_WTHR(PREDTH1,PD,PKEFF,PTKE,PSQRT_TKE,PBETA,PLEPS,PETHETA)
+FUNCTION M3_WR_WTHR(KKA,KKU,KKL,PREDTH1,PD,PKEFF,PTKE,PSQRT_TKE,PBETA,PLEPS,PETHETA)
+ INTEGER, INTENT(IN) :: KKA
+ INTEGER, INTENT(IN) :: KKU
+ INTEGER, INTENT(IN) :: KKL
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
REAL, DIMENSION(:,:,:), INTENT(IN) :: PKEFF
@@ -1138,11 +1903,17 @@ FUNCTION M3_WR_WTHR(PREDTH1,PD,PKEFF,PTKE,PSQRT_TKE,PBETA,PLEPS,PETHETA)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PETHETA
REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: M3_WR_WTHR
!
-M3_WR_WTHR = M3_WTH_WTHR(PREDTH1,PD,PKEFF,PTKE,PSQRT_TKE,PBETA,PLEPS,PETHETA)
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_WR_WTHR',0,ZHOOK_HANDLE)
+M3_WR_WTHR = M3_WTH_WTHR(KKA,KKU,KKL,PREDTH1,PD,PKEFF,PTKE,PSQRT_TKE,PBETA,PLEPS,PETHETA)
!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_WR_WTHR',1,ZHOOK_HANDLE)
END FUNCTION M3_WR_WTHR
!----------------------------------------------------------------------------
-FUNCTION D_M3_WR_WTHR_O_DDRDZ(PM3_WR_WTHR,PREDR1,PREDTH1,PD,PBLL_O_E,PEMOIST)
+FUNCTION D_M3_WR_WTHR_O_DDRDZ(KKA,KKU,KKL,PM3_WR_WTHR,PREDR1,PREDTH1,PD,PBLL_O_E,PEMOIST)
+ INTEGER, INTENT(IN) :: KKA
+ INTEGER, INTENT(IN) :: KKU
+ INTEGER, INTENT(IN) :: KKL
REAL, DIMENSION(:,:,:), INTENT(IN) :: PM3_WR_WTHR
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
@@ -1151,11 +1922,17 @@ FUNCTION D_M3_WR_WTHR_O_DDRDZ(PM3_WR_WTHR,PREDR1,PREDTH1,PD,PBLL_O_E,PEMOIST)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PEMOIST
REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: D_M3_WR_WTHR_O_DDRDZ
!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_WR_WTHR_O_DDRDZ',0,ZHOOK_HANDLE)
D_M3_WR_WTHR_O_DDRDZ = D_M3_WTH_WTHR_O_DDTDZ(PM3_WR_WTHR,PREDR1,PREDTH1,PD,PBLL_O_E,PEMOIST)
!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_WR_WTHR_O_DDRDZ',1,ZHOOK_HANDLE)
END FUNCTION D_M3_WR_WTHR_O_DDRDZ
!----------------------------------------------------------------------------
-FUNCTION M3_R2_W2R(PREDR1,PREDTH1,PD,PDRDZ,PLM,PLEPS,PTKE)
+FUNCTION M3_R2_W2R(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PDRDZ,PLM,PLEPS,PTKE)
+ INTEGER, INTENT(IN) :: KKA
+ INTEGER, INTENT(IN) :: KKU
+ INTEGER, INTENT(IN) :: KKL
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
@@ -1165,11 +1942,17 @@ FUNCTION M3_R2_W2R(PREDR1,PREDTH1,PD,PDRDZ,PLM,PLEPS,PTKE)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKE
REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: M3_R2_W2R
!
-M3_R2_W2R = M3_TH2_W2TH(PREDR1,PREDTH1,PD,PDRDZ,PLM,PLEPS,PTKE)
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_R2_W2R',0,ZHOOK_HANDLE)
+M3_R2_W2R = M3_TH2_W2TH(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PDRDZ,PLM,PLEPS,PTKE)
!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_R2_W2R',1,ZHOOK_HANDLE)
END FUNCTION M3_R2_W2R
!----------------------------------------------------------------------------
-FUNCTION D_M3_R2_W2R_O_DDRDZ(PREDR1,PREDTH1,PD,PLM,PLEPS,PTKE,OUSERV)
+FUNCTION D_M3_R2_W2R_O_DDRDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLM,PLEPS,PTKE,OUSERV)
+ INTEGER, INTENT(IN) :: KKA
+ INTEGER, INTENT(IN) :: KKU
+ INTEGER, INTENT(IN) :: KKL
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
@@ -1179,11 +1962,17 @@ FUNCTION D_M3_R2_W2R_O_DDRDZ(PREDR1,PREDTH1,PD,PLM,PLEPS,PTKE,OUSERV)
LOGICAL, INTENT(IN) :: OUSERV
REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: D_M3_R2_W2R_O_DDRDZ
!
-D_M3_R2_W2R_O_DDRDZ = D_M3_TH2_W2TH_O_DDTDZ(PREDR1,PREDTH1,PD,PLM,PLEPS,PTKE,OUSERV)
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_R2_W2R_O_DDRDZ',0,ZHOOK_HANDLE)
+D_M3_R2_W2R_O_DDRDZ = D_M3_TH2_W2TH_O_DDTDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLM,PLEPS,PTKE,OUSERV)
!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_R2_W2R_O_DDRDZ',1,ZHOOK_HANDLE)
END FUNCTION D_M3_R2_W2R_O_DDRDZ
!----------------------------------------------------------------------------
-FUNCTION M3_R2_WR2(PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE)
+FUNCTION M3_R2_WR2(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE)
+ INTEGER, INTENT(IN) :: KKA
+ INTEGER, INTENT(IN) :: KKU
+ INTEGER, INTENT(IN) :: KKL
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
@@ -1191,11 +1980,17 @@ FUNCTION M3_R2_WR2(PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PSQRT_TKE
REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: M3_R2_WR2
!
-M3_R2_WR2 = M3_TH2_WTH2(PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE)
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_R2_WR2',0,ZHOOK_HANDLE)
+M3_R2_WR2 = M3_TH2_WTH2(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE)
!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_R2_WR2',1,ZHOOK_HANDLE)
END FUNCTION M3_R2_WR2
!----------------------------------------------------------------------------
-FUNCTION D_M3_R2_WR2_O_DDRDZ(PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST)
+FUNCTION D_M3_R2_WR2_O_DDRDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST)
+ INTEGER, INTENT(IN) :: KKA
+ INTEGER, INTENT(IN) :: KKU
+ INTEGER, INTENT(IN) :: KKL
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
@@ -1205,11 +2000,17 @@ FUNCTION D_M3_R2_WR2_O_DDRDZ(PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PEMOIST
REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: D_M3_R2_WR2_O_DDRDZ
!
-D_M3_R2_WR2_O_DDRDZ = D_M3_TH2_WTH2_O_DDTDZ(PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST)
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_R2_WR2_O_DDRDZ',0,ZHOOK_HANDLE)
+D_M3_R2_WR2_O_DDRDZ = D_M3_TH2_WTH2_O_DDTDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST)
!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_R2_WR2_O_DDRDZ',1,ZHOOK_HANDLE)
END FUNCTION D_M3_R2_WR2_O_DDRDZ
!----------------------------------------------------------------------------
-FUNCTION M3_R2_W2TH(PD,PLM,PLEPS,PTKE,PBLL_O_E,PETHETA,PDRDZ)
+FUNCTION M3_R2_W2TH(KKA,KKU,KKL,PD,PLM,PLEPS,PTKE,PBLL_O_E,PETHETA,PDRDZ)
+ INTEGER, INTENT(IN) :: KKA
+ INTEGER, INTENT(IN) :: KKU
+ INTEGER, INTENT(IN) :: KKL
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
REAL, DIMENSION(:,:,:), INTENT(IN) :: PLM
REAL, DIMENSION(:,:,:), INTENT(IN) :: PLEPS
@@ -1219,11 +2020,17 @@ FUNCTION M3_R2_W2TH(PD,PLM,PLEPS,PTKE,PBLL_O_E,PETHETA,PDRDZ)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDRDZ
REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: M3_R2_W2TH
!
-M3_R2_W2TH = M3_TH2_W2R(PD,PLM,PLEPS,PTKE,PBLL_O_E,PETHETA,PDRDZ)
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_R2_W2TH',0,ZHOOK_HANDLE)
+M3_R2_W2TH = M3_TH2_W2R(KKA,KKU,KKL,PD,PLM,PLEPS,PTKE,PBLL_O_E,PETHETA,PDRDZ)
!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_R2_W2TH',1,ZHOOK_HANDLE)
END FUNCTION M3_R2_W2TH
!----------------------------------------------------------------------------
-FUNCTION D_M3_R2_W2TH_O_DDRDZ(PREDR1,PREDTH1,PD,PLM,PLEPS,PTKE,PBLL_O_E,PETHETA,PDRDZ)
+FUNCTION D_M3_R2_W2TH_O_DDRDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLM,PLEPS,PTKE,PBLL_O_E,PETHETA,PDRDZ)
+ INTEGER, INTENT(IN) :: KKA
+ INTEGER, INTENT(IN) :: KKU
+ INTEGER, INTENT(IN) :: KKL
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
@@ -1235,11 +2042,17 @@ FUNCTION D_M3_R2_W2TH_O_DDRDZ(PREDR1,PREDTH1,PD,PLM,PLEPS,PTKE,PBLL_O_E,PETHETA,
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDRDZ
REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: D_M3_R2_W2TH_O_DDRDZ
!
-D_M3_R2_W2TH_O_DDRDZ = D_M3_TH2_W2R_O_DDTDZ(PREDR1,PREDTH1,PD,PLM,PLEPS,PTKE,PBLL_O_E,PETHETA,PDRDZ)
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_R2_W2TH_O_DDRDZ',0,ZHOOK_HANDLE)
+D_M3_R2_W2TH_O_DDRDZ = D_M3_TH2_W2R_O_DDTDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLM,PLEPS,PTKE,PBLL_O_E,PETHETA,PDRDZ)
!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_R2_W2TH_O_DDRDZ',1,ZHOOK_HANDLE)
END FUNCTION D_M3_R2_W2TH_O_DDRDZ
!----------------------------------------------------------------------------
-FUNCTION M3_R2_WTH2(PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDRDZ)
+FUNCTION M3_R2_WTH2(KKA,KKU,KKL,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDRDZ)
+ INTEGER, INTENT(IN) :: KKA
+ INTEGER, INTENT(IN) :: KKU
+ INTEGER, INTENT(IN) :: KKL
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
REAL, DIMENSION(:,:,:), INTENT(IN) :: PLEPS
REAL, DIMENSION(:,:,:), INTENT(IN) :: PSQRT_TKE
@@ -1248,11 +2061,17 @@ FUNCTION M3_R2_WTH2(PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDRDZ)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDRDZ
REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: M3_R2_WTH2
!
-M3_R2_WTH2 = M3_TH2_WR2(PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDRDZ)
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_R2_WTH2',0,ZHOOK_HANDLE)
+M3_R2_WTH2 = M3_TH2_WR2(KKA,KKU,KKL,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDRDZ)
!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_R2_WTH2',1,ZHOOK_HANDLE)
END FUNCTION M3_R2_WTH2
!----------------------------------------------------------------------------
-FUNCTION D_M3_R2_WTH2_O_DDRDZ(PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDRDZ)
+FUNCTION D_M3_R2_WTH2_O_DDRDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDRDZ)
+ INTEGER, INTENT(IN) :: KKA
+ INTEGER, INTENT(IN) :: KKU
+ INTEGER, INTENT(IN) :: KKL
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
@@ -1263,11 +2082,17 @@ FUNCTION D_M3_R2_WTH2_O_DDRDZ(PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDRDZ
REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: D_M3_R2_WTH2_O_DDRDZ
!
-D_M3_R2_WTH2_O_DDRDZ = D_M3_TH2_WR2_O_DDTDZ(PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDRDZ)
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_R2_WTH2_O_DDRDZ',0,ZHOOK_HANDLE)
+D_M3_R2_WTH2_O_DDRDZ = D_M3_TH2_WR2_O_DDTDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDRDZ)
!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_R2_WTH2_O_DDRDZ',1,ZHOOK_HANDLE)
END FUNCTION D_M3_R2_WTH2_O_DDRDZ
!----------------------------------------------------------------------------
-FUNCTION M3_R2_WTHR(PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDRDZ)
+FUNCTION M3_R2_WTHR(KKA,KKU,KKL,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDRDZ)
+ INTEGER, INTENT(IN) :: KKA
+ INTEGER, INTENT(IN) :: KKU
+ INTEGER, INTENT(IN) :: KKL
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
REAL, DIMENSION(:,:,:), INTENT(IN) :: PLEPS
@@ -1277,11 +2102,17 @@ FUNCTION M3_R2_WTHR(PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDRDZ)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDRDZ
REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: M3_R2_WTHR
!
-M3_R2_WTHR = M3_TH2_WTHR(PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDRDZ)
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_R2_WTHR',0,ZHOOK_HANDLE)
+M3_R2_WTHR = M3_TH2_WTHR(KKA,KKU,KKL,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDRDZ)
!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_R2_WTHR',1,ZHOOK_HANDLE)
END FUNCTION M3_R2_WTHR
!----------------------------------------------------------------------------
-FUNCTION D_M3_R2_WTHR_O_DDRDZ(PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDRDZ)
+FUNCTION D_M3_R2_WTHR_O_DDRDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDRDZ)
+ INTEGER, INTENT(IN) :: KKA
+ INTEGER, INTENT(IN) :: KKU
+ INTEGER, INTENT(IN) :: KKL
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
@@ -1292,11 +2123,17 @@ FUNCTION D_M3_R2_WTHR_O_DDRDZ(PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDRDZ
REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: D_M3_R2_WTHR_O_DDRDZ
!
-D_M3_R2_WTHR_O_DDRDZ = D_M3_TH2_WTHR_O_DDTDZ(PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDRDZ)
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_R2_WTHR_O_DDRDZ',0,ZHOOK_HANDLE)
+D_M3_R2_WTHR_O_DDRDZ = D_M3_TH2_WTHR_O_DDTDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDRDZ)
!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_R2_WTHR_O_DDRDZ',1,ZHOOK_HANDLE)
END FUNCTION D_M3_R2_WTHR_O_DDRDZ
!----------------------------------------------------------------------------
-FUNCTION D_M3_THR_WTHR_O_DDRDZ(PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST)
+FUNCTION D_M3_THR_WTHR_O_DDRDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST)
+ INTEGER, INTENT(IN) :: KKA
+ INTEGER, INTENT(IN) :: KKU
+ INTEGER, INTENT(IN) :: KKL
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
@@ -1306,11 +2143,17 @@ FUNCTION D_M3_THR_WTHR_O_DDRDZ(PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIS
REAL, DIMENSION(:,:,:), INTENT(IN) :: PEMOIST
REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: D_M3_THR_WTHR_O_DDRDZ
!
-D_M3_THR_WTHR_O_DDRDZ = D_M3_THR_WTHR_O_DDTDZ(PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST)
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_THR_WTHR_O_DDRDZ',0,ZHOOK_HANDLE)
+D_M3_THR_WTHR_O_DDRDZ = D_M3_THR_WTHR_O_DDTDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST)
!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_THR_WTHR_O_DDRDZ',1,ZHOOK_HANDLE)
END FUNCTION D_M3_THR_WTHR_O_DDRDZ
!----------------------------------------------------------------------------
-FUNCTION M3_THR_WR2(PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PDTDZ)
+FUNCTION M3_THR_WR2(KKA,KKU,KKL,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PDTDZ)
+ INTEGER, INTENT(IN) :: KKA
+ INTEGER, INTENT(IN) :: KKU
+ INTEGER, INTENT(IN) :: KKL
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
REAL, DIMENSION(:,:,:), INTENT(IN) :: PLEPS
@@ -1320,11 +2163,17 @@ FUNCTION M3_THR_WR2(PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PDTDZ)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDTDZ
REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: M3_THR_WR2
!
-M3_THR_WR2 = M3_THR_WTH2(PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PDTDZ)
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_THR_WR2',0,ZHOOK_HANDLE)
+M3_THR_WR2 = M3_THR_WTH2(KKA,KKU,KKL,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PDTDZ)
!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_THR_WR2',1,ZHOOK_HANDLE)
END FUNCTION M3_THR_WR2
!----------------------------------------------------------------------------
-FUNCTION D_M3_THR_WR2_O_DDRDZ(PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PDTDZ)
+FUNCTION D_M3_THR_WR2_O_DDRDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PDTDZ)
+ INTEGER, INTENT(IN) :: KKA
+ INTEGER, INTENT(IN) :: KKU
+ INTEGER, INTENT(IN) :: KKL
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
@@ -1335,11 +2184,17 @@ FUNCTION D_M3_THR_WR2_O_DDRDZ(PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDTDZ
REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: D_M3_THR_WR2_O_DDRDZ
!
-D_M3_THR_WR2_O_DDRDZ = D_M3_THR_WTH2_O_DDTDZ(PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PDTDZ)
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_THR_WR2_O_DDRDZ',0,ZHOOK_HANDLE)
+D_M3_THR_WR2_O_DDRDZ = D_M3_THR_WTH2_O_DDTDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PDTDZ)
!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_THR_WR2_O_DDRDZ',1,ZHOOK_HANDLE)
END FUNCTION D_M3_THR_WR2_O_DDRDZ
!----------------------------------------------------------------------------
-FUNCTION D_M3_THR_WR2_O_DDTDZ(PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST)
+FUNCTION D_M3_THR_WR2_O_DDTDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST)
+ INTEGER, INTENT(IN) :: KKA
+ INTEGER, INTENT(IN) :: KKU
+ INTEGER, INTENT(IN) :: KKL
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
@@ -1349,11 +2204,17 @@ FUNCTION D_M3_THR_WR2_O_DDTDZ(PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST
REAL, DIMENSION(:,:,:), INTENT(IN) :: PEMOIST
REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: D_M3_THR_WR2_O_DDTDZ
!
-D_M3_THR_WR2_O_DDTDZ = D_M3_THR_WTH2_O_DDRDZ(PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST)
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_THR_WR2_O_DDTDZ',0,ZHOOK_HANDLE)
+D_M3_THR_WR2_O_DDTDZ = D_M3_THR_WTH2_O_DDRDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST)
!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_THR_WR2_O_DDTDZ',1,ZHOOK_HANDLE)
END FUNCTION D_M3_THR_WR2_O_DDTDZ
!----------------------------------------------------------------------------
-FUNCTION M3_THR_W2R(PREDTH1,PD,PLM,PLEPS,PTKE,PDTDZ)
+FUNCTION M3_THR_W2R(KKA,KKU,KKL,PREDTH1,PD,PLM,PLEPS,PTKE,PDTDZ)
+ INTEGER, INTENT(IN) :: KKA
+ INTEGER, INTENT(IN) :: KKU
+ INTEGER, INTENT(IN) :: KKL
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
REAL, DIMENSION(:,:,:), INTENT(IN) :: PLM
@@ -1362,11 +2223,17 @@ FUNCTION M3_THR_W2R(PREDTH1,PD,PLM,PLEPS,PTKE,PDTDZ)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDTDZ
REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: M3_THR_W2R
!
-M3_THR_W2R = M3_THR_W2TH(PREDTH1,PD,PLM,PLEPS,PTKE,PDTDZ)
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_THR_W2R',0,ZHOOK_HANDLE)
+M3_THR_W2R = M3_THR_W2TH(KKA,KKU,KKL,PREDTH1,PD,PLM,PLEPS,PTKE,PDTDZ)
!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_THR_W2R',1,ZHOOK_HANDLE)
END FUNCTION M3_THR_W2R
!----------------------------------------------------------------------------
-FUNCTION D_M3_THR_W2R_O_DDRDZ(PREDR1,PREDTH1,PD,PLM,PLEPS,PTKE,PBLL_O_E,PDTDZ,PEMOIST)
+FUNCTION D_M3_THR_W2R_O_DDRDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLM,PLEPS,PTKE,PBLL_O_E,PDTDZ,PEMOIST)
+ INTEGER, INTENT(IN) :: KKA
+ INTEGER, INTENT(IN) :: KKU
+ INTEGER, INTENT(IN) :: KKL
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
@@ -1378,11 +2245,17 @@ FUNCTION D_M3_THR_W2R_O_DDRDZ(PREDR1,PREDTH1,PD,PLM,PLEPS,PTKE,PBLL_O_E,PDTDZ,PE
REAL, DIMENSION(:,:,:), INTENT(IN) :: PEMOIST
REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: D_M3_THR_W2R_O_DDRDZ
!
-D_M3_THR_W2R_O_DDRDZ = D_M3_THR_W2TH_O_DDTDZ(PREDR1,PREDTH1,PD,PLM,PLEPS,PTKE,PBLL_O_E,PDTDZ,PEMOIST)
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_THR_W2R_O_DDRDZ',0,ZHOOK_HANDLE)
+D_M3_THR_W2R_O_DDRDZ = D_M3_THR_W2TH_O_DDTDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLM,PLEPS,PTKE,PBLL_O_E,PDTDZ,PEMOIST)
!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_THR_W2R_O_DDRDZ',1,ZHOOK_HANDLE)
END FUNCTION D_M3_THR_W2R_O_DDRDZ
!----------------------------------------------------------------------------
-FUNCTION D_M3_THR_W2R_O_DDTDZ(PREDR1,PREDTH1,PD,PLM,PLEPS,PTKE)
+FUNCTION D_M3_THR_W2R_O_DDTDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLM,PLEPS,PTKE)
+ INTEGER, INTENT(IN) :: KKA
+ INTEGER, INTENT(IN) :: KKU
+ INTEGER, INTENT(IN) :: KKL
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
@@ -1391,9 +2264,13 @@ FUNCTION D_M3_THR_W2R_O_DDTDZ(PREDR1,PREDTH1,PD,PLM,PLEPS,PTKE)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKE
REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: D_M3_THR_W2R_O_DDTDZ
!
-D_M3_THR_W2R_O_DDTDZ = D_M3_THR_W2TH_O_DDRDZ(PREDR1,PREDTH1,PD,PLM,PLEPS,PTKE)
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_THR_W2R_O_DDTDZ',0,ZHOOK_HANDLE)
+D_M3_THR_W2R_O_DDTDZ = D_M3_THR_W2TH_O_DDRDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLM,PLEPS,PTKE)
!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_THR_W2R_O_DDTDZ',1,ZHOOK_HANDLE)
END FUNCTION D_M3_THR_W2R_O_DDTDZ
!----------------------------------------------------------------------------
!
END MODULE MODE_PRANDTL
+
diff --git a/src/mesonh/turb/mode_turb_ver_dyn_flux.f90 b/src/mesonh/turb/mode_turb_ver_dyn_flux.f90
index 4473628de..f103db1a7 100644
--- a/src/mesonh/turb/mode_turb_ver_dyn_flux.f90
+++ b/src/mesonh/turb/mode_turb_ver_dyn_flux.f90
@@ -543,7 +543,7 @@ IF(HTURBDIM=='3DIM') THEN
CALL SECOND_MNH(ZTIME1)
CALL LES_MEAN_SUBGRID(MZF(MXF(GX_W_UW(PWM,PDXX,&
PDZZ,PDZX, KKA, KKU, KKL)*ZFLXZ), KKA, KKU, KKL), X_LES_RES_ddxa_W_SBG_UaW )
- CALL LES_MEAN_SUBGRID(MXF(GX_M_U(PTHLM,PDXX,PDZZ,PDZX, KKA, KKU, KKL)&
+ CALL LES_MEAN_SUBGRID(MXF(GX_M_U(KKA, KKU, KKL,PTHLM,PDXX,PDZZ,PDZX)&
* MZF(ZFLXZ, KKA, KKU, KKL)), X_LES_RES_ddxa_Thl_SBG_UaW )
IF (KRR>=1) THEN
CALL LES_MEAN_SUBGRID(MXF(GX_U_M(PRM(:,:,:,1),PDXX,PDZZ,PDZX, KKA, KKU, KKL)&
@@ -723,7 +723,7 @@ IF(HTURBDIM=='3DIM') THEN
CALL LES_MEAN_SUBGRID(MZF(MYF(GY_W_VW(PWM,PDYY,&
&PDZZ,PDZY, KKA, KKU, KKL)*ZFLXZ), KKA, KKU, KKL), &
&X_LES_RES_ddxa_W_SBG_UaW , .TRUE. )
- CALL LES_MEAN_SUBGRID(MYF(GY_M_V(PTHLM,PDYY,PDZZ,PDZY, KKA, KKU, KKL)*&
+ CALL LES_MEAN_SUBGRID(MYF(GY_M_V(KKA, KKU, KKL,PTHLM,PDYY,PDZZ,PDZY)*&
&MZF(ZFLXZ, KKA, KKU, KKL)), &
&X_LES_RES_ddxa_Thl_SBG_UaW , .TRUE. )
IF (KRR>=1) THEN
diff --git a/src/mesonh/turb/mode_turb_ver_sv_corr.f90 b/src/mesonh/turb/mode_turb_ver_sv_corr.f90
index f140c0792..786bcfdcc 100644
--- a/src/mesonh/turb/mode_turb_ver_sv_corr.f90
+++ b/src/mesonh/turb/mode_turb_ver_sv_corr.f90
@@ -138,7 +138,7 @@ DO JSV=1,NSV
!
IF (LLES_CALL) THEN
! approximation: diagnosed explicitely (without implicit term)
- ZFLXZ(:,:,:) = PPSI_SV(:,:,:,JSV)*GZ_M_W(PSVM(:,:,:,JSV),PDZZ, KKA, KKU, KKL)**2
+ ZFLXZ(:,:,:) = PPSI_SV(:,:,:,JSV)*GZ_M_W(KKA, KKU, KKL,PSVM(:,:,:,JSV),PDZZ)**2
ZFLXZ(:,:,:) = XCHF / ZCSVD * PLM * PLEPS * MZF(ZFLXZ(:,:,:), KKA, KKU, KKL)
CALL LES_MEAN_SUBGRID(-2.*ZCSVD*SQRT(PTKEM)*ZFLXZ/PLEPS, X_LES_SUBGRID_DISS_Sv2(:,:,:,JSV) )
CALL LES_MEAN_SUBGRID(MZF(PWM, KKA, KKU, KKL)*ZFLXZ, X_LES_RES_W_SBG_Sv2(:,:,:,JSV) )
@@ -150,8 +150,8 @@ DO JSV=1,NSV
! approximation: diagnosed explicitely (without implicit term)
ZA(:,:,:) = ETHETA(KRR,KRRI,PTHLM,PRM,PLOCPEXNM,PATHETA,PSRCM)
ZFLXZ(:,:,:)= ( XCSHF * PPHI3 + XCHF * PPSI_SV(:,:,:,JSV) ) &
- * GZ_M_W(PTHLM,PDZZ, KKA, KKU, KKL) &
- * GZ_M_W(PSVM(:,:,:,JSV),PDZZ, KKA, KKU, KKL)
+ * GZ_M_W(KKA, KKU, KKL,PTHLM,PDZZ) &
+ * GZ_M_W(KKA, KKU, KKL,PSVM(:,:,:,JSV),PDZZ)
ZFLXZ(:,:,:)= PLM * PLEPS / (2.*ZCTSVD) * MZF(ZFLXZ, KKA, KKU, KKL)
CALL LES_MEAN_SUBGRID( ZA*ZFLXZ, X_LES_SUBGRID_SvThv(:,:,:,JSV) )
CALL LES_MEAN_SUBGRID( -XG/PTHVREF/3.*ZA*ZFLXZ, X_LES_SUBGRID_SvPz(:,:,:,JSV), .TRUE.)
@@ -159,8 +159,8 @@ DO JSV=1,NSV
IF (KRR>=1) THEN
ZA(:,:,:) = EMOIST(KRR,KRRI,PTHLM,PRM,PLOCPEXNM,PAMOIST,PSRCM)
ZFLXZ(:,:,:)= ( XCHF * PPSI3 + XCHF * PPSI_SV(:,:,:,JSV) ) &
- * GZ_M_W(PRM(:,:,:,1),PDZZ, KKA, KKU, KKL) &
- * GZ_M_W(PSVM(:,:,:,JSV),PDZZ, KKA, KKU, KKL)
+ * GZ_M_W(KKA, KKU, KKL,PRM(:,:,:,1),PDZZ) &
+ * GZ_M_W(KKA, KKU, KKL,PSVM(:,:,:,JSV),PDZZ)
ZFLXZ(:,:,:)= PLM * PLEPS / (2.*ZCQSVD) * MZF(ZFLXZ, KKA, KKU, KKL)
CALL LES_MEAN_SUBGRID( ZA*ZFLXZ, X_LES_SUBGRID_SvThv(:,:,:,JSV) , .TRUE.)
CALL LES_MEAN_SUBGRID( -XG/PTHVREF/3.*ZA*ZFLXZ, X_LES_SUBGRID_SvPz(:,:,:,JSV), .TRUE.)
diff --git a/src/mesonh/turb/mode_turb_ver_sv_flux.f90 b/src/mesonh/turb/mode_turb_ver_sv_flux.f90
index 9ef220cf8..ada376d53 100644
--- a/src/mesonh/turb/mode_turb_ver_sv_flux.f90
+++ b/src/mesonh/turb/mode_turb_ver_sv_flux.f90
@@ -429,7 +429,7 @@ ENDIF
CALL LES_MEAN_SUBGRID(MZF(ZFLXZ, KKA, KKU, KKL), X_LES_SUBGRID_WSv(:,:,:,JSV) )
CALL LES_MEAN_SUBGRID(GZ_W_M(PWM,PDZZ, KKA, KKU, KKL)*MZF(ZFLXZ, KKA, KKU, KKL), &
X_LES_RES_ddxa_W_SBG_UaSv(:,:,:,JSV) )
- CALL LES_MEAN_SUBGRID(MZF(GZ_M_W(PSVM(:,:,:,JSV),PDZZ, KKA, KKU, KKL)*ZFLXZ, KKA, KKU, KKL), &
+ CALL LES_MEAN_SUBGRID(MZF(GZ_M_W(KKA, KKU, KKL,PSVM(:,:,:,JSV),PDZZ)*ZFLXZ, KKA, KKU, KKL), &
X_LES_RES_ddxa_Sv_SBG_UaSv(:,:,:,JSV) )
CALL LES_MEAN_SUBGRID(-ZCSVP*SQRT(PTKEM)/PLM*MZF(ZFLXZ, KKA, KKU, KKL), X_LES_SUBGRID_SvPz(:,:,:,JSV) )
CALL LES_MEAN_SUBGRID(MZF(PWM*ZFLXZ, KKA, KKU, KKL), X_LES_RES_W_SBG_WSv(:,:,:,JSV) )
diff --git a/src/mesonh/turb/mode_turb_ver_thermo_corr.f90 b/src/mesonh/turb/mode_turb_ver_thermo_corr.f90
index 3d420f393..7913b4e6a 100644
--- a/src/mesonh/turb/mode_turb_ver_thermo_corr.f90
+++ b/src/mesonh/turb/mode_turb_ver_thermo_corr.f90
@@ -852,8 +852,12 @@ ENDIF
! Extrapolate PSIGS at the ground and at the top
PSIGS(:,:,KKA) = PSIGS(:,:,IKB)
PSIGS(:,:,KKU) = PSIGS(:,:,IKE)
- PSIGS(:,:,:) = MAX (PSIGS(:,:,:) , 0.)
+#ifdef REPRO48
+ PSIGS(:,:,:) = MAX (PSIGS(:,:,:) , 0.)
PSIGS(:,:,:) = SQRT(PSIGS(:,:,:))
+#else
+ PSIGS(:,:,:) = SQRT( MAX (PSIGS(:,:,:) , 1.E-12) )
+#endif
END IF
!
diff --git a/src/mesonh/turb/mode_turb_ver_thermo_flux.f90 b/src/mesonh/turb/mode_turb_ver_thermo_flux.f90
index 7a79162a4..f96471652 100644
--- a/src/mesonh/turb/mode_turb_ver_thermo_flux.f90
+++ b/src/mesonh/turb/mode_turb_ver_thermo_flux.f90
@@ -466,7 +466,7 @@ END IF
!
! d(w'2r')/dz
IF (GFWR) THEN
- ZF = ZF + M3_WTH_W2R(KKA,KKU,KKL,PREDTH1,PREDR1,PD,ZKEFF,&
+ ZF = ZF + M3_WTH_W2R(KKA,KKU,KKL,PD,ZKEFF,&
& PTKEM,PBLL_O_E,PEMOIST,PDTH_DZ) * PFWR
ZDFDDTDZ = ZDFDDTDZ + D_M3_WTH_W2R_O_DDTDZ(KKA,KKU,KKL,PREDTH1,PREDR1,&
& PD,ZKEFF,PTKEM,PBLL_O_E,PEMOIST) * PFWR
@@ -474,7 +474,7 @@ END IF
!
! d(w'r'2)/dz
IF (GFR2) THEN
- ZF = ZF + M3_WTH_WR2(KKA,KKU,KKL,PREDTH1,PREDR1,PD,ZKEFF,PTKEM,&
+ ZF = ZF + M3_WTH_WR2(KKA,KKU,KKL,PD,ZKEFF,PTKEM,&
& PSQRT_TKE,PBLL_O_E,PBETA,PLEPS,PEMOIST,PDTH_DZ) * MZM(PFR2, KKA, KKU, KKL)
ZDFDDTDZ = ZDFDDTDZ + D_M3_WTH_WR2_O_DDTDZ(KKA,KKU,KKL,PREDTH1,PREDR1,PD,&
& ZKEFF,PTKEM,PSQRT_TKE,PBLL_O_E,PBETA,PLEPS,PEMOIST) * MZM(PFR2, KKA, KKU, KKL)
@@ -505,6 +505,9 @@ ELSE
* 0.5 * (1. + PRHODJ(:,:,KKA) / PRHODJ(:,:,IKB))
END IF
!
+#ifdef REPRO55
+ZF(:,:,IKE)=0.
+#endif
! Compute the splitted conservative potential temperature at t+deltat
CALL TRIDIAG_THERMO(KKA,KKU,KKL,PTHLM,ZF,ZDFDDTDZ,PTSTEP,PIMPL,PDZZ,&
PRHODJ,PTHLP)
@@ -559,20 +562,22 @@ PWTHV = MZM(PETHETA, KKA, KKU, KKL) * ZFLXZ
PWTHV(:,:,IKB) = PETHETA(:,:,IKB) * ZFLXZ(:,:,IKB)
!
!* 2.3 Partial vertical divergence of the < Rc w > flux
-! Correction for qc and qi negative in AROME
-!IF ( KRRL >= 1 ) THEN
-! IF ( KRRI >= 1 ) THEN
-! PRRS(:,:,:,2) = PRRS(:,:,:,2) - &
-! DZF(MZM(PRHODJ*PATHETA*2.*PSRCM, KKA, KKU, KKL)*ZFLXZ/PDZZ, KKA, KKU, KKL) &
-! *(1.0-PFRAC_ICE(:,:,:))
-! PRRS(:,:,:,4) = PRRS(:,:,:,4) - &
-! DZF(MZM(PRHODJ*PATHETA*2.*PSRCM, KKA, KKU, KKL)*ZFLXZ/PDZZ, KKA, KKU, KKL) &
-! *PFRAC_ICE(:,:,:)
-! ELSE
-! PRRS(:,:,:,2) = PRRS(:,:,:,2) - &
-! DZF(MZM(PRHODJ*PATHETA*2.*PSRCM, KKA, KKU, KKL)*ZFLXZ/PDZZ, KKA, KKU, KKL)
-! END IF
-!END IF
+!
+#ifdef REPRO55
+IF ( KRRL >= 1 ) THEN
+ IF ( KRRI >= 1 ) THEN
+ PRRS(:,:,:,2) = PRRS(:,:,:,2) - &
+ PRHODJ*PATHETA*2.*PSRCM*DZF(ZFLXZ/PDZZ, KKA, KKU, KKL) &
+ *(1.0-PFRAC_ICE(:,:,:))
+ PRRS(:,:,:,4) = PRRS(:,:,:,4) - &
+ PRHODJ*PATHETA*2.*PSRCM*DZF(ZFLXZ/PDZZ, KKA, KKU, KKL) &
+ *PFRAC_ICE(:,:,:)
+ ELSE
+ PRRS(:,:,:,2) = PRRS(:,:,:,2) - &
+ PRHODJ*PATHETA*2.*PSRCM*DZF(ZFLXZ/PDZZ, KKA, KKU, KKL)
+ END IF
+END IF
+#endif
!
!* 2.4 Storage in LES configuration
!
@@ -648,7 +653,7 @@ IF (KRR /= 0) THEN
!
! d(w'2th')/dz
IF (GFWTH) THEN
- ZF = ZF + M3_WR_W2TH(KKA,KKU,KKL,PREDR1,PREDTH1,PD,ZKEFF,&
+ ZF = ZF + M3_WR_W2TH(KKA,KKU,KKL,PD,ZKEFF,&
& PTKEM,PBLL_O_E,PETHETA,PDR_DZ) * PFWTH
ZDFDDRDZ = ZDFDDRDZ + D_M3_WR_W2TH_O_DDRDZ(KKA,KKU,KKL,PREDR1,PREDTH1,&
& PD,ZKEFF,PTKEM,PBLL_O_E,PETHETA) * PFWTH
@@ -656,7 +661,7 @@ IF (KRR /= 0) THEN
!
! d(w'th'2)/dz
IF (GFTH2) THEN
- ZF = ZF + M3_WR_WTH2(KKA,KKU,KKL,PREDR1,PREDTH1,PD,ZKEFF,PTKEM,&
+ ZF = ZF + M3_WR_WTH2(KKA,KKU,KKL,PD,ZKEFF,PTKEM,&
& PSQRT_TKE,PBLL_O_E,PBETA,PLEPS,PETHETA,PDR_DZ) * MZM(PFTH2, KKA, KKU, KKL)
ZDFDDRDZ = ZDFDDRDZ + D_M3_WR_WTH2_O_DDRDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,&
&ZKEFF,PTKEM,PSQRT_TKE,PBLL_O_E,PBETA,PLEPS,PETHETA) * MZM(PFTH2, KKA, KKU, KKL)
@@ -687,6 +692,9 @@ IF (KRR /= 0) THEN
* 0.5 * (1. + PRHODJ(:,:,KKA) / PRHODJ(:,:,IKB))
END IF
!
+#ifdef REPRO55
+ ZF(:,:,IKE)=0.
+#endif
! Compute the splitted conservative potential temperature at t+deltat
CALL TRIDIAG_THERMO(KKA,KKU,KKL,PRM(:,:,:,1),ZF,ZDFDDRDZ,PTSTEP,PIMPL,&
PDZZ,PRHODJ,PRP)
@@ -739,20 +747,22 @@ IF (KRR /= 0) THEN
PWTHV(:,:,IKB) = PWTHV(:,:,IKB) + PEMOIST(:,:,IKB) * ZFLXZ(:,:,IKB)
!
!* 3.3 Complete vertical divergence of the < Rc w > flux
-! Correction of qc and qi negative for AROME
-! IF ( KRRL >= 1 ) THEN
-! IF ( KRRI >= 1 ) THEN
-! PRRS(:,:,:,2) = PRRS(:,:,:,2) - &
-! DZF(MZM(PRHODJ*PAMOIST*2.*PSRCM, KKA, KKU, KKL)*ZFLXZ/PDZZ, KKA, KKU, KKL) &
-! *(1.0-PFRAC_ICE(:,:,:))
-! PRRS(:,:,:,4) = PRRS(:,:,:,4) - &
-! DZF(MZM(PRHODJ*PAMOIST*2.*PSRCM, KKA, KKU, KKL)*ZFLXZ/PDZZ, KKA, KKU, KKL) &
-! *PFRAC_ICE(:,:,:)
-! ELSE
-! PRRS(:,:,:,2) = PRRS(:,:,:,2) - &
-! DZF(MZM(PRHODJ*PAMOIST*2.*PSRCM, KKA, KKU, KKL)*ZFLXZ/PDZZ, KKA, KKU, KKL)
-! END IF
-! END IF
+!
+#ifdef REPRO55
+ IF ( KRRL >= 1 ) THEN
+ IF ( KRRI >= 1 ) THEN
+ PRRS(:,:,:,2) = PRRS(:,:,:,2) - &
+ PRHODJ*PAMOIST*2.*PSRCM*DZF(ZFLXZ/PDZZ, KKA, KKU, KKL ) &
+ *(1.0-PFRAC_ICE(:,:,:))
+ PRRS(:,:,:,4) = PRRS(:,:,:,4) - &
+ PRHODJ*PAMOIST*2.*PSRCM*DZF(ZFLXZ/PDZZ, KKA, KKU, KKL ) &
+ *PFRAC_ICE(:,:,:)
+ ELSE
+ PRRS(:,:,:,2) = PRRS(:,:,:,2) - &
+ PRHODJ*PAMOIST*2.*PSRCM*DZF(ZFLXZ/PDZZ, KKA, KKU, KKL )
+ END IF
+ END IF
+#endif
!
!* 3.4 Storage in LES configuration
!
diff --git a/src/mesonh/turb/prandtl.f90 b/src/mesonh/turb/prandtl.f90
deleted file mode 100644
index 9b8455f87..000000000
--- a/src/mesonh/turb/prandtl.f90
+++ /dev/null
@@ -1,611 +0,0 @@
-!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier
-!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!MNH_LIC for details. version 1.
-!-----------------------------------------------------------------
-! ###################
- MODULE MODI_PRANDTL
-! ###################
-!
-INTERFACE
-!
- SUBROUTINE PRANDTL(KKA,KKU,KKL,KRR,KRRI,OTURB_DIAG, &
- HTURBDIM, &
- TPFILE, &
- PDXX,PDYY,PDZZ,PDZX,PDZY, &
- PTHVREF,PLOCPEXNM,PATHETA,PAMOIST, &
- PLM,PLEPS,PTKEM,PTHLM,PRM,PSVM,PSRCM, &
- PREDTH1,PREDR1, &
- PRED2TH3, PRED2R3, PRED2THR3, &
- PREDS1,PRED2THS3, PRED2RS3, &
- PBLL_O_E, &
- PETHETA, PEMOIST )
-!
-!
-USE MODD_IO, ONLY: TFILEDATA
-!
-INTEGER, INTENT(IN) :: KKA !near ground array index
-INTEGER, INTENT(IN) :: KKU !uppest atmosphere array index
-INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=ARO
-INTEGER, INTENT(IN) :: KRR ! number of moist var.
-INTEGER, INTENT(IN) :: KRRI ! number of ice var.
-!
-LOGICAL, INTENT(IN) :: OTURB_DIAG ! switch to write some
- ! diagnostic fields in the syncronous FM-file
-CHARACTER(len=4), INTENT(IN) :: HTURBDIM ! Kind of turbulence param.
-TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX,PDYY,PDZZ,PDZX,PDZY
- ! metric coefficients
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHVREF ! Virtual Potential Temp.
- ! of the reference state
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLOCPEXNM ! Lv(T)/Cp/Exner at t-1
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PATHETA ! coefficients between
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PAMOIST ! s and Thetal and Rnp
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLM ! Turbulent Mixing length
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLEPS ! Dissipative length
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHLM,PTKEM! Conservative Potential
- ! Temperature and TKE at t-1
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRM ! Mixing ratios at t-1
- ! with PRM(:,:,:,1) = cons.
- ! mixing ratio
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVM ! Scalars at t-1
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRCM
- ! s'r'c/2Sigma_s2 at t-1 multiplied by Lambda_3
-!
-!
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PREDTH1 ! Redelsperger number R_theta
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PREDR1 ! Redelsperger number R_q
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRED2TH3 ! Redelsperger number R*2_theta
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRED2R3 ! Redelsperger number R*2_q
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRED2THR3! Redelsperger number R*2_thq
-REAL, DIMENSION(:,:,:,:), INTENT(OUT):: PREDS1 ! Redelsperger number R_sv
-REAL, DIMENSION(:,:,:,:), INTENT(OUT):: PRED2THS3! Redelsperger number R*2_thsv
-REAL, DIMENSION(:,:,:,:), INTENT(OUT):: PRED2RS3 ! Redelsperger number R*2_qsv
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PBLL_O_E! beta*Lk*Leps/tke
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PETHETA ! coefficient E_theta
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PEMOIST ! coefficient E_moist
-!
-END SUBROUTINE PRANDTL
-!
-END INTERFACE
-!
-END MODULE MODI_PRANDTL
-!
-!
-!
-! ###########################################################
- SUBROUTINE PRANDTL(KKA,KKU,KKL,KRR,KRRI,OTURB_DIAG, &
- HTURBDIM, &
- TPFILE, &
- PDXX,PDYY,PDZZ,PDZX,PDZY, &
- PTHVREF,PLOCPEXNM,PATHETA,PAMOIST, &
- PLM,PLEPS,PTKEM,PTHLM,PRM,PSVM,PSRCM, &
- PREDTH1,PREDR1, &
- PRED2TH3, PRED2R3, PRED2THR3, &
- PREDS1,PRED2THS3, PRED2RS3, &
- PBLL_O_E, &
- PETHETA, PEMOIST )
-! ###########################################################
-!
-!
-!!**** *PRANDTL* - routine to compute the Prandtl turbulent numbers
-!!
-!! PURPOSE
-!! -------
-! The purpose of this routine is to compute the Redelsperger
-! numbers and then get the turbulent Prandtl and Schmidt numbers:
-! * for the heat fluxes - PHI3 = 1/ Prandtl
-! * for the moisture fluxes - PSI3 = 1/ Schmidt
-!
-!!** METHOD
-!! ------
-!! The following steps are performed:
-!!
-!! 1 - default values of 1 are taken for phi3 and psi3 and different masks
-!! are defined depending on the presence of turbulence, stratification and
-!! humidity. The 1D Redelsperger numbers are computed
-!! * ZREDTH1 : (g / THVREF ) (LT**2 / TKE ) ETHETA (D Theta / Dz)
-!! * ZREDR1 : (g / THVREF ) (LT**2 / TKE ) EMOIST (D TW / Dz)
-!! 2 - 3D Redelsperger numbers are computed only for turbulent
-!! grid points where ZREDTH1 or ZREDR1 are > 0.
-!! 3 - PHI3 is computed only for turbulent grid points where ZREDTH1 > 0
-!! (turbulent thermally stratified points)
-!! 4 - PSI3 is computed only for turbulent grid points where ZREDR1 > 0
-!! (turbulent moist points)
-!!
-!!
-!! EXTERNAL
-!! --------
-!! FUNCTIONs ETHETA and EMOIST :
-!! allows to compute the coefficients
-!! for the turbulent correlation between any variable
-!! and the virtual potential temperature, of its correlations
-!! with the conservative potential temperature and the humidity
-!! conservative variable:
-!! ------- ------- -------
-!! A' Thv' = ETHETA A' Thl' + EMOIST A' Rnp'
-!!
-!! GX_M_M, GY_M_M, GZ_M_M : Cartesian gradient operators
-!! MZM : Shuman function (mean operator in the z direction)
-!! Module MODI_ETHETA : interface module for ETHETA
-!! Module MODI_EMOIST : interface module for EMOIST
-!! Module MODI_SHUMAN : interface module for Shuman operators
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!! Module MODD_CST : contains physical constants
-!! XG : gravity constant
-!!
-!! Module MODD_CTURB: contains the set of constants for
-!! the turbulence scheme
-!! XCTV,XCPR2 : constants for the turbulent prandtl numbers
-!! XTKEMIN : minimum value allowed for the TKE
-!!
-!! Module MODD_PARAMETERS
-!! JPVEXT_TURB : number of vertical marginal points
-!!
-!! REFERENCE
-!! ---------
-!! Book 2 of documentation (routine PRANDTL)
-!! Book 1 of documentation (Chapter: Turbulence)
-!!
-!! AUTHOR
-!! ------
-!! Joan Cuxart * INM and Meteo-France *
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 18/10/94
-!! Modifications: Feb 14, 1995 (J.Cuxart and J.Stein)
-!! Doctorization and Optimization
-!! Modifications: March 21, 1995 (J.M. Carriere)
-!! Introduction of cloud water
-!! Modifications: March 21, 1995 (J. Cuxart and J.Stein)
-!! Phi3 and Psi3 at w point + cleaning
-!! Modifications: July 2, 1995 (J.Cuxart and Ph.Bougeault)
-!! change the value of Phi3 and Psi3 if negative
-!! Modifications: Sept 20, 1995 (J. Stein, J. Cuxart, J.L. Redelsperger)
-!! remove the Where + use REDTH1+REDR1 for the tests
-!! Modifications: October 10, 1995 (J. Cuxart and J.Stein)
-!! Psi3 for tPREDS1he scalar variables
-!! Modifications: February 27, 1996 (J.Stein) optimization
-!! Modifications: June 15, 1996 (P.Jabouille) return to the previous
-!! computation of Phi3 and Psi3
-!! Modifications: October 10, 1996 (J. Stein) change the temporal
-!! discretization
-!! Modifications: May 23, 1997 (J. Stein) bug in 3D Redels number at ground
-!! with orography
-!! Modifications: Feb 20, 1998 (J. Stein) bug in all the 3D cases due to
-!! the use of ZW1 instead of ZW2
-!! Feb 20, 2003 (JP Pinty) Add PFRAC_ICE
-!! July 2005 (Tomas, Masson) implicitation of PHI3 and PSI3
-!! October 2009 (G. Tanguy) add ILENCH=LEN(YCOMMENT) after
-!! change of YCOMMENT
-!! 2012-02 Y. Seity, add possibility to run with reversed
-!! vertical levels
-!! Modifications: July 2015 (Wim de Rooy) LHARAT (Racmo turbulence) switch
-!! 2017-09 J.Escobar, use epsilon XMNH_TINY_12 for R*4
-!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
-!! JL Redelsperger 03/2021 : adding Ocean case for temperature only
-!! --------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_CST
-USE MODD_CONF
-USE MODD_CTURB
-USE MODD_DYN_n, ONLY: LOCEAN
-use modd_field, only: tfielddata, TYPEREAL
-USE MODD_IO, ONLY: TFILEDATA
-USE MODD_PARAMETERS
-!
-USE MODI_GRADIENT_M
-USE MODI_EMOIST
-USE MODI_ETHETA
-USE MODI_SHUMAN
-USE MODE_IO_FIELD_WRITE, only: IO_Field_write
-!
-IMPLICIT NONE
-!
-!
-!* 0.1 declarations of arguments
-!
-INTEGER, INTENT(IN) :: KKA !near ground array index
-INTEGER, INTENT(IN) :: KKU !uppest atmosphere array index
-INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=ARO
-
-INTEGER, INTENT(IN) :: KRR ! number of moist var.
-INTEGER, INTENT(IN) :: KRRI ! number of ice var.
-!
-LOGICAL, INTENT(IN) :: OTURB_DIAG ! switch to write some
- ! diagnostic fields in the syncronous FM-file
-CHARACTER(LEN=4), INTENT(IN) :: HTURBDIM ! Kind of turbulence param.
-TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX,PDYY,PDZZ,PDZX,PDZY
- ! metric coefficients
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHVREF ! Virtual Potential Temp.
- ! of the reference state
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLOCPEXNM ! Lv(T)/Cp/Exner at t-1
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PATHETA ! coefficients between
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PAMOIST ! s and Thetal and Rnp
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLM ! Turbulent Mixing length
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLEPS ! Dissipative length
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHLM,PTKEM! Conservative Potential
- ! Temperature and TKE at t-1
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRM ! Mixing ratios at t-1
- ! with PRM(:,:,:,1) = cons.
- ! mixing ratio
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVM ! Scalars at t-1
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRCM
- ! s'r'c/2Sigma_s2 at t-1 multiplied by Lambda_3
-!
-!
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PREDTH1 ! Redelsperger number R_theta
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PREDR1 ! Redelsperger number R_q
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRED2TH3 ! Redelsperger number R*2_theta
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRED2R3 ! Redelsperger number R*2_q
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRED2THR3! Redelsperger number R*2_thq
-REAL, DIMENSION(:,:,:,:), INTENT(OUT):: PREDS1 ! Redelsperger number R_s
-REAL, DIMENSION(:,:,:,:), INTENT(OUT):: PRED2THS3! Redelsperger number R*2_thsv
-REAL, DIMENSION(:,:,:,:), INTENT(OUT):: PRED2RS3 ! Redelsperger number R*2_qsv
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PBLL_O_E! beta*Lk*Leps/tke
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PETHETA ! coefficient E_theta
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PEMOIST ! coefficient E_moist
-!
-!
-! 0.2 declaration of local variables
-!
-REAL, DIMENSION(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) :: &
- ZW1, ZW2
-! working variables
-!
-INTEGER :: IKB ! vertical index value for the first inner mass point
-INTEGER :: IKE ! vertical index value for the last inner mass point
-INTEGER:: ISV ! number of scalar variables
-INTEGER:: JSV ! loop index for the scalar variables
-
-INTEGER :: JLOOP
-REAL :: ZMINVAL
-TYPE(TFIELDDATA) :: TZFIELD
-! ---------------------------------------------------------------------------
-!
-!* 1. DEFAULT VALUES, 1D REDELSPERGER NUMBERS
-! ----------------------------------------
-!
-IKB = KKA+JPVEXT_TURB*KKL
-IKE = KKU-JPVEXT_TURB*KKL
-ISV =SIZE(PSVM,4)
-!
-PETHETA(:,:,:) = MZM( ETHETA(KRR,KRRI,PTHLM,PRM,PLOCPEXNM,PATHETA,PSRCM) )
-PEMOIST(:,:,:) = MZM( EMOIST(KRR,KRRI,PTHLM,PRM,PLOCPEXNM,PAMOIST,PSRCM) )
-PETHETA(:,:,KKA) = 2.*PETHETA(:,:,IKB) - PETHETA(:,:,IKB+KKL)
-PEMOIST(:,:,KKA) = 2.*PEMOIST(:,:,IKB) - PEMOIST(:,:,IKB+KKL)
-!
-!---------------------------------------------------------------------------
-!
-! 1.3 1D Redelsperger numbers
-!
-IF (LOCEAN) THEN
- PBLL_O_E(:,:,:) = MZM(XG *XALPHAOC* PLM(:,:,:) * PLEPS(:,:,:) / PTKEM(:,:,:) )
- PREDTH1(:,:,:)= XCTV*PBLL_O_E(:,:,:) * GZ_M_W(KKA,KKU,KKL,PTHLM,PDZZ)
- PREDR1(:,:,:) = 0.
-ELSE
- PBLL_O_E(:,:,:) = MZM(XG / PTHVREF(:,:,:) * PLM(:,:,:) * PLEPS(:,:,:) / PTKEM(:,:,:) )
- IF (KRR /= 0) THEN ! moist case
- PREDTH1(:,:,:)= XCTV*PBLL_O_E(:,:,:) * PETHETA(:,:,:) * &
- & GZ_M_W(KKA,KKU,KKL,PTHLM,PDZZ)
- PREDR1(:,:,:) = XCTV*PBLL_O_E(:,:,:) * PEMOIST(:,:,:) * &
- & GZ_M_W(KKA,KKU,KKL,PRM(:,:,:,1),PDZZ)
- ELSE ! dry case
- PREDTH1(:,:,:)= XCTV*PBLL_O_E(:,:,:) * GZ_M_W(KKA,KKU,KKL,PTHLM,PDZZ)
- PREDR1(:,:,:) = 0.
- END IF
-!
-END IF
-!
-! 3. Limits on 1D Redelperger numbers
-! --------------------------------
-!
-ZMINVAL = (1.-1./XPHI_LIM)
-!
-ZW1 = 1.
-ZW2 = 1.
-!
-WHERE (PREDTH1+PREDR1<-ZMINVAL)
- ZW1 = (-ZMINVAL) / (PREDTH1+PREDR1)
-END WHERE
-!
-WHERE (PREDTH1<-ZMINVAL)
- ZW2 = (-ZMINVAL) / (PREDTH1)
-END WHERE
-ZW2 = MIN(ZW1,ZW2)
-!
-ZW1 = 1.
-WHERE (PREDR1<-ZMINVAL)
- ZW1 = (-ZMINVAL) / (PREDR1)
-END WHERE
-ZW1 = MIN(ZW2,ZW1)
-!
-!
-! 3. Modification of Mixing length and dissipative length
-! ----------------------------------------------------
-!
-PBLL_O_E(:,:,:) = PBLL_O_E(:,:,:) * ZW1(:,:,:)
-PREDTH1 (:,:,:) = PREDTH1 (:,:,:) * ZW1(:,:,:)
-PREDR1 (:,:,:) = PREDR1 (:,:,:) * ZW1(:,:,:)
-!
-! 4. Threshold for very small (in absolute value) Redelperger numbers
-! ----------------------------------------------------------------
-!
-ZW2=SIGN(1.,PREDTH1(:,:,:))
-PREDTH1(:,:,:)= ZW2(:,:,:) * MAX(XMNH_TINY_12, ZW2(:,:,:)*PREDTH1(:,:,:))
-!
-IF (.NOT.LOCEAN) THEN
- IF (KRR /= 0) THEN ! dry case
- ZW2=SIGN(1.,PREDR1(:,:,:))
- PREDR1(:,:,:)= ZW2(:,:,:) * MAX(XMNH_TINY_12, ZW2(:,:,:)*PREDR1(:,:,:))
- END IF
-END IF
-!
-!
-!---------------------------------------------------------------------------
-!
-! For the scalar variables
-DO JSV=1,ISV
- PREDS1(:,:,:,JSV)=XCTV*PBLL_O_E(:,:,:)*GZ_M_W(KKA,KKU,KKL,PSVM(:,:,:,JSV),PDZZ)
-END DO
-!
-DO JSV=1,ISV
- ZW2=SIGN(1.,PREDS1(:,:,:,JSV))
- PREDS1(:,:,:,JSV)= ZW2(:,:,:) * MAX(XMNH_TINY_12, ZW2(:,:,:)*PREDS1(:,:,:,JSV))
-END DO
-!
-!---------------------------------------------------------------------------
-!
-!* 2. 3D REDELSPERGER NUMBERS
-! ------------------------
-!
-IF(HTURBDIM=='1DIM') THEN ! 1D case
-!
-!
- PRED2TH3(:,:,:) = PREDTH1(:,:,:)**2
-!
- PRED2R3(:,:,:) = PREDR1(:,:,:) **2
-!
- PRED2THR3(:,:,:) = PREDTH1(:,:,:) * PREDR1(:,:,:)
-!
-ELSE IF (L2D) THEN ! 3D case in a 2D model
-!
- IF (KRR /= 0) THEN ! moist 3D case
- PRED2TH3(:,:,:)= PREDTH1(:,:,:)**2+(XCTV*PBLL_O_E(:,:,:)*PETHETA(:,:,:) )**2 * &
- MZM( GX_M_M(PTHLM,PDXX,PDZZ,PDZX)**2 )
- PRED2TH3(:,:,IKB)=PRED2TH3(:,:,IKB+KKL)
-!
- PRED2R3(:,:,:)= PREDR1(:,:,:)**2 + (XCTV*PBLL_O_E(:,:,:)*PEMOIST(:,:,:))**2 * &
- MZM( GX_M_M(PRM(:,:,:,1),PDXX,PDZZ,PDZX)**2 )
- PRED2R3(:,:,IKB)=PRED2R3(:,:,IKB+KKL)
-!
- PRED2THR3(:,:,:)= PREDR1(:,:,:) * PREDTH1(:,:,:) + XCTV**2*PBLL_O_E(:,:,:)**2 * &
- PEMOIST(:,:,:) * PETHETA(:,:,:) * &
- MZM( GX_M_M(PRM(:,:,:,1),PDXX,PDZZ,PDZX)* &
- GX_M_M(PTHLM,PDXX,PDZZ,PDZX))
- PRED2THR3(:,:,IKB)=PRED2THR3(:,:,IKB+KKL)
-!
- ELSE ! dry 3D case in a 2D model
- PRED2TH3(:,:,:) = PREDTH1(:,:,:)**2 + XCTV**2*PBLL_O_E(:,:,:)**2 * &
- MZM( GX_M_M(PTHLM,PDXX,PDZZ,PDZX)**2 )
- PRED2TH3(:,:,IKB)=PRED2TH3(:,:,IKB+KKL)
-!
- PRED2R3(:,:,:) = 0.
-!
- PRED2THR3(:,:,:) = 0.
-!
- END IF
-!
-ELSE ! 3D case in a 3D model
-!
- IF (KRR /= 0) THEN ! moist 3D case
- PRED2TH3(:,:,:)= PREDTH1(:,:,:)**2 + ( XCTV*PBLL_O_E(:,:,:)*PETHETA(:,:,:) )**2 * &
- MZM( GX_M_M(PTHLM,PDXX,PDZZ,PDZX)**2 &
- + GY_M_M(PTHLM,PDYY,PDZZ,PDZY)**2 )
- PRED2TH3(:,:,IKB)=PRED2TH3(:,:,IKB+KKL)
-!
- PRED2R3(:,:,:)= PREDR1(:,:,:)**2 + (XCTV*PBLL_O_E(:,:,:)*PEMOIST(:,:,:))**2 * &
- MZM( GX_M_M(PRM(:,:,:,1),PDXX,PDZZ,PDZX)**2 + &
- GY_M_M(PRM(:,:,:,1),PDYY,PDZZ,PDZY)**2 )
- PRED2R3(:,:,IKB)=PRED2R3(:,:,IKB+KKL)
-!
- PRED2THR3(:,:,:)= PREDR1(:,:,:) * PREDTH1(:,:,:) + XCTV**2*PBLL_O_E(:,:,:)**2 * &
- PEMOIST(:,:,:) * PETHETA(:,:,:) * &
- MZM( GX_M_M(PRM(:,:,:,1),PDXX,PDZZ,PDZX)* &
- GX_M_M(PTHLM,PDXX,PDZZ,PDZX)+ &
- GY_M_M(PRM(:,:,:,1),PDYY,PDZZ,PDZY)* &
- GY_M_M(PTHLM,PDYY,PDZZ,PDZY) )
- PRED2THR3(:,:,IKB)=PRED2THR3(:,:,IKB+KKL)
-!
- ELSE ! dry 3D case in a 3D model
- PRED2TH3(:,:,:) = PREDTH1(:,:,:)**2 + XCTV**2*PBLL_O_E(:,:,:)**2 * &
- MZM( GX_M_M(PTHLM,PDXX,PDZZ,PDZX)**2 &
- + GY_M_M(PTHLM,PDYY,PDZZ,PDZY)**2 )
- PRED2TH3(:,:,IKB)=PRED2TH3(:,:,IKB+KKL)
-!
- PRED2R3(:,:,:) = 0.
-!
- PRED2THR3(:,:,:) = 0.
-!
- END IF
-!
-END IF ! end of the if structure on the turbulence dimensionnality
-!
-!
-!---------------------------------------------------------------------------
-!
-! 5. Prandtl numbers for scalars
-! ---------------------------
-IF(HTURBDIM=='1DIM') THEN
-! 1D case
- DO JSV=1,ISV
- PRED2THS3(:,:,:,JSV) = PREDS1(:,:,:,JSV) * PREDTH1(:,:,:)
- IF (KRR /= 0) THEN
- PRED2RS3(:,:,:,JSV) = PREDR1(:,:,:) *PREDS1(:,:,:,JSV)
- ELSE
- PRED2RS3(:,:,:,JSV) = 0.
- END IF
- ENDDO
-!
-ELSE IF (L2D) THEN ! 3D case in a 2D model
-!
- IF (LOCEAN) THEN
- IF (KRR /= 0) THEN
- ZW1 = MZM((XG *XALPHAOC * PLM * PLEPS / PTKEM)**2 ) *PETHETA
- ELSE
- ZW1 = MZM((XG *XALPHAOC * PLM * PLEPS / PTKEM)**2)
- END IF
- ELSE
- DO JSV=1,ISV
- IF (KRR /= 0) THEN
- ZW1 = MZM( (XG / PTHVREF * PLM * PLEPS / PTKEM)**2 ) *PETHETA
- ELSE
- ZW1 = MZM( (XG / PTHVREF * PLM * PLEPS / PTKEM)**2)
- END IF
- PRED2THS3(:,:,:,JSV) = PREDTH1(:,:,:) * PREDS1(:,:,:,JSV) + &
- ZW1* &
- MZM(GX_M_M(PSVM(:,:,:,JSV),PDXX,PDZZ,PDZX)* &
- GX_M_M(PTHLM,PDXX,PDZZ,PDZX) &
- )
-!
- IF (KRR /= 0) THEN
- PRED2RS3(:,:,:,JSV) = PREDR1(:,:,:) * PREDS1(:,:,:,JSV) + &
- ZW1 * PEMOIST * &
- MZM(GX_M_M(PSVM(:,:,:,JSV),PDXX,PDZZ,PDZX)* &
- GX_M_M(PRM(:,:,:,1),PDXX,PDZZ,PDZX) &
- )
- ELSE
- PRED2RS3(:,:,:,JSV) = 0.
- END IF
- ENDDO
- END IF
-!
-ELSE ! 3D case in a 3D model
-!
- IF (LOCEAN) THEN
- IF (KRR /= 0) THEN
- ZW1 = MZM((XG *XALPHAOC * PLM * PLEPS / PTKEM)**2 ) *PETHETA
- ELSE
- ZW1 = MZM((XG *XALPHAOC * PLM * PLEPS / PTKEM)**2)
- END IF
- ELSE
- DO JSV=1,ISV
- IF (KRR /= 0) THEN
- ZW1 = MZM( (XG / PTHVREF * PLM * PLEPS / PTKEM)**2 ) *PETHETA
- ELSE
- ZW1 = MZM( (XG / PTHVREF * PLM * PLEPS / PTKEM)**2)
- END IF
- PRED2THS3(:,:,:,JSV) = PREDTH1(:,:,:) * PREDS1(:,:,:,JSV) + &
- ZW1* &
- MZM(GX_M_M(PSVM(:,:,:,JSV),PDXX,PDZZ,PDZX)* &
- GX_M_M(PTHLM,PDXX,PDZZ,PDZX) &
- +GY_M_M(PSVM(:,:,:,JSV),PDYY,PDZZ,PDZY)* &
- GY_M_M(PTHLM,PDYY,PDZZ,PDZY) &
- )
-!
- IF (KRR /= 0) THEN
- PRED2RS3(:,:,:,JSV) = PREDR1(:,:,:) * PREDS1(:,:,:,JSV) + &
- ZW1 * PEMOIST * &
- MZM(GX_M_M(PSVM(:,:,:,JSV),PDXX,PDZZ,PDZX)* &
- GX_M_M(PRM(:,:,:,1),PDXX,PDZZ,PDZX) &
- +GY_M_M(PSVM(:,:,:,JSV),PDYY,PDZZ,PDZY)* &
- GY_M_M(PRM(:,:,:,1),PDYY,PDZZ,PDZY) &
- )
- ELSE
- PRED2RS3(:,:,:,JSV) = 0.
- END IF
- ENDDO
- END IF
-!
-END IF ! end of HTURBDIM if-block
-!
-!
-!---------------------------------------------------------------------------
-!
-!* 6. SAVES THE REDELSPERGER NUMBERS
-! ------------------------------
-!
-IF ( OTURB_DIAG .AND. TPFILE%LOPENED ) THEN
- !
- ! stores the RED_TH1
- TZFIELD%CMNHNAME = 'RED_TH1'
- TZFIELD%CSTDNAME = ''
- TZFIELD%CLONGNAME = 'RED_TH1'
- TZFIELD%CUNITS = '1'
- TZFIELD%CDIR = 'XY'
- TZFIELD%CCOMMENT = 'X_Y_Z_RED_TH1'
- TZFIELD%NGRID = 4
- TZFIELD%NTYPE = TYPEREAL
- TZFIELD%NDIMS = 3
- TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_Field_write(TPFILE,TZFIELD,PREDTH1)
- !
- ! stores the RED_R1
- TZFIELD%CMNHNAME = 'RED_R1'
- TZFIELD%CSTDNAME = ''
- TZFIELD%CLONGNAME = 'RED_R1'
- TZFIELD%CUNITS = '1'
- TZFIELD%CDIR = 'XY'
- TZFIELD%CCOMMENT = 'X_Y_Z_RED_R1'
- TZFIELD%NGRID = 4
- TZFIELD%NTYPE = TYPEREAL
- TZFIELD%NDIMS = 3
- TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_Field_write(TPFILE,TZFIELD,PREDR1)
- !
- ! stores the RED2_TH3
- TZFIELD%CMNHNAME = 'RED2_TH3'
- TZFIELD%CSTDNAME = ''
- TZFIELD%CLONGNAME = 'RED2_TH3'
- TZFIELD%CUNITS = '1'
- TZFIELD%CDIR = 'XY'
- TZFIELD%CCOMMENT = 'X_Y_Z_RED2_TH3'
- TZFIELD%NGRID = 4
- TZFIELD%NTYPE = TYPEREAL
- TZFIELD%NDIMS = 3
- TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_Field_write(TPFILE,TZFIELD,PRED2TH3)
- !
- ! stores the RED2_R3
- TZFIELD%CMNHNAME = 'RED2_R3'
- TZFIELD%CSTDNAME = ''
- TZFIELD%CLONGNAME = 'RED2_R3'
- TZFIELD%CUNITS = '1'
- TZFIELD%CDIR = 'XY'
- TZFIELD%CCOMMENT = 'X_Y_Z_RED2_R3'
- TZFIELD%NGRID = 4
- TZFIELD%NTYPE = TYPEREAL
- TZFIELD%NDIMS = 3
- TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_Field_write(TPFILE,TZFIELD,PRED2R3)
- !
- ! stores the RED2_THR3
- TZFIELD%CMNHNAME = 'RED2_THR3'
- TZFIELD%CSTDNAME = ''
- TZFIELD%CLONGNAME = 'RED2_THR3'
- TZFIELD%CUNITS = '1'
- TZFIELD%CDIR = 'XY'
- TZFIELD%CCOMMENT = 'X_Y_Z_RED2_THR3'
- TZFIELD%NGRID = 4
- TZFIELD%NTYPE = TYPEREAL
- TZFIELD%NDIMS = 3
- TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_Field_write(TPFILE,TZFIELD,PRED2THR3)
- !
-END IF
-!
-!---------------------------------------------------------------------------
-!
-IF (LHOOK) CALL DR_HOOK('PRANDTL',1,ZHOOK_HANDLE)
-END SUBROUTINE PRANDTL
diff --git a/src/mesonh/turb/turb.f90 b/src/mesonh/turb/turb.f90
index 228241e2c..e089edc82 100644
--- a/src/mesonh/turb/turb.f90
+++ b/src/mesonh/turb/turb.f90
@@ -9,23 +9,26 @@
!
INTERFACE
!
- SUBROUTINE TURB(KKA, KKU, KKL, KMI,KRR,KRRL,KRRI,HLBCX,HLBCY, &
- KSPLIT,KMODEL_CL, &
- OTURB_FLX,OTURB_DIAG,OSUBG_COND,ORMC01, &
- HTURBDIM,HTURBLEN,HTOM,HTURBLEN_CL,HCLOUD,PIMPL, &
- PTSTEP,TPFILE,PDXX,PDYY,PDZZ,PDZX,PDZY,PZZ, &
- PDIRCOSXW,PDIRCOSYW,PDIRCOSZW,PCOSSLOPE,PSINSLOPE, &
- PRHODJ,PTHVREF, &
- PSFTH,PSFRV,PSFSV,PSFU,PSFV, &
- PPABST,PUT,PVT,PWT,PTKET,PSVT,PSRCT, &
- PBL_DEPTH, PSBL_DEPTH, &
- PCEI,PCEI_MIN,PCEI_MAX,PCOEF_AMPL_SAT, &
- PTHLT,PRT, &
- PRUS,PRVS,PRWS,PRTHLS,PRRS,PRSVS,PRTKES,PRTKEMS,PSIGS,&
- PFLXZTHVMF,PWTH,PWRC,PWSV,PDYP,PTHP,PTR,PDISS,PLEM )
+ SUBROUTINE TURB(KKA,KKU,KKL,KMI,KRR,KRRL,KRRI,HLBCX,HLBCY, &
+ & KSPLIT,KMODEL_CL, &
+ & OTURB_FLX,OTURB_DIAG,OSUBG_COND,ORMC01, &
+ & HTURBDIM,HTURBLEN,HTOM,HTURBLEN_CL,HCLOUD,PIMPL, &
+ & PTSTEP,TPFILE,PDXX,PDYY,PDZZ,PDZX,PDZY,PZZ, &
+ & PDIRCOSXW,PDIRCOSYW,PDIRCOSZW,PCOSSLOPE,PSINSLOPE, &
+ & PRHODJ,PTHVREF, &
+ & PSFTH,PSFRV,PSFSV,PSFU,PSFV, &
+ & PPABST,PUT,PVT,PWT,PTKET,PSVT,PSRCT, &
+ & PLENGTHM,PLENGTHH,MFMOIST, &
+ & PBL_DEPTH, PSBL_DEPTH, &
+ & PCEI,PCEI_MIN,PCEI_MAX,PCOEF_AMPL_SAT, &
+ & PTHLT,PRT, &
+ & PRUS,PRVS,PRWS,PRTHLS,PRRS,PRSVS,PRTKES,PRTKEMS,PSIGS,&
+ & PFLXZTHVMF,PWTH,PWRC,PWSV,PDYP,PTHP,PTDIFF,PTDISS,PLEM,&
+ & TBUDGETS, KBUDGETS )
!
USE MODD_IO, ONLY: TFILEDATA
+USE MODD_BUDGET, ONLY: TBUDGETDATA
!
INTEGER, INTENT(IN) :: KKA !near ground array index
INTEGER, INTENT(IN) :: KKU !uppest atmosphere array index
@@ -66,6 +69,7 @@ REAL, DIMENSION(:,:), INTENT(IN) :: PCOSSLOPE ! cosinus of the angle
REAL, DIMENSION(:,:), INTENT(IN) :: PSINSLOPE ! sinus of the angle
! between i and the slope vector
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! dry density * Grid size
+REAL, DIMENSION(:,:,:), INTENT(IN) :: MFMOIST ! moist mass flux dual scheme
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHVREF ! Virtual Potential
! Temperature of the reference state
!
@@ -119,10 +123,13 @@ REAL, DIMENSION(:,:,:), INTENT(OUT) :: PWRC ! cloud water flux
REAL, DIMENSION(:,:,:,:),INTENT(OUT) :: PWSV ! scalar flux
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PDYP ! Dynamical production of TKE
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PTHP ! Thermal production of TKE
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PTR ! Transport production of TKE
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PDISS ! Dissipation of TKE
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PTDIFF ! Transport production of TKE
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PTDISS ! Dissipation of TKE
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLEM ! Mixing length
-
+TYPE(TBUDGETDATA), DIMENSION(KBUDGETS), INTENT(INOUT) :: TBUDGETS
+INTEGER, INTENT(IN) :: KBUDGETS
+! length scale from vdfexcu
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLENGTHM, PLENGTHH
!
!-------------------------------------------------------------------------------
!
@@ -142,11 +149,13 @@ END MODULE MODI_TURB
PRHODJ,PTHVREF, &
PSFTH,PSFRV,PSFSV,PSFU,PSFV, &
PPABST,PUT,PVT,PWT,PTKET,PSVT,PSRCT, &
+ PLENGTHM,PLENGTHH,MFMOIST, &
PBL_DEPTH, PSBL_DEPTH, &
PCEI,PCEI_MIN,PCEI_MAX,PCOEF_AMPL_SAT, &
PTHLT,PRT, &
PRUS,PRVS,PRWS,PRTHLS,PRRS,PRSVS,PRTKES,PRTKEMS,PSIGS,&
- PFLXZTHVMF,PWTH,PWRC,PWSV,PDYP,PTHP,PTR,PDISS,PLEM )
+ PFLXZTHVMF,PWTH,PWRC,PWSV,PDYP,PTHP,PTDIFF,PTDISS,PLEM,&
+ TBUDGETS, KBUDGETS )
! #################################################################
!
!
@@ -355,7 +364,7 @@ use modd_budget, only: lbudget_u, lbudget_v, lbudget_w, lbudget_th, lbud
lbudget_rr, lbudget_ri, lbudget_rs, lbudget_rg, lbudget_rh, lbudget_sv, &
NBUDGET_U, NBUDGET_V, NBUDGET_W, NBUDGET_TH, NBUDGET_RV, NBUDGET_RC, &
NBUDGET_RR, NBUDGET_RI, NBUDGET_RS, NBUDGET_RG, NBUDGET_RH, NBUDGET_SV1, &
- tbudgets
+ TBUDGETDATA
USE MODD_CONF
USE MODD_CST
USE MODD_CTURB
@@ -372,10 +381,10 @@ USE MODI_GRADIENT_M
USE MODI_GRADIENT_U
USE MODI_GRADIENT_V
USE MODI_BL89
-USE MODI_TURB_VER
+USE MODE_TURB_VER, ONLY : TURB_VER
USE MODI_ROTATE_WIND
USE MODI_TURB_HOR_SPLT
-USE MODI_TKE_EPS_SOURCES
+USE MODE_TKE_EPS_SOURCES, ONLY: TKE_EPS_SOURCES
USE MODI_SHUMAN
USE MODI_GRADIENT_M
USE MODI_LES_MEAN_SUBGRID
@@ -443,6 +452,7 @@ REAL, DIMENSION(:,:), INTENT(IN) :: PCOSSLOPE ! cosinus of the angle
REAL, DIMENSION(:,:), INTENT(IN) :: PSINSLOPE ! sinus of the angle
! between i and the slope vector
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! dry density * Grid size
+REAL, DIMENSION(:,:,:), INTENT(IN) :: MFMOIST ! moist mass flux dual scheme
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHVREF ! Virtual Potential
! Temperature of the reference state
!
@@ -496,10 +506,15 @@ REAL, DIMENSION(:,:,:), INTENT(OUT) :: PWRC ! cloud water flux
REAL, DIMENSION(:,:,:,:),INTENT(OUT) :: PWSV ! scalar flux
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PDYP ! Dynamical production of TKE
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PTHP ! Thermal production of TKE
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PTR ! Transport production of TKE
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PDISS ! Dissipation of TKE
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PTDIFF ! Transport production of TKE
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PTDISS ! Dissipation of TKE
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLEM ! Mixing length
!
+TYPE(TBUDGETDATA), DIMENSION(KBUDGETS), INTENT(INOUT) :: TBUDGETS
+INTEGER, INTENT(IN) :: KBUDGETS
+!
+! length scale from vdfexcu
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLENGTHM, PLENGTHH
!
!-------------------------------------------------------------------------------
!
@@ -987,7 +1002,6 @@ if ( lbudget_sv ) then
call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + jsv), 'VTURB', prsvs(:, :, :, jsv) )
end do
end if
-
CALL TURB_VER(KKA,KKU,KKL,KRR, KRRL, KRRI, &
OTURB_FLX, &
HTURBDIM,HTOM,PIMPL,ZEXPL, &
@@ -998,7 +1012,7 @@ CALL TURB_VER(KKA,KKU,KKL,KRR, KRRL, KRRI, &
PSFTH,PSFRV,PSFSV,PSFTH,PSFRV,PSFSV, &
ZCDUEFF,ZTAU11M,ZTAU12M,ZTAU33M, &
PUT,PVT,PWT,ZUSLOPE,ZVSLOPE,PTHLT,PRT,PSVT, &
- PTKET,PLEM,ZLEPS, &
+ PTKET,PLEM,PLENGTHM,PLENGTHH,ZLEPS,MFMOIST, &
ZLOCPEXNM,ZATHETA,ZAMOIST,PSRCT,ZFRAC_ICE, &
ZFWTH,ZFWR,ZFTH2,ZFR2,ZFTHR,PBL_DEPTH, &
PSBL_DEPTH,ZLMO, &
@@ -1141,7 +1155,8 @@ CALL TKE_EPS_SOURCES(KKA,KKU,KKL,KMI,PTKET,PLEM,ZLEPS,PDYP,ZTRH, &
PTSTEP,PIMPL,ZEXPL, &
HTURBLEN,HTURBDIM, &
TPFILE,OTURB_DIAG, &
- PTHP,PRTKES,PRTKEMS,PRTHLS,ZCOEF_DISS,PTR,PDISS )
+ PTHP,PRTKES,PRTHLS,ZCOEF_DISS,PTDIFF,PTDISS,&
+ TBUDGETS,KBUDGETS,PRTKESM=PRTKEMS)
!----------------------------------------------------------------------------
!
diff --git a/src/mesonh/turb/turb_ver_dyn_flux.f90 b/src/mesonh/turb/turb_ver_dyn_flux.f90
deleted file mode 100644
index b7c131ba1..000000000
--- a/src/mesonh/turb/turb_ver_dyn_flux.f90
+++ /dev/null
@@ -1,932 +0,0 @@
-!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier
-!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!MNH_LIC for details. version 1.
-!-----------------------------------------------------------------
-! ####################
- MODULE MODI_TURB_VER_DYN_FLUX
-! ####################
-!
-INTERFACE
-!
- SUBROUTINE TURB_VER_DYN_FLUX(KKA,KKU,KKL, &
- OTURB_FLX,KRR, &
- HTURBDIM,PIMPL,PEXPL, &
- PTSTEP, &
- TPFILE, &
- PDXX,PDYY,PDZZ,PDZX,PDZY,PDIRCOSZW,PZZ, &
- PCOSSLOPE,PSINSLOPE, &
- PRHODJ, &
- PCDUEFF,PTAU11M,PTAU12M,PTAU33M, &
- PTHLM,PRM,PSVM,PUM,PVM,PWM,PUSLOPEM,PVSLOPEM, &
- PTKEM,PLM,MFMOIST,PWU,PWV, &
- PRUS,PRVS,PRWS, &
- PDP,PTP )
-!
-USE MODD_IO, ONLY: TFILEDATA
-!
-INTEGER, INTENT(IN) :: KKA !near ground array index
-INTEGER, INTENT(IN) :: KKU !uppest atmosphere array index
-INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=AR
-LOGICAL, INTENT(IN) :: OTURB_FLX ! switch to write the
- ! turbulent fluxes in the syncronous FM-file
-INTEGER, INTENT(IN) :: KRR ! number of moist var.
-CHARACTER(len=4), INTENT(IN) :: HTURBDIM ! dimensionality of the
- ! turbulence scheme
-REAL, INTENT(IN) :: PIMPL, PEXPL ! Coef. for temporal disc.
-REAL, INTENT(IN) :: PTSTEP ! Double Time Step
-TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX, PDYY, PDZZ, PDZX, PDZY
- ! Metric coefficients
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! altitude of flux points
-REAL, DIMENSION(:,:), INTENT(IN) :: PDIRCOSZW ! Director Cosinus of the
- ! normal to the ground surface
-REAL, DIMENSION(:,:), INTENT(IN) :: PCOSSLOPE ! cosinus of the angle
- ! between i and the slope vector
-REAL, DIMENSION(:,:), INTENT(IN) :: PSINSLOPE ! sinus of the angle
- ! between i and the slope vector
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! dry density * grid volum
-!
-REAL, DIMENSION(:,:), INTENT(IN) :: PCDUEFF ! Cd * || u || at time t
-REAL, DIMENSION(:,:), INTENT(IN) :: PTAU11M ! <uu> in the axes linked
- ! to the maximum slope direction and the surface normal and the binormal
- ! at time t - dt
-REAL, DIMENSION(:,:), INTENT(IN) :: PTAU12M ! <uv> in the same axes
-REAL, DIMENSION(:,:), INTENT(IN) :: PTAU33M ! <ww> in the same axes
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PUM,PVM,PWM,PTHLM
- ! Wind at t-Delta t
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRM
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVM
-REAL, DIMENSION(:,:), INTENT(IN) :: PUSLOPEM ! wind component along the
- ! maximum slope direction
-REAL, DIMENSION(:,:), INTENT(IN) :: PVSLOPEM ! wind component along the
- ! direction normal to the maximum slope one
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKEM ! TKE at time t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLM ! Turb. mixing length
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PWU ! momentum flux u'w'
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PWV ! momentum flux v'w'
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRUS, PRVS, PRWS
- ! cumulated sources for the prognostic variables
-!
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PDP ! Dynamic TKE production term
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTP ! Thermal TKE production term
-!
-!
-!
-END SUBROUTINE TURB_VER_DYN_FLUX
-!
-END INTERFACE
-!
-END MODULE MODI_TURB_VER_DYN_FLUX
-!
-!
-! ###############################################################
- SUBROUTINE TURB_VER_DYN_FLUX(KKA,KKU,KKL, &
- OTURB_FLX,KRR, &
- HTURBDIM,PIMPL,PEXPL, &
- PTSTEP, &
- TPFILE, &
- PDXX,PDYY,PDZZ,PDZX,PDZY,PDIRCOSZW,PZZ, &
- PCOSSLOPE,PSINSLOPE, &
- PRHODJ, &
- PCDUEFF,PTAU11M,PTAU12M,PTAU33M, &
- PTHLM,PRM,PSVM,PUM,PVM,PWM,PUSLOPEM,PVSLOPEM, &
- PTKEM,PLM,PWU,PWV, &
- PRUS,PRVS,PRWS, &
- PDP,PTP )
-! ###############################################################
-!
-!
-!!**** *TURB_VER_DYN_FLUX* -compute the source terms due to the vertical turbulent
-!! fluxes.
-!!
-!! PURPOSE
-!! -------
-! The purpose of this routine is to compute the vertical turbulent
-! fluxes of the evolutive variables and give back the source
-! terms to the main program. In the case of large horizontal meshes,
-! the divergence of these vertical turbulent fluxes represent the whole
-! effect of the turbulence but when the three-dimensionnal version of
-! the turbulence scheme is activated (CTURBDIM="3DIM"), these divergences
-! are completed in the next routine TURB_HOR.
-! An arbitrary degree of implicitness has been implemented for the
-! temporal treatment of these diffusion terms.
-! The vertical boundary conditions are as follows:
-! * at the bottom, the surface fluxes are prescribed at the same
-! as the other turbulent fluxes
-! * at the top, the turbulent fluxes are set to 0.
-! It should be noted that the condensation has been implicitely included
-! in this turbulence scheme by using conservative variables and computing
-! the subgrid variance of a statistical variable s indicating the presence
-! or not of condensation in a given mesh.
-!
-!!** METHOD
-!! ------
-!! 1D type calculations are made;
-!! The vertical turbulent fluxes are computed in an off-centered
-!! implicit scheme (a Crank-Nicholson type with coefficients different
-!! than 0.5), which allows to vary the degree of implicitness of the
-!! formulation.
-!! The different prognostic variables are treated one by one.
-!! The contributions of each turbulent fluxes are cumulated into the
-!! tendency PRvarS, and into the dynamic and thermal production of
-!! TKE if necessary.
-!!
-!! In section 2 and 3, the thermodynamical fields are considered.
-!! Only the turbulent fluxes of the conservative variables
-!! (Thetal and Rnp stored in PRx(:,:,:,1)) are computed.
-!! Note that the turbulent fluxes at the vertical
-!! boundaries are given either by the soil scheme for the surface one
-!! ( at the same instant as the others fluxes) and equal to 0 at the
-!! top of the model. The thermal production is computed by vertically
-!! averaging the turbulent flux and multiply this flux at the mass point by
-!! a function ETHETA or EMOIST, which preform the transformation from the
-!! conservative variables to the virtual potential temperature.
-!!
-!! In section 4, the variance of the statistical variable
-!! s indicating presence or not of condensation, is determined in function
-!! of the turbulent moments of the conservative variables and its
-!! squarred root is stored in PSIGS. This information will be completed in
-!! the horizontal turbulence if the turbulence dimensionality is not
-!! equal to "1DIM".
-!!
-!! In section 5, the x component of the stress tensor is computed.
-!! The surface flux <u'w'> is computed from the value of the surface
-!! fluxes computed in axes linked to the orography ( i", j" , k"):
-!! i" is parallel to the surface and in the direction of the maximum
-!! slope
-!! j" is also parallel to the surface and in the normal direction of
-!! the maximum slope
-!! k" is the normal to the surface
-!! In order to prevent numerical instability, the implicit scheme has
-!! been extended to the surface flux regarding to its dependence in
-!! function of U. The dependence in function of the other components
-!! introduced by the different rotations is only explicit.
-!! The turbulent fluxes are used to compute the dynamic production of
-!! TKE. For the last TKE level ( located at PDZZ(:,:,IKB)/2 from the
-!! ground), an harmonic extrapolation from the dynamic production at
-!! PDZZ(:,:,IKB) is used to avoid an evaluation of the gradient of U
-!! in the surface layer.
-!!
-!! In section 6, the same steps are repeated but for the y direction
-!! and in section 7, a diagnostic computation of the W variance is
-!! performed.
-!!
-!! In section 8, the turbulent fluxes for the scalar variables are
-!! computed by the same way as the conservative thermodynamical variables
-!!
-!!
-!! EXTERNAL
-!! --------
-!! GX_U_M, GY_V_M, GZ_W_M : cartesian gradient operators
-!! GX_U_UW,GY_V_VW (X,Y,Z) represent the direction of the gradient
-!! _(M,U,...)_ represent the localization of the
-!! field to be derivated
-!! _(M,UW,...) represent the localization of the
-!! field derivated
-!!
-!!
-!! MXM,MXF,MYM,MYF,MZM,MZF
-!! : Shuman functions (mean operators)
-!! DXF,DYF,DZF,DZM
-!! : Shuman functions (difference operators)
-!!
-!! SUBROUTINE TRIDIAG : to compute the split implicit evolution
-!! of a variable located at a mass point
-!!
-!! SUBROUTINE TRIDIAG_WIND: to compute the split implicit evolution
-!! of a variable located at a wind point
-!!
-!! FUNCTIONs ETHETA and EMOIST :
-!! allows to compute:
-!! - the coefficients for the turbulent correlation between
-!! any variable and the virtual potential temperature, of its
-!! correlations with the conservative potential temperature and
-!! the humidity conservative variable:
-!! ------- ------- -------
-!! A' Thv' = ETHETA A' Thl' + EMOIST A' Rnp'
-!!
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!! Module MODD_CST : contains physical constants
-!!
-!! XG : gravity constant
-!!
-!! Module MODD_CTURB: contains the set of constants for
-!! the turbulence scheme
-!!
-!! XCMFS,XCMFB : cts for the momentum flux
-!! XCSHF : ct for the sensible heat flux
-!! XCHF : ct for the moisture flux
-!! XCTV,XCHV : cts for the T and moisture variances
-!!
-!! Module MODD_PARAMETERS
-!!
-!! JPVEXT_TURB : number of vertical external points
-!! JPHEXT : number of horizontal external points
-!!
-!!
-!! REFERENCE
-!! ---------
-!! Book 1 of documentation (Chapter: Turbulence)
-!!
-!! AUTHOR
-!! ------
-!! Joan Cuxart * INM and Meteo-France *
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original August 19, 1994
-!! Modifications: February 14, 1995 (J.Cuxart and J.Stein)
-!! Doctorization and Optimization
-!! Modifications: March 21, 1995 (J.M. Carriere)
-!! Introduction of cloud water
-!! Modifications: June 14, 1995 (J.Cuxart and J. Stein)
-!! Phi3 and Psi3 at w-point + bug in the all
-!! or nothing condens.
-!! Modifications: Sept 15, 1995 (J.Cuxart and J. Stein)
-!! Change the DP computation at the ground
-!! Modifications: October 10, 1995 (J.Cuxart and J. Stein)
-!! Psi for scal var and LES tools
-!! Modifications: November 10, 1995 (J. Stein)
-!! change the surface relations
-!! Modifications: February 20, 1995 (J. Stein) optimization
-!! Modifications: May 21, 1996 (J. Stein)
-!! bug in the vertical flux of the V wind
-!! component for explicit computation
-!! Modifications: May 21, 1996 (N. wood)
-!! modify the computation of the vertical
-!! part or the surface tangential flux
-!! Modifications: May 21, 1996 (P. Jabouille)
-!! same modification in the Y direction
-!!
-!! Modifications: Sept 17, 1996 (J. Stein) change the moist case by using
-!! Pi instead of Piref + use Atheta and Amoist
-!!
-!! Modifications: Nov 24, 1997 (V. Masson) removes the DO loops
-!! Modifications: Mar 31, 1998 (V. Masson) splits the routine TURB_VER_DYN_FLUX
-!! Modifications: Oct 18, 2000 (J. Stein) Bug in some computations for IKB level
-!! Modifications: Oct 18, 2000 (V. Masson) LES computations + LFLAT switch
-!! Nov 06, 2002 (V. Masson) LES budgets
-!! October 2009 (G. Tanguy) add ILENCH=LEN(YCOMMENT) after
-!! change of YCOMMENT
-!! 2012-02 Y. Seity, add possibility to run with reversed vertical levels
-!! Modifications July 2015 (Wim de Rooy) LHARATU switch
-!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
-!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
-!! Q. Rodier 17/01/2019 : cleaning : remove cyclic conditions on DP and ZA
-!! JL Redelsperger 03/2021 : Add Ocean & O-A Autocoupling LES Cases
-!!--------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE PARKIND1, ONLY : JPRB
-USE YOMHOOK , ONLY : LHOOK, DR_HOOK
-!
-USE MODD_CONF
-USE MODD_CST
-USE MODD_CTURB
-USE MODD_DYN_n, ONLY: LOCEAN
-USE MODD_FIELD, ONLY: TFIELDDATA, TYPEREAL
-USE MODD_IO, ONLY: TFILEDATA
-USE MODD_LES
-USE MODD_NSV
-USE MODD_OCEANH
-USE MODD_PARAMETERS
-USE MODD_REF, ONLY : LCOUPLES
-USE MODD_TURB_n
-!
-!
-USE MODI_GRADIENT_U
-USE MODI_GRADIENT_V
-USE MODI_GRADIENT_W
-USE MODI_GRADIENT_M
-USE MODI_SECOND_MNH
-USE MODI_SHUMAN , ONLY: MZM, MZF, MXM, MXF, MYM, MYF,&
- & DZM, DXF, DXM, DYF, DYM
-USE MODI_TRIDIAG
-USE MODI_TRIDIAG_WIND
-USE MODI_LES_MEAN_SUBGRID
-!
-USE MODE_IO_FIELD_WRITE, only: IO_Field_write
-USE MODE_ll
-!
-IMPLICIT NONE
-!
-!* 0.1 declarations of arguments
-!
-!
-!
-INTEGER, INTENT(IN) :: KKA !near ground array index
-INTEGER, INTENT(IN) :: KKU !uppest atmosphere array index
-INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=ARO
-LOGICAL, INTENT(IN) :: OTURB_FLX ! switch to write the
- ! turbulent fluxes in the syncronous FM-file
-INTEGER, INTENT(IN) :: KRR ! number of moist var.
-CHARACTER(len=4), INTENT(IN) :: HTURBDIM ! dimensionality of the
- ! turbulence scheme
-REAL, INTENT(IN) :: PIMPL, PEXPL ! Coef. for temporal disc.
-REAL, INTENT(IN) :: PTSTEP ! Double Time Step
-TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX, PDYY, PDZZ, PDZX, PDZY
- ! Metric coefficients
-REAL, DIMENSION(:,:), INTENT(IN) :: PDIRCOSZW ! Director Cosinus of the
- ! normal to the ground surface
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! altitude of flux points
-REAL, DIMENSION(:,:), INTENT(IN) :: PCOSSLOPE ! cosinus of the angle
- ! between i and the slope vector
-REAL, DIMENSION(:,:), INTENT(IN) :: PSINSLOPE ! sinus of the angle
- ! between i and the slope vector
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! dry density * grid volum
-REAL, DIMENSION(:,:,:), INTENT(IN) :: MFMOIST ! moist mass flux dual scheme
-
-!
-REAL, DIMENSION(:,:), INTENT(IN) :: PCDUEFF ! Cd * || u || at time t
-REAL, DIMENSION(:,:), INTENT(IN) :: PTAU11M ! <uu> in the axes linked
- ! to the maximum slope direction and the surface normal and the binormal
- ! at time t - dt
-REAL, DIMENSION(:,:), INTENT(IN) :: PTAU12M ! <uv> in the same axes
-REAL, DIMENSION(:,:), INTENT(IN) :: PTAU33M ! <ww> in the same axes
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PUM,PVM,PWM, PTHLM
- ! Wind at t-Delta t
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRM
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVM
-REAL, DIMENSION(:,:), INTENT(IN) :: PUSLOPEM ! wind component along the
- ! maximum slope direction
-REAL, DIMENSION(:,:), INTENT(IN) :: PVSLOPEM ! wind component along the
- ! direction normal to the maximum slope one
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKEM ! TKE at time t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLM ! Turb. mixing length
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PWU ! momentum flux u'w'
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PWV ! momentum flux v'w'
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRUS, PRVS, PRWS
- ! cumulated sources for the prognostic variables
-!
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PDP ! Dynamic TKE production term
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTP ! Thermal TKE production term
-!
-!
-!
-!
-!* 0.2 declaration of local variables
-!
-!
-REAL, DIMENSION(SIZE(PUM,1),SIZE(PUM,2)) :: ZDIRSINZW ! sinus of the angle
- ! between the normal and the vertical at the surface
-REAL, DIMENSION(SIZE(PUM,1),SIZE(PUM,2),1):: ZCOEFS ! coeff. for the
- ! implicit scheme for the wind at the surface
-REAL, DIMENSION(SIZE(PUM,1),SIZE(PUM,2),SIZE(PUM,3)) :: &
- ZA, & ! under diagonal elements of the tri-diagonal matrix involved
- ! in the temporal implicit scheme (also used to store coefficient
- ! J in Section 5)
- ZRES, & ! guess of the treated variable at t+ deltat when the turbu-
- ! lence is the only source of evolution added to the ones
- ! considered in ZSOURCE
- ZFLXZ, & ! vertical flux of the treated variable
- ZSOURCE, & ! source of evolution for the treated variable
- ZKEFF ! effectif diffusion coeff = LT * SQRT( TKE )
-INTEGER :: IIB,IIE, & ! I index values for the Beginning and End
- IJB,IJE, & ! mass points of the domain in the 3 direct.
- IKB,IKE !
-INTEGER :: IKT ! array size in k direction
-INTEGER :: IKTB,IKTE ! start, end of k loops in physical domain
-INTEGER :: JSV ! scalar loop counter
-REAL, DIMENSION(SIZE(PDZZ,1),SIZE(PDZZ,2),1) :: ZCOEFFLXU, &
- ZCOEFFLXV, ZUSLOPEM, ZVSLOPEM
- ! coefficients for the surface flux
- ! evaluation and copy of PUSLOPEM and
- ! PVSLOPEM in local 3D arrays
-INTEGER :: IIU,IJU ! size of array in x,y,z directions
-!
-REAL :: ZTIME1, ZTIME2
-TYPE(TFIELDDATA) :: TZFIELD
-!----------------------------------------------------------------------------
-!
-!* 1. PRELIMINARIES
-! -------------
-ZA=XUNDEF
-PDP=XUNDEF
-!
-IIU=SIZE(PUM,1)
-IJU=SIZE(PUM,2)
-CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
-IKB=KKA+JPVEXT_TURB*KKL
-IKE=KKU-JPVEXT_TURB*KKL
-IKT=SIZE(PUM,3)
-IKTB=1+JPVEXT_TURB
-IKTE=IKT-JPVEXT_TURB
-
-
-!
-ZSOURCE(:,:,:) = 0.
-!
-ZDIRSINZW(:,:) = SQRT(1.-PDIRCOSZW(:,:)**2)
-! compute the coefficients for the uncentred gradient computation near the
-! ground
-!
-ZKEFF(:,:,:) = MZM( PLM(:,:,:) * SQRT(PTKEM(:,:,:)) )
-!
-ZUSLOPEM(:,:,1)=PUSLOPEM(:,:)
-ZVSLOPEM(:,:,1)=PVSLOPEM(:,:)
-!
-!----------------------------------------------------------------------------
-!
-!
-!* 5. SOURCES OF U,W WIND COMPONENTS AND PARTIAL DYNAMIC PRODUCTION
-! -------------------------------------------------------------
-!
-!* 5.1 Source of U wind component
-!
-! Preparation of the arguments for TRIDIAG_WIND
-!
-ZA(:,:,:) = -PTSTEP * XCMFS * &
- MXM( ZKEFF ) * MXM(MZM( PRHODJ )) / &
- MXM( PDZZ )**2
-!
-!
-! Compute the source of U wind component
-!
-! compute the coefficient between the vertical flux and the 2 components of the
-! wind following the slope
-ZCOEFFLXU(:,:,1) = PCDUEFF(:,:) * (PDIRCOSZW(:,:)**2 - ZDIRSINZW(:,:)**2) &
- * PCOSSLOPE(:,:)
-ZCOEFFLXV(:,:,1) = PCDUEFF(:,:) * PDIRCOSZW(:,:) * PSINSLOPE(:,:)
-
-! prepare the implicit scheme coefficients for the surface flux
-ZCOEFS(:,:,1)= ZCOEFFLXU(:,:,1) * PCOSSLOPE(:,:) * PDIRCOSZW(:,:) &
- +ZCOEFFLXV(:,:,1) * PSINSLOPE(:,:)
-!
-! average this flux to be located at the U,W vorticity point
-ZCOEFS(:,:,1:1)=MXM(ZCOEFS(:,:,1:1) / PDZZ(:,:,IKB:IKB) )
-!
-!
-! ZSOURCE= FLUX /DZ
-IF (LOCEAN) THEN ! OCEAN MODEL ONLY
- ! Sfx flux assumed to be in SI & at vorticity point
- IF (LCOUPLES) THEN
- ZSOURCE(:,:,IKE:IKE) = XSSUFL_C(:,:,1:1)/PDZZ(:,:,IKE:IKE) &
- *0.5 * ( 1. + MXM(PRHODJ(:,:,KKU:KKU)) / MXM(PRHODJ(:,:,IKE:IKE)))
- ELSE
- ZSOURCE(:,:,IKE) = XSSUFL(:,:)
- ZSOURCE(:,:,IKE:IKE) = ZSOURCE (:,:,IKE:IKE) /PDZZ(:,:,IKE:IKE) &
- *0.5 * ( 1. + MXM(PRHODJ(:,:,KKU:KKU)) / MXM(PRHODJ(:,:,IKE:IKE)) )
- ENDIF
- !No flux at the ocean domain bottom
- ZSOURCE(:,:,IKB) = 0.
- ZSOURCE(:,:,IKTB+1:IKTE-1) = 0
-!
-ELSE !ATMOS MODEL ONLY
- IF (LCOUPLES) THEN
- ZSOURCE(:,:,IKB:IKB) = XSSUFL_C(:,:,1:1)/PDZZ(:,:,IKB:IKB) &
- * 0.5 * ( 1. + MXM(PRHODJ(:,:,KKA:KKA)) / MXM(PRHODJ(:,:,IKB:IKB)) )
- ELSE
- ! compute the explicit tangential flux at the W point
- ZSOURCE(:,:,IKB) = &
- PTAU11M(:,:) * PCOSSLOPE(:,:) * PDIRCOSZW(:,:) * ZDIRSINZW(:,:) &
- -PTAU12M(:,:) * PSINSLOPE(:,:) * ZDIRSINZW(:,:) &
- -PTAU33M(:,:) * PCOSSLOPE(:,:) * ZDIRSINZW(:,:) * PDIRCOSZW(:,:)
-!
- ! add the vertical part or the surface flux at the U,W vorticity point
-!
- ZSOURCE(:,:,IKB:IKB) = &
- ( MXM( ZSOURCE(:,:,IKB:IKB) / PDZZ(:,:,IKB:IKB) ) &
- + MXM( ZCOEFFLXU(:,:,1:1) / PDZZ(:,:,IKB:IKB) &
- *ZUSLOPEM(:,:,1:1) &
- -ZCOEFFLXV(:,:,1:1) / PDZZ(:,:,IKB:IKB) &
- *ZVSLOPEM(:,:,1:1) ) &
- - ZCOEFS(:,:,1:1) * PUM(:,:,IKB:IKB) * PIMPL &
- ) * 0.5 * ( 1. + MXM(PRHODJ(:,:,KKA:KKA)) / MXM(PRHODJ(:,:,IKB:IKB)) )
- ENDIF
-!
- ZSOURCE(:,:,IKTB+1:IKTE-1) = 0.
- ZSOURCE(:,:,IKE) = 0.
-ENDIF !end ocean or atmosphere cases
-!
-! Obtention of the split U at t+ deltat
-!
-CALL TRIDIAG_WIND(KKA,KKU,KKL,PUM,ZA,ZCOEFS(:,:,1),PTSTEP,PEXPL,PIMPL, &
- MXM(PRHODJ),ZSOURCE,ZRES)
-!
-! Compute the equivalent tendency for the U wind component
-!
-PRUS(:,:,:)=PRUS(:,:,:)+MXM(PRHODJ(:,:,:))*(ZRES(:,:,:)-PUM(:,:,:))/PTSTEP
-!
-!
-!* 5.2 Partial Dynamic Production
-!
-! vertical flux of the U wind component
-!
-ZFLXZ(:,:,:) = -XCMFS * MXM(ZKEFF) * &
- DZM (PIMPL*ZRES + PEXPL*PUM) / MXM(PDZZ)
-!
-! surface flux
-ZFLXZ(:,:,IKB:IKB) = MXM(PDZZ(:,:,IKB:IKB)) * &
- ( ZSOURCE(:,:,IKB:IKB) &
- +ZCOEFS(:,:,1:1) * ZRES(:,:,IKB:IKB) * PIMPL &
- ) / 0.5 / ( 1. + MXM(PRHODJ(:,:,KKA:KKA)) / MXM(PRHODJ(:,:,IKB:IKB)) )
-!
-ZFLXZ(:,:,KKA) = ZFLXZ(:,:,IKB)
-
-IF (LOCEAN) THEN !ocean model at phys sfc (ocean domain top)
- ZFLXZ(:,:,IKE:IKE) = MXM(PDZZ(:,:,IKE:IKE)) * &
- ZSOURCE(:,:,IKE:IKE) &
- / 0.5 / ( 1. + MXM(PRHODJ(:,:,KKU:KKU)) / MXM(PRHODJ(:,:,IKE:IKE)) )
- ZFLXZ(:,:,KKU) = ZFLXZ(:,:,IKE)
-END IF
-!
-IF ( OTURB_FLX .AND. tpfile%lopened ) THEN
- ! stores the U wind component vertical flux
- TZFIELD%CMNHNAME = 'UW_VFLX'
- TZFIELD%CSTDNAME = ''
- TZFIELD%CLONGNAME = 'UW_VFLX'
- TZFIELD%CUNITS = 'm2 s-2'
- TZFIELD%CDIR = 'XY'
- TZFIELD%CCOMMENT = 'U wind component vertical flux'
- TZFIELD%NGRID = 4
- TZFIELD%NTYPE = TYPEREAL
- TZFIELD%NDIMS = 3
- TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_Field_write(TPFILE,TZFIELD,ZFLXZ)
-END IF
-!
-! first part of total momentum flux
-!
-PWU(:,:,:) = ZFLXZ(:,:,:)
-!
-! Contribution to the dynamic production of TKE
-! compute the dynamic production at the mass point
-!
-PDP(:,:,:) = - MZF( MXF ( ZFLXZ * GZ_U_UW(PUM,PDZZ) ) )
-!
-! evaluate the dynamic production at w(IKB+KKL) in PDP(IKB)
-PDP(:,:,IKB:IKB) = - MXF ( &
- ZFLXZ(:,:,IKB+KKL:IKB+KKL) * (PUM(:,:,IKB+KKL:IKB+KKL)-PUM(:,:,IKB:IKB)) &
- / MXM(PDZZ(:,:,IKB+KKL:IKB+KKL)) &
- )
-!
-IF (LOCEAN) THEN
- ! evaluate the dynamic production at w(IKE-KKL) in PDP(IKE)
- PDP(:,:,IKE:IKE) = - MXF ( &
- ZFLXZ(:,:,IKE-KKL:IKE-KKL) * (PUM(:,:,IKE:IKE)-PUM(:,:,IKE-KKL:IKE-KKL)) &
- / MXM(PDZZ(:,:,IKE-KKL:IKE-KKL)) &
- )
-END IF
-!
-! Storage in the LES configuration
-!
-IF (LLES_CALL) THEN
- CALL SECOND_MNH(ZTIME1)
- CALL LES_MEAN_SUBGRID( MZF(MXF(ZFLXZ)), X_LES_SUBGRID_WU )
- CALL LES_MEAN_SUBGRID( MZF(MXF(GZ_U_UW(PUM,PDZZ) &
- & *ZFLXZ)), X_LES_RES_ddxa_U_SBG_UaU )
- CALL LES_MEAN_SUBGRID( XCMFS * ZKEFF, X_LES_SUBGRID_Km )
- CALL SECOND_MNH(ZTIME2)
- XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
-END IF
-!
-!* 5.3 Source of W wind component
-!
-!
-IF(HTURBDIM=='3DIM') THEN
- ! Compute the source for the W wind component
- ! used to compute the W source at the ground
- ZFLXZ(:,:,KKA) = 2 * ZFLXZ(:,:,IKB) - ZFLXZ(:,:,IKB+KKL) ! extrapolation
- IF (LOCEAN) THEN
- ZFLXZ(:,:,KKU) = 2 * ZFLXZ(:,:,IKE) - ZFLXZ(:,:,IKE-KKL) ! extrapolation
- END IF
-
- !
- IF (.NOT. LFLAT) THEN
- PRWS(:,:,:)= PRWS &
- -DXF( MZM( MXM(PRHODJ) /PDXX ) * ZFLXZ ) &
- +DZM( PRHODJ / MZF(PDZZ ) * &
- MXF( MZF( ZFLXZ*PDZX ) / PDXX ) &
- )
- ELSE
- PRWS(:,:,:)= PRWS -DXF( MZM( MXM(PRHODJ) /PDXX ) * ZFLXZ )
- END IF
- !
- ! Complete the Dynamical production with the W wind component
- !
- ZA(:,:,:)=-MZF( MXF ( ZFLXZ * GX_W_UW( PWM,PDXX,PDZZ,PDZX) ) )
- !
- !
- ! evaluate the dynamic production at w(IKB+KKL) in PDP(IKB)
- ZA(:,:,IKB:IKB) = - MXF ( &
- ZFLXZ(:,:,IKB+KKL:IKB+KKL) * &
- ( DXM( PWM(:,:,IKB+KKL:IKB+KKL) ) &
- -MXM( (PWM(:,:,IKB+2*KKL:IKB+2*KKL )-PWM(:,:,IKB+KKL:IKB+KKL)) &
- /(PDZZ(:,:,IKB+2*KKL:IKB+2*KKL)+PDZZ(:,:,IKB+KKL:IKB+KKL)) &
- +(PWM(:,:,IKB+KKL:IKB+KKL)-PWM(:,:,IKB:IKB )) &
- /(PDZZ(:,:,IKB+KKL:IKB+KKL)+PDZZ(:,:,IKB:IKB )) &
- ) &
- * PDZX(:,:,IKB+KKL:IKB+KKL) &
- ) / (0.5*(PDXX(:,:,IKB+KKL:IKB+KKL)+PDXX(:,:,IKB:IKB))) &
- )
- !
-IF (LOCEAN) THEN
- ! evaluate the dynamic production at w(IKE-KKL) in PDP(IKE)
- ZA(:,:,IKE:IKE) = - MXF ( &
- ZFLXZ(:,:,IKE-KKL:IKE-KKL) * &
- ( DXM( PWM(:,:,IKE-KKL:IKE-KKL) ) &
- -MXM( (PWM(:,:,IKE-2*KKL:IKE-2*KKL )-PWM(:,:,IKE-KKL:IKE-KKL)) &
- /(PDZZ(:,:,IKE-2*KKL:IKE-2*KKL)+PDZZ(:,:,IKE-KKL:IKE-KKL)) &
- +(PWM(:,:,IKE-KKL:IKE-KKL)-PWM(:,:,IKE:IKE )) &
- /(PDZZ(:,:,IKE-KKL:IKE-KKL)+PDZZ(:,:,IKE:IKE )) &
- ) &
- * PDZX(:,:,IKE-KKL:IKE-KKL) &
- ) / (0.5*(PDXX(:,:,IKE-KKL:IKE-KKL)+PDXX(:,:,IKE:IKE))) &
- )
-END IF
- !
- PDP(:,:,:)=PDP(:,:,:)+ZA(:,:,:)
- !
- ! Storage in the LES configuration
- !
- IF (LLES_CALL) THEN
- CALL SECOND_MNH(ZTIME1)
- CALL LES_MEAN_SUBGRID( MZF(MXF(GX_W_UW(PWM,PDXX,&
- PDZZ,PDZX)*ZFLXZ)), X_LES_RES_ddxa_W_SBG_UaW )
- CALL LES_MEAN_SUBGRID( MXF(GX_M_U(KKA,KKU,KKL,PTHLM,PDXX,PDZZ,PDZX)&
- * MZF(ZFLXZ)), X_LES_RES_ddxa_Thl_SBG_UaW )
- IF (KRR>=1) THEN
- CALL LES_MEAN_SUBGRID(MXF(GX_U_M(PRM(:,:,:,1),PDXX,PDZZ,PDZX)&
- *MZF(ZFLXZ)),X_LES_RES_ddxa_Rt_SBG_UaW )
- END IF
- DO JSV=1,NSV
- CALL LES_MEAN_SUBGRID( MXF(GX_U_M(PSVM(:,:,:,JSV),PDXX,PDZZ,&
- PDZX)*MZF(ZFLXZ)),X_LES_RES_ddxa_Sv_SBG_UaW(:,:,:,JSV) )
- END DO
- CALL SECOND_MNH(ZTIME2)
- XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
- END IF
-END IF
-!
-!----------------------------------------------------------------------------
-!
-!
-!* 6. SOURCES OF V,W WIND COMPONENTS AND COMPLETE 1D DYNAMIC PRODUCTION
-! -----------------------------------------------------------------
-!
-!* 6.1 Source of V wind component
-!
-! Preparation of the arguments for TRIDIAG_WIND
-!!
-ZA(:,:,:) = - PTSTEP * XCMFS * &
- MYM( ZKEFF ) * MYM(MZM( PRHODJ )) / &
- MYM( PDZZ )**2
-!
-!
-!
-! Compute the source of V wind component
-! compute the coefficient between the vertical flux and the 2 components of the
-! wind following the slope
-ZCOEFFLXU(:,:,1) = PCDUEFF(:,:) * (PDIRCOSZW(:,:)**2 - ZDIRSINZW(:,:)**2) &
- * PSINSLOPE(:,:)
-ZCOEFFLXV(:,:,1) = PCDUEFF(:,:) * PDIRCOSZW(:,:) * PCOSSLOPE(:,:)
-
-! prepare the implicit scheme coefficients for the surface flux
-ZCOEFS(:,:,1)= ZCOEFFLXU(:,:,1) * PSINSLOPE(:,:) * PDIRCOSZW(:,:) &
- +ZCOEFFLXV(:,:,1) * PCOSSLOPE(:,:)
-!
-! average this flux to be located at the V,W vorticity point
-ZCOEFS(:,:,1:1)=MYM(ZCOEFS(:,:,1:1) / PDZZ(:,:,IKB:IKB) )
-!
-IF (LOCEAN) THEN ! Ocean case
- IF (LCOUPLES) THEN
- ZSOURCE(:,:,IKE:IKE) = XSSVFL_C(:,:,1:1)/PDZZ(:,:,IKE:IKE) &
- *0.5 * ( 1. + MYM(PRHODJ(:,:,KKU:KKU)) / MYM(PRHODJ(:,:,IKE:IKE)) )
- ELSE
- ZSOURCE(:,:,IKE) = XSSVFL(:,:)
- ZSOURCE(:,:,IKE:IKE) = ZSOURCE(:,:,IKE:IKE)/PDZZ(:,:,IKE:IKE) &
- *0.5 * ( 1. + MYM(PRHODJ(:,:,KKU:KKU)) / MYM(PRHODJ(:,:,IKE:IKE)) )
- END IF
- !No flux at the ocean domain bottom
- ZSOURCE(:,:,IKB) = 0.
-ELSE ! Atmos case
- IF (.NOT.LCOUPLES) THEN ! only atmosp without coupling
- ! compute the explicit tangential flux at the W point
- ZSOURCE(:,:,IKB) = &
- PTAU11M(:,:) * PSINSLOPE(:,:) * PDIRCOSZW(:,:) * ZDIRSINZW(:,:) &
- +PTAU12M(:,:) * PCOSSLOPE(:,:) * ZDIRSINZW(:,:) &
- -PTAU33M(:,:) * PSINSLOPE(:,:) * ZDIRSINZW(:,:) * PDIRCOSZW(:,:)
-!
- ! add the vertical part or the surface flux at the V,W vorticity point
- ZSOURCE(:,:,IKB:IKB) = &
- ( MYM( ZSOURCE(:,:,IKB:IKB) / PDZZ(:,:,IKB:IKB) ) &
- + MYM( ZCOEFFLXU(:,:,1:1) / PDZZ(:,:,IKB:IKB) &
- *ZUSLOPEM(:,:,1:1) &
- +ZCOEFFLXV(:,:,1:1) / PDZZ(:,:,IKB:IKB) &
- *ZVSLOPEM(:,:,1:1) ) &
- - ZCOEFS(:,:,1:1) * PVM(:,:,IKB:IKB) * PIMPL &
- ) * 0.5 * ( 1. + MYM(PRHODJ(:,:,KKA:KKA)) / MYM(PRHODJ(:,:,IKB:IKB)) )
-!
- ELSE !atmosphere when coupling
- ! input flux assumed to be in SI and at vorticity point
- ZSOURCE(:,:,IKB:IKB) = -XSSVFL_C(:,:,1:1)/(1.*PDZZ(:,:,IKB:IKB)) &
- * 0.5 * ( 1. + MYM(PRHODJ(:,:,KKA:KKA)) / MYM(PRHODJ(:,:,IKB:IKB)) )
- ENDIF
- !No flux at the atmosphere top
- ZSOURCE(:,:,IKE) = 0.
-ENDIF ! End of Ocean or Atmospher Cases
-ZSOURCE(:,:,IKTB+1:IKTE-1) = 0.
-!
-! Obtention of the split V at t+ deltat
-CALL TRIDIAG_WIND(KKA,KKU,KKL,PVM,ZA,ZCOEFS(:,:,1),PTSTEP,PEXPL,PIMPL, &
- MYM(PRHODJ),ZSOURCE,ZRES)
-!
-! Compute the equivalent tendency for the V wind component
-!
-PRVS(:,:,:)=PRVS(:,:,:)+MYM(PRHODJ(:,:,:))*(ZRES(:,:,:)-PVM(:,:,:))/PTSTEP
-!
-!
-!* 6.2 Complete 1D dynamic Production
-!
-! vertical flux of the V wind component
-!
-ZFLXZ(:,:,:) = -XCMFS * MYM(ZKEFF) * &
- DZM( PIMPL*ZRES + PEXPL*PVM ) / MYM(PDZZ)
-!
-ZFLXZ(:,:,IKB:IKB) = MYM(PDZZ(:,:,IKB:IKB)) * &
- ( ZSOURCE(:,:,IKB:IKB) &
- +ZCOEFS(:,:,1:1) * ZRES(:,:,IKB:IKB) * PIMPL &
- ) / 0.5 / ( 1. + MYM(PRHODJ(:,:,KKA:KKA)) / MYM(PRHODJ(:,:,IKB:IKB)) )
-!
-!
-ZFLXZ(:,:,KKA) = ZFLXZ(:,:,IKB)
-!
-IF (LOCEAN) THEN
- ZFLXZ(:,:,IKE:IKE) = MYM(PDZZ(:,:,IKE:IKE)) * &
- ZSOURCE(:,:,IKE:IKE) &
- / 0.5 / ( 1. + MYM(PRHODJ(:,:,KKU:KKU)) / MYM(PRHODJ(:,:,IKE:IKE)) )
- ZFLXZ(:,:,KKU) = ZFLXZ(:,:,IKE)
-END IF
-!
-IF ( OTURB_FLX .AND. TPFILE%LOPENED ) THEN
- ! stores the V wind component vertical flux
- TZFIELD%CMNHNAME = 'VW_VFLX'
- TZFIELD%CSTDNAME = ''
- TZFIELD%CLONGNAME = 'VW_VFLX'
- TZFIELD%CUNITS = 'm2 s-2'
- TZFIELD%CDIR = 'XY'
- TZFIELD%CCOMMENT = 'V wind component vertical flux'
- TZFIELD%NGRID = 4
- TZFIELD%NTYPE = TYPEREAL
- TZFIELD%NDIMS = 3
- TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_Field_write(TPFILE,TZFIELD,ZFLXZ)
-END IF
-!
-! second part of total momentum flux
-!
-PWV(:,:,:) = ZFLXZ(:,:,:)
-!
-! Contribution to the dynamic production of TKE
-! compute the dynamic production contribution at the mass point
-!
-ZA(:,:,:) = - MZF( MYF ( ZFLXZ * GZ_V_VW(PVM,PDZZ) ) )
-!
-! evaluate the dynamic production at w(IKB+KKL) in PDP(IKB)
-ZA(:,:,IKB:IKB) = &
- - MYF ( &
-ZFLXZ(:,:,IKB+KKL:IKB+KKL) * (PVM(:,:,IKB+KKL:IKB+KKL)-PVM(:,:,IKB:IKB)) &
- / MYM(PDZZ(:,:,IKB+KKL:IKB+KKL)) &
- )
-!
-IF (LOCEAN) THEN
- ! evaluate the dynamic production at w(IKE-KKL) in PDP(IKE)
- ZA(:,:,IKE:IKE) = - MYF ( &
- ZFLXZ(:,:,IKE-KKL:IKE-KKL) * (PVM(:,:,IKE:IKE)-PVM(:,:,IKE-KKL:IKE-KKL)) &
- / MYM(PDZZ(:,:,IKE-KKL:IKE-KKL)) &
- )
-END IF
-!
-PDP(:,:,:)=PDP(:,:,:)+ZA(:,:,:)
-!
-! Storage in the LES configuration
-!
-IF (LLES_CALL) THEN
- CALL SECOND_MNH(ZTIME1)
- CALL LES_MEAN_SUBGRID( MZF(MYF(ZFLXZ)), X_LES_SUBGRID_WV )
- CALL LES_MEAN_SUBGRID( MZF(MYF(GZ_V_VW(PVM,PDZZ)*&
- & ZFLXZ)), X_LES_RES_ddxa_V_SBG_UaV )
- CALL SECOND_MNH(ZTIME2)
- XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
-END IF
-!
-!
-!* 6.3 Source of W wind component
-!
-IF(HTURBDIM=='3DIM') THEN
- ! Compute the source for the W wind component
- ZFLXZ(:,:,KKA) = 2 * ZFLXZ(:,:,IKB) - ZFLXZ(:,:,IKB+KKL) ! extrapolation
- IF (LOCEAN) THEN
- ZFLXZ(:,:,KKU) = 2 * ZFLXZ(:,:,IKE) - ZFLXZ(:,:,IKE-KKL) ! extrapolation
- END IF
- !
- IF (.NOT. L2D) THEN
- IF (.NOT. LFLAT) THEN
- PRWS(:,:,:)= PRWS(:,:,:) &
- -DYF( MZM( MYM(PRHODJ) /PDYY ) * ZFLXZ ) &
- +DZM( PRHODJ / MZF(PDZZ ) * &
- MYF( MZF( ZFLXZ*PDZY ) / PDYY ) &
- )
- ELSE
- PRWS(:,:,:)= PRWS(:,:,:) -DYF( MZM( MYM(PRHODJ) /PDYY ) * ZFLXZ )
- END IF
- END IF
- !
- ! Complete the Dynamical production with the W wind component
- IF (.NOT. L2D) THEN
- ZA(:,:,:) = - MZF( MYF ( ZFLXZ * GY_W_VW( PWM,PDYY,PDZZ,PDZY) ) )
- !
- ! evaluate the dynamic production at w(IKB+KKL) in PDP(IKB)
- ZA(:,:,IKB:IKB) = - MYF ( &
- ZFLXZ(:,:,IKB+KKL:IKB+KKL) * &
- ( DYM( PWM(:,:,IKB+KKL:IKB+KKL) ) &
- -MYM( (PWM(:,:,IKB+2*KKL:IKB+2*KKL)-PWM(:,:,IKB+KKL:IKB+KKL)) &
- /(PDZZ(:,:,IKB+2*KKL:IKB+2*KKL)+PDZZ(:,:,IKB+KKL:IKB+KKL)) &
- +(PWM(:,:,IKB+KKL:IKB+KKL)-PWM(:,:,IKB:IKB )) &
- /(PDZZ(:,:,IKB+KKL:IKB+KKL)+PDZZ(:,:,IKB:IKB )) &
- ) &
- * PDZY(:,:,IKB+KKL:IKB+KKL) &
- ) / (0.5*(PDYY(:,:,IKB+KKL:IKB+KKL)+PDYY(:,:,IKB:IKB))) &
- )
- !
- IF (LOCEAN) THEN
- ZA(:,:,IKE:IKE) = - MYF ( &
- ZFLXZ(:,:,IKE-KKL:IKE-KKL) * &
- ( DYM( PWM(:,:,IKE-KKL:IKE-KKL) ) &
- -MYM( (PWM(:,:,IKE-2*KKL:IKE-2*KKL)-PWM(:,:,IKE-KKL:IKE-KKL)) &
- /(PDZZ(:,:,IKE-2*KKL:IKE-2*KKL)+PDZZ(:,:,IKE-KKL:IKE-KKL)) &
- +(PWM(:,:,IKE-KKL:IKE-KKL)-PWM(:,:,IKE:IKE )) &
- /(PDZZ(:,:,IKE-KKL:IKE-KKL)+PDZZ(:,:,IKE:IKE )) &
- ) &
- * PDZY(:,:,IKE-KKL:IKE-KKL) &
- ) / (0.5*(PDYY(:,:,IKE-KKL:IKE-KKL)+PDYY(:,:,IKE:IKE))) &
- )
- END IF
-!
- PDP(:,:,:)=PDP(:,:,:)+ZA(:,:,:)
- !
- END IF
- !
- ! Storage in the LES configuration
- !
- IF (LLES_CALL) THEN
- CALL SECOND_MNH(ZTIME1)
- CALL LES_MEAN_SUBGRID( MZF(MYF(GY_W_VW(PWM,PDYY,&
- PDZZ,PDZY)*ZFLXZ)), X_LES_RES_ddxa_W_SBG_UaW , .TRUE. )
- CALL LES_MEAN_SUBGRID( MYF(GY_M_V(KKA,KKU,KKL,PTHLM,PDYY,PDZZ,PDZY)&
- *MZF(ZFLXZ)), X_LES_RES_ddxa_Thl_SBG_UaW , .TRUE. )
- IF (KRR>=1) THEN
- CALL LES_MEAN_SUBGRID( MYF(GY_V_M(PRM(:,:,:,1),PDYY,PDZZ,&
- PDZY)*MZF(ZFLXZ)),X_LES_RES_ddxa_Rt_SBG_UaW , .TRUE. )
- END IF
- CALL SECOND_MNH(ZTIME2)
- XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
- END IF
- !
-END IF
-!
-!
-!----------------------------------------------------------------------------
-!
-!* 7. DIAGNOSTIC COMPUTATION OF THE 1D <W W> VARIANCE
-! -----------------------------------------------
-!
-IF ( OTURB_FLX .AND. TPFILE%LOPENED .AND. HTURBDIM == '1DIM') THEN
- ZFLXZ(:,:,:)= (2./3.) * PTKEM(:,:,:) &
- -XCMFS*PLM(:,:,:)*SQRT(PTKEM(:,:,:))*GZ_W_M(PWM,PDZZ)
- ! to be tested &
- ! +XCMFB*(4./3.)*PLM(:,:,:)/SQRT(PTKEM(:,:,:))*PTP(:,:,:)
- ! stores the W variance
- TZFIELD%CMNHNAME = 'W_VVAR'
- TZFIELD%CSTDNAME = ''
- TZFIELD%CLONGNAME = 'W_VVAR'
- TZFIELD%CUNITS = 'm2 s-2'
- TZFIELD%CDIR = 'XY'
- TZFIELD%CCOMMENT = 'X_Y_Z_W_VVAR'
- TZFIELD%NGRID = 1
- TZFIELD%NTYPE = TYPEREAL
- TZFIELD%NDIMS = 3
- TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_Field_write(TPFILE,TZFIELD,ZFLXZ)
-END IF
-!
-!----------------------------------------------------------------------------
-!
-IF (LHOOK) CALL DR_HOOK('TURB_VER_DYN_FLUX',1,ZHOOK_HANDLE)
-END SUBROUTINE TURB_VER_DYN_FLUX
diff --git a/src/mesonh/turb/turb_ver_sv_corr.f90 b/src/mesonh/turb/turb_ver_sv_corr.f90
deleted file mode 100644
index 6676e227c..000000000
--- a/src/mesonh/turb/turb_ver_sv_corr.f90
+++ /dev/null
@@ -1,229 +0,0 @@
-!MNH_LIC Copyright 2002-2020 CNRS, Meteo-France and Universite Paul Sabatier
-!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!MNH_LIC for details. version 1.
-!-----------------------------------------------------------------
-! ####################
- MODULE MODI_TURB_VER_SV_CORR
-! ####################
-!
-INTERFACE
-!
- SUBROUTINE TURB_VER_SV_CORR(KKA,KKU,KKL,KRR,KRRL,KRRI, &
- PDZZ, &
- PTHLM,PRM,PTHVREF, &
- PLOCPEXNM,PATHETA,PAMOIST,PSRCM,PPHI3,PPSI3, &
- PWM,PSVM, &
- PTKEM,PLM,PLEPS,PPSI_SV )
-!
-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
-INTEGER, INTENT(IN) :: KRR ! number of moist var.
-INTEGER, INTENT(IN) :: KRRL ! number of liquid var.
-INTEGER, INTENT(IN) :: KRRI ! number of ice var.
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ
- ! Metric coefficients
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHLM ! potential temperature at t-Delta t
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRM ! Mixing ratios at t-Delta t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHVREF ! reference Thv
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLOCPEXNM ! Lv(T)/Cp/Exnref at time t-1
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PATHETA ! coefficients between
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PAMOIST ! s and Thetal and Rnp
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRCM ! normalized
- ! 2nd-order flux s'r'c/2Sigma_s2 at t-1 multiplied by Lambda_3
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPHI3 ! Inv.Turb.Sch.for temperature
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPSI3 ! Inv.Turb.Sch.for humidity
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PWM ! w at time t
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVM ! scalar var. at t-Delta t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKEM ! TKE at time t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLM ! Turb. mixing length
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLEPS ! dissipative length
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PPSI_SV ! Inv.Turb.Sch.for scalars
- ! cumulated sources for the prognostic variables
-!
-!
-END SUBROUTINE TURB_VER_SV_CORR
-!
-END INTERFACE
-!
-END MODULE MODI_TURB_VER_SV_CORR
-!
-!
-! ###############################################################
- SUBROUTINE TURB_VER_SV_CORR(KKA,KKU,KKL,KRR,KRRL,KRRI, &
- PDZZ, &
- PTHLM,PRM,PTHVREF, &
- PLOCPEXNM,PATHETA,PAMOIST,PSRCM,PPHI3,PPSI3, &
- PWM,PSVM, &
- PTKEM,PLM,PLEPS,PPSI_SV )
-! ###############################################################
-!
-!
-!!**** *TURB_VER_SV_CORR* -compute the subgrid Sv2 and SvThv terms
-!!
-!! PURPOSE
-!! -------
-!!
-!!
-!! EXTERNAL
-!! --------
-!!
-!! FUNCTIONs ETHETA and EMOIST :
-!! allows to compute:
-!! - the coefficients for the turbulent correlation between
-!! any variable and the virtual potential temperature, of its
-!! correlations with the conservative potential temperature and
-!! the humidity conservative variable:
-!! ------- ------- -------
-!! A' Thv' = ETHETA A' Thl' + EMOIST A' Rnp'
-!!
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!! REFERENCE
-!! ---------
-!!
-!! AUTHOR
-!! ------
-!! V. Masson * Meteo-France *
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original October 29, 2002
-!! JP Pinty Feb 20, 2003 Add PFRAC_ICE
-!!--------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE PARKIND1, ONLY : JPRB
-USE YOMHOOK , ONLY : LHOOK, DR_HOOK
-!
-USE MODD_CST
-USE MODD_CTURB
-USE MODD_PARAMETERS
-USE MODD_LES
-USE MODD_CONF
-USE MODD_NSV, ONLY : NSV,NSV_LGBEG,NSV_LGEND
-USE MODD_BLOWSNOW
-!
-!
-USE MODI_GRADIENT_U
-USE MODI_GRADIENT_V
-USE MODI_GRADIENT_W
-USE MODI_GRADIENT_M
-USE MODI_SHUMAN , ONLY : MZF
-USE MODI_EMOIST
-USE MODI_ETHETA
-USE MODI_LES_MEAN_SUBGRID
-!
-USE MODI_SECOND_MNH
-!
-IMPLICIT NONE
-!
-!* 0.1 declarations of arguments
-!
-!
-!
-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
-INTEGER, INTENT(IN) :: KRR ! number of moist var.
-INTEGER, INTENT(IN) :: KRRL ! number of liquid var.
-INTEGER, INTENT(IN) :: KRRI ! number of ice var.
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ
- ! Metric coefficients
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHLM ! potential temperature at t-Delta t
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRM ! Mixing ratios at t-Delta t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHVREF ! reference Thv
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLOCPEXNM ! Lv(T)/Cp/Exnref at time t-1
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PATHETA ! coefficients between
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PAMOIST ! s and Thetal and Rnp
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRCM ! normalized
- ! 2nd-order flux s'r'c/2Sigma_s2 at t-1 multiplied by Lambda_3
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPHI3 ! Inv.Turb.Sch.for temperature
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPSI3 ! Inv.Turb.Sch.for humidity
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PWM ! w at time t
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVM ! scalar var. at t-Delta t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKEM ! TKE at time t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLM ! Turb. mixing length
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLEPS ! dissipative length
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PPSI_SV ! Inv.Turb.Sch.for scalars
- ! cumulated sources for the prognostic variables
-!
-!
-!
-!
-!* 0.2 declaration of local variables
-!
-!
-REAL, DIMENSION(SIZE(PSVM,1),SIZE(PSVM,2),SIZE(PSVM,3)) :: &
- ZA, ZFLXZ
-!
-REAL :: ZCSV !constant for the scalar flux
-!
-INTEGER :: JSV ! loop counters
-!
-REAL :: ZTIME1, ZTIME2
-!
-REAL :: ZCSVD = 1.2 ! constant for scalar variance dissipation
-REAL :: ZCTSVD = 2.4 ! constant for temperature - scalar covariance dissipation
-REAL :: ZCQSVD = 2.4 ! constant for humidity - scalar covariance dissipation
-!----------------------------------------------------------------------------
-!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-IF (LHOOK) CALL DR_HOOK('TURB_VER_SV_CORR',0,ZHOOK_HANDLE)
-CALL SECOND_MNH(ZTIME1)
-!
-IF(LBLOWSNOW) THEN
-! See Vionnet (PhD, 2012) for a complete discussion around the value of the Schmidt number for blowing snow variables
- ZCSV= XCHF/XRSNOW
-ELSE
- ZCSV= XCHF
-ENDIF
-!
-DO JSV=1,NSV
- !
- IF (LNOMIXLG .AND. JSV >= NSV_LGBEG .AND. JSV<= NSV_LGEND) CYCLE
- !
- ! variance Sv2
- !
- IF (LLES_CALL) THEN
- ! approximation: diagnosed explicitely (without implicit term)
- ZFLXZ(:,:,:) = PPSI_SV(:,:,:,JSV)*GZ_M_W(KKA,KKU,KKL,PSVM(:,:,:,JSV),PDZZ)**2
- ZFLXZ(:,:,:) = ZCSV / ZCSVD * PLM * PLEPS * MZF(ZFLXZ(:,:,:) )
- CALL LES_MEAN_SUBGRID( -2.*ZCSVD*SQRT(PTKEM)*ZFLXZ/PLEPS, X_LES_SUBGRID_DISS_Sv2(:,:,:,JSV) )
- CALL LES_MEAN_SUBGRID( MZF(PWM)*ZFLXZ, X_LES_RES_W_SBG_Sv2(:,:,:,JSV) )
- END IF
- !
- ! covariance ThvSv
- !
- IF (LLES_CALL) THEN
- ! approximation: diagnosed explicitely (without implicit term)
- ZA(:,:,:) = ETHETA(KRR,KRRI,PTHLM,PRM,PLOCPEXNM,PATHETA,PSRCM)
- ZFLXZ(:,:,:)= ( XCSHF * PPHI3 + ZCSV * PPSI_SV(:,:,:,JSV) ) &
- * GZ_M_W(KKA,KKU,KKL,PTHLM,PDZZ) &
- * GZ_M_W(KKA,KKU,KKL,PSVM(:,:,:,JSV),PDZZ)
- ZFLXZ(:,:,:)= PLM * PLEPS / (2.*ZCTSVD) * MZF(ZFLXZ)
- CALL LES_MEAN_SUBGRID( ZA*ZFLXZ, X_LES_SUBGRID_SvThv(:,:,:,JSV) )
- CALL LES_MEAN_SUBGRID( -XG/PTHVREF/3.*ZA*ZFLXZ, X_LES_SUBGRID_SvPz(:,:,:,JSV), .TRUE.)
- !
- IF (KRR>=1) THEN
- ZA(:,:,:) = EMOIST(KRR,KRRI,PTHLM,PRM,PLOCPEXNM,PAMOIST,PSRCM)
- ZFLXZ(:,:,:)= ( XCHF * PPSI3 + ZCSV * PPSI_SV(:,:,:,JSV) ) &
- * GZ_M_W(KKA,KKU,KKL,PRM(:,:,:,1),PDZZ) &
- * GZ_M_W(KKA,KKU,KKL,PSVM(:,:,:,JSV),PDZZ)
- ZFLXZ(:,:,:)= PLM * PLEPS / (2.*ZCQSVD) * MZF(ZFLXZ)
- CALL LES_MEAN_SUBGRID( ZA*ZFLXZ, X_LES_SUBGRID_SvThv(:,:,:,JSV) , .TRUE.)
- CALL LES_MEAN_SUBGRID( -XG/PTHVREF/3.*ZA*ZFLXZ, X_LES_SUBGRID_SvPz(:,:,:,JSV), .TRUE.)
- END IF
- END IF
- !
-END DO ! end of scalar loop
-!
-CALL SECOND_MNH(ZTIME2)
-XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
-!----------------------------------------------------------------------------
-!
-IF (LHOOK) CALL DR_HOOK('TURB_VER_SV_CORR',1,ZHOOK_HANDLE)
-END SUBROUTINE TURB_VER_SV_CORR
diff --git a/src/mesonh/turb/turb_ver_sv_flux.f90 b/src/mesonh/turb/turb_ver_sv_flux.f90
deleted file mode 100644
index aa7010e43..000000000
--- a/src/mesonh/turb/turb_ver_sv_flux.f90
+++ /dev/null
@@ -1,500 +0,0 @@
-!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier
-!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!MNH_LIC for details. version 1.
-!-----------------------------------------------------------------
-! ####################
- MODULE MODI_TURB_VER_SV_FLUX
-! ####################
-!
-INTERFACE
-!
- SUBROUTINE TURB_VER_SV_FLUX(KKA,KKU,KKL, &
- OTURB_FLX,HTURBDIM, &
- PIMPL,PEXPL, &
- PTSTEP, &
- TPFILE, &
- PDZZ,PDIRCOSZW, &
- PRHODJ,PWM, &
- PSFSVM,PSFSVP, &
- PSVM, &
- PTKEM,PLM,MFMOIST,PPSI_SV, &
- PRSVS,PWSV )
-!
-USE MODD_IO, ONLY: TFILEDATA
-!
-INTEGER, INTENT(IN) :: KKA !near ground array index
-INTEGER, INTENT(IN) :: KKU !uppest atmosphere array index
-INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=AR
-LOGICAL, INTENT(IN) :: OTURB_FLX ! switch to write the
- ! turbulent fluxes in the syncronous FM-file
-CHARACTER(len=4), INTENT(IN) :: HTURBDIM ! dimensionality of the
- ! turbulence scheme
-REAL, INTENT(IN) :: PIMPL, PEXPL ! Coef. for temporal disc.
-REAL, INTENT(IN) :: PTSTEP ! Double Time Step
-TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ
- ! Metric coefficients
-REAL, DIMENSION(:,:), INTENT(IN) :: PDIRCOSZW ! Director Cosinus of the
- ! normal to the ground surface
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! dry density * grid volum
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSFSVM ! t - deltat
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSFSVP ! t + deltat
-!
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVM ! scalar var. at t-Delta t
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PWM ! vertical wind
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKEM ! TKE at time t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLM ! Turb. mixing length
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PPSI_SV ! Inv.Turb.Sch.for scalars
-!
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRSVS
- ! cumulated sources for the prognostic variables
-REAL, DIMENSION(:,:,:,:), INTENT(OUT) :: PWSV ! scalar flux
-
-!
-!
-END SUBROUTINE TURB_VER_SV_FLUX
-!
-END INTERFACE
-!
-END MODULE MODI_TURB_VER_SV_FLUX
-!
-!
-! ###############################################################
- SUBROUTINE TURB_VER_SV_FLUX(KKA,KKU,KKL, &
- OTURB_FLX,HTURBDIM, &
- PIMPL,PEXPL, &
- PTSTEP, &
- TPFILE, &
- PDZZ,PDIRCOSZW, &
- PRHODJ,PWM, &
- PSFSVM,PSFSVP, &
- PSVM, &
- PTKEM,PLM,PPSI_SV, &
- PRSVS,PWSV )
-!
-
-!
-!
-!!**** *TURB_VER_SV_FLUX* -compute the source terms due to the vertical turbulent
-!! fluxes.
-!!
-!! PURPOSE
-!! -------
-! The purpose of this routine is to compute the vertical turbulent
-! fluxes of the evolutive variables and give back the source
-! terms to the main program. In the case of large horizontal meshes,
-! the divergence of these vertical turbulent fluxes represent the whole
-! effect of the turbulence but when the three-dimensionnal version of
-! the turbulence scheme is activated (CTURBDIM="3DIM"), these divergences
-! are completed in the next routine TURB_HOR.
-! An arbitrary degree of implicitness has been implemented for the
-! temporal treatment of these diffusion terms.
-! The vertical boundary conditions are as follows:
-! * at the bottom, the surface fluxes are prescribed at the same
-! as the other turbulent fluxes
-! * at the top, the turbulent fluxes are set to 0.
-! It should be noted that the condensation has been implicitely included
-! in this turbulence scheme by using conservative variables and computing
-! the subgrid variance of a statistical variable s indicating the presence
-! or not of condensation in a given mesh.
-!
-!!** METHOD
-!! ------
-!! 1D type calculations are made;
-!! The vertical turbulent fluxes are computed in an off-centered
-!! implicit scheme (a Crank-Nicholson type with coefficients different
-!! than 0.5), which allows to vary the degree of implicitness of the
-!! formulation.
-!! The different prognostic variables are treated one by one.
-!! The contributions of each turbulent fluxes are cumulated into the
-!! tendency PRvarS, and into the dynamic and thermal production of
-!! TKE if necessary.
-!!
-!! In section 2 and 3, the thermodynamical fields are considered.
-!! Only the turbulent fluxes of the conservative variables
-!! (Thetal and Rnp stored in PRx(:,:,:,1)) are computed.
-!! Note that the turbulent fluxes at the vertical
-!! boundaries are given either by the soil scheme for the surface one
-!! ( at the same instant as the others fluxes) and equal to 0 at the
-!! top of the model. The thermal production is computed by vertically
-!! averaging the turbulent flux and multiply this flux at the mass point by
-!! a function ETHETA or EMOIST, which preform the transformation from the
-!! conservative variables to the virtual potential temperature.
-!!
-!! In section 4, the variance of the statistical variable
-!! s indicating presence or not of condensation, is determined in function
-!! of the turbulent moments of the conservative variables and its
-!! squarred root is stored in PSIGS. This information will be completed in
-!! the horizontal turbulence if the turbulence dimensionality is not
-!! equal to "1DIM".
-!!
-!! In section 5, the x component of the stress tensor is computed.
-!! The surface flux <u'w'> is computed from the value of the surface
-!! fluxes computed in axes linked to the orography ( i", j" , k"):
-!! i" is parallel to the surface and in the direction of the maximum
-!! slope
-!! j" is also parallel to the surface and in the normal direction of
-!! the maximum slope
-!! k" is the normal to the surface
-!! In order to prevent numerical instability, the implicit scheme has
-!! been extended to the surface flux regarding to its dependence in
-!! function of U. The dependence in function of the other components
-!! introduced by the different rotations is only explicit.
-!! The turbulent fluxes are used to compute the dynamic production of
-!! TKE. For the last TKE level ( located at PDZZ(:,:,IKB)/2 from the
-!! ground), an harmonic extrapolation from the dynamic production at
-!! PDZZ(:,:,IKB) is used to avoid an evaluation of the gradient of U
-!! in the surface layer.
-!!
-!! In section 6, the same steps are repeated but for the y direction
-!! and in section 7, a diagnostic computation of the W variance is
-!! performed.
-!!
-!! In section 8, the turbulent fluxes for the scalar variables are
-!! computed by the same way as the conservative thermodynamical variables
-!!
-!!
-!! EXTERNAL
-!! --------
-!! GX_U_M, GY_V_M, GZ_W_M : cartesian gradient operators
-!! GX_U_UW,GY_V_VW (X,Y,Z) represent the direction of the gradient
-!! _(M,U,...)_ represent the localization of the
-!! field to be derivated
-!! _(M,UW,...) represent the localization of the
-!! field derivated
-!!
-!!
-!! MXM,MXF,MYM,MYF,MZM,MZF
-!! : Shuman functions (mean operators)
-!! DXF,DYF,DZF,DZM
-!! : Shuman functions (difference operators)
-!!
-!! SUBROUTINE TRIDIAG : to compute the split implicit evolution
-!! of a variable located at a mass point
-!!
-!! SUBROUTINE TRIDIAG_WIND: to compute the split implicit evolution
-!! of a variable located at a wind point
-!!
-!! FUNCTIONs ETHETA and EMOIST :
-!! allows to compute:
-!! - the coefficients for the turbulent correlation between
-!! any variable and the virtual potential temperature, of its
-!! correlations with the conservative potential temperature and
-!! the humidity conservative variable:
-!! ------- ------- -------
-!! A' Thv' = ETHETA A' Thl' + EMOIST A' Rnp'
-!!
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!! Module MODD_CST : contains physical constants
-!!
-!! XG : gravity constant
-!!
-!! Module MODD_CTURB: contains the set of constants for
-!! the turbulence scheme
-!!
-!! XCMFS,XCMFB : cts for the momentum flux
-!! XCSHF : ct for the sensible heat flux
-!! XCHF : ct for the moisture flux
-!! XCTV,XCHV : cts for the T and moisture variances
-!!
-!! Module MODD_PARAMETERS
-!!
-!! JPVEXT_TURB : number of vertical external points
-!! JPHEXT : number of horizontal external points
-!!
-!!
-!! REFERENCE
-!! ---------
-!! Book 1 of documentation (Chapter: Turbulence)
-!!
-!! AUTHOR
-!! ------
-!! Joan Cuxart * INM and Meteo-France *
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original August 19, 1994
-!! Modifications: February 14, 1995 (J.Cuxart and J.Stein)
-!! Doctorization and Optimization
-!! Modifications: March 21, 1995 (J.M. Carriere)
-!! Introduction of cloud water
-!! Modifications: June 14, 1995 (J.Cuxart and J. Stein)
-!! Phi3 and Psi3 at w-point + bug in the all
-!! or nothing condens.
-!! Modifications: Sept 15, 1995 (J.Cuxart and J. Stein)
-!! Change the DP computation at the ground
-!! Modifications: October 10, 1995 (J.Cuxart and J. Stein)
-!! Psi for scal var and LES tools
-!! Modifications: November 10, 1995 (J. Stein)
-!! change the surface relations
-!! Modifications: February 20, 1995 (J. Stein) optimization
-!! Modifications: May 21, 1996 (J. Stein)
-!! bug in the vertical flux of the V wind
-!! component for explicit computation
-!! Modifications: May 21, 1996 (N. wood)
-!! modify the computation of the vertical
-!! part or the surface tangential flux
-!! Modifications: May 21, 1996 (P. Jabouille)
-!! same modification in the Y direction
-!!
-!! Modifications: Sept 17, 1996 (J. Stein) change the moist case by using
-!! Pi instead of Piref + use Atheta and Amoist
-!!
-!! Modifications: Nov 24, 1997 (V. Masson) removes the DO loops
-!! Modifications: Mar 31, 1998 (V. Masson) splits the routine TURB_VER_SV_FLUX
-!! Modifications: Dec 01, 2000 (V. Masson) conservation of scalar emission
-!! from surface in 1DIM case
-!! when slopes are present
-!! Jun 20, 2001 (J Stein) case of lagragian variables
-!! Nov 06, 2002 (V. Masson) LES budgets
-!! October 2009 (G. Tanguy) add ILENCH=LEN(YCOMMENT) after
-!! change of YCOMMENT
-!! Feb 2012(Y. Seity) add possibility to run with reversed
-!! vertical levels
-!! Modifications: July 2015 (Wim de Rooy) LHARAT switch
-!! Feb 2017(M. Leriche) add initialisation of ZSOURCE
-!! to avoid unknwon values outside physical domain
-!! and avoid negative values in sv tendencies
-!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
-!!--------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE PARKIND1, ONLY : JPRB
-USE YOMHOOK , ONLY : LHOOK, DR_HOOK
-!
-USE MODD_CST
-USE MODD_CTURB
-USE MODD_FIELD, ONLY: TFIELDDATA, TYPEREAL
-USE MODD_IO, ONLY: TFILEDATA
-USE MODD_PARAMETERS
-USE MODD_LES
-USE MODD_CONF
-USE MODD_NSV, ONLY: XSVMIN, NSV_LGBEG, NSV_LGEND
-USE MODD_BLOWSNOW
-USE MODE_IO_FIELD_WRITE, ONLY: IO_FIELD_WRITE
-!
-USE MODI_GRADIENT_U
-USE MODI_GRADIENT_V
-USE MODI_GRADIENT_W
-USE MODI_GRADIENT_M
-USE MODI_SHUMAN , ONLY : DZM, MZM, MZF
-USE MODI_TRIDIAG
-USE MODI_TRIDIAG_WIND
-USE MODI_EMOIST
-USE MODI_ETHETA
-USE MODI_LES_MEAN_SUBGRID
-!
-USE MODI_SECOND_MNH
-!
-IMPLICIT NONE
-!
-!* 0.1 declarations of arguments
-!
-!
-INTEGER, INTENT(IN) :: KKA !near ground array index
-INTEGER, INTENT(IN) :: KKU !uppest atmosphere array index
-INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=ARO
-LOGICAL, INTENT(IN) :: OTURB_FLX ! switch to write the
- ! turbulent fluxes in the syncronous FM-file
-CHARACTER(len=4), INTENT(IN) :: HTURBDIM ! dimensionality of the
- ! turbulence scheme
-REAL, INTENT(IN) :: PIMPL, PEXPL ! Coef. for temporal disc.
-REAL, INTENT(IN) :: PTSTEP ! Double Time Step
-TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ
- ! Metric coefficients
-REAL, DIMENSION(:,:), INTENT(IN) :: PDIRCOSZW ! Director Cosinus of the
- ! normal to the ground surface
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! dry density * grid volum
-REAL, DIMENSION(:,:,:), INTENT(IN) :: MFMOIST ! moist mf dual scheme
-
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSFSVM ! t - deltat
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSFSVP ! t + deltat
-!
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVM ! scalar var. at t-Delta t
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PWM ! vertical wind
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKEM ! TKE at time t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLM ! Turb. mixing length
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PPSI_SV ! Inv.Turb.Sch.for scalars
-!
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRSVS
- ! cumulated sources for the prognostic variables
-REAL, DIMENSION(:,:,:,:), INTENT(OUT) :: PWSV ! scalar flux
-!
-!
-!
-!
-!* 0.2 declaration of local variables
-!
-!
-REAL, DIMENSION(SIZE(PSVM,1),SIZE(PSVM,2),SIZE(PSVM,3)) :: &
- ZA, & ! under diagonal elements of the tri-diagonal matrix involved
- ! in the temporal implicit scheme (also used to store coefficient
- ! J in Section 5)
- ZRES, & ! guess of the treated variable at t+ deltat when the turbu-
- ! lence is the only source of evolution added to the ones
- ! considered in ZSOURCE
- ZFLXZ, & ! vertical flux of the treated variable
- ZSOURCE, & ! source of evolution for the treated variable
- ZKEFF ! effectif diffusion coeff = LT * SQRT( TKE )
-INTEGER :: IKB,IKE ! I index values for the Beginning and End
- ! mass points of the domain in the 3 direct.
-INTEGER :: IKT ! array size in k direction
-INTEGER :: IKTB,IKTE ! start, end of k loops in physical domain
-INTEGER :: JSV ! loop counters
-INTEGER :: JK ! loop
-INTEGER :: ISV ! number of scalar var.
-!
-REAL :: ZTIME1, ZTIME2
-
-REAL :: ZCSVP = 4.0 ! constant for scalar flux presso-correlation (RS81)
-REAL :: ZCSV !constant for the scalar flux
-!
-TYPE(TFIELDDATA) :: TZFIELD
-!----------------------------------------------------------------------------
-!
-!* 1. PRELIMINARIES
-! -------------
-!
-
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-IF (LHOOK) CALL DR_HOOK('TURB_VER_SV_FLUX',0,ZHOOK_HANDLE)
-IKB=KKA+JPVEXT_TURB*KKL
-IKE=KKU-JPVEXT_TURB*KKL
-IKT=SIZE(PSVM,3)
-IKTE =IKT-JPVEXT_TURB
-IKTB =1+JPVEXT_TURB
-!
-ISV=SIZE(PSVM,4)
-!
-ZKEFF(:,:,:) = MZM( PLM(:,:,:) * SQRT(PTKEM(:,:,:)) )
-!
-IF(LBLOWSNOW) THEN
-! See Vionnet (PhD, 2012) for a complete discussion around the value of the Schmidt number for blowing snow variables
- ZCSV= XCHF/XRSNOW
-ELSE
- ZCSV= XCHF
-ENDIF
-!----------------------------------------------------------------------------
-!
-!* 8. SOURCES OF PASSIVE SCALAR VARIABLES
-! -----------------------------------
-!
-DO JSV=1,ISV
-!
- IF (LNOMIXLG .AND. JSV >= NSV_LGBEG .AND. JSV<= NSV_LGEND) CYCLE
-!
-! Preparation of the arguments for TRIDIAG
- ZA(:,:,:) = -PTSTEP*ZCSV*PPSI_SV(:,:,:,JSV) * &
- ZKEFF * MZM(PRHODJ) / &
- PDZZ**2
- ZSOURCE(:,:,:) = 0.
-!
-! Compute the sources for the JSVth scalar variable
-
-!* in 3DIM case, a part of the flux goes vertically, and another goes horizontally
-! (in presence of slopes)
-!* in 1DIM case, the part of energy released in horizontal flux
-! is taken into account in the vertical part
- IF (HTURBDIM=='3DIM') THEN
- ZSOURCE(:,:,IKB) = (PIMPL*PSFSVP(:,:,JSV) + PEXPL*PSFSVM(:,:,JSV)) / &
- PDZZ(:,:,IKB) * PDIRCOSZW(:,:) &
- * 0.5 * (1. + PRHODJ(:,:,KKA) / PRHODJ(:,:,IKB))
- ELSE
-
- ZSOURCE(:,:,IKB) = (PIMPL*PSFSVP(:,:,JSV) + PEXPL*PSFSVM(:,:,JSV)) / &
- PDZZ(:,:,IKB) / PDIRCOSZW(:,:) &
- * 0.5 * (1. + PRHODJ(:,:,KKA) / PRHODJ(:,:,IKB))
- END IF
- ZSOURCE(:,:,IKTB+1:IKTE-1) = 0.
- ZSOURCE(:,:,IKE) = 0.
-!
-! Obtention of the split JSV scalar variable at t+ deltat
- CALL TRIDIAG(KKA,KKU,KKL,PSVM(:,:,:,JSV),ZA,PTSTEP,PEXPL,PIMPL,PRHODJ,ZSOURCE,ZRES)
-!
-! Compute the equivalent tendency for the JSV scalar variable
- PRSVS(:,:,:,JSV)= PRSVS(:,:,:,JSV)+ &
- PRHODJ(:,:,:)*(ZRES(:,:,:)-PSVM(:,:,:,JSV))/PTSTEP
-! PRSVS(:,:,:,JSV)= MAX((PRSVS(:,:,:,JSV)+ &
-! PRHODJ(:,:,:)*(ZRES(:,:,:)-PSVM(:,:,:,JSV))/PTSTEP),XSVMIN(JSV))
-!
- IF ( (OTURB_FLX .AND. TPFILE%LOPENED) .OR. LLES_CALL ) THEN
- ! Diagnostic of the cartesian vertical flux
- !
- ZFLXZ(:,:,:) = -ZCSV * PPSI_SV(:,:,:,JSV) * MZM(PLM*SQRT(PTKEM)) / PDZZ * &
- DZM( PIMPL*ZRES(:,:,:) + PEXPL*PSVM(:,:,:,JSV) )
- ! surface flux
- !* in 3DIM case, a part of the flux goes vertically, and another goes horizontally
- ! (in presence of slopes)
- !* in 1DIM case, the part of energy released in horizontal flux
- ! is taken into account in the vertical part
- IF (HTURBDIM=='3DIM') THEN
- ZFLXZ(:,:,IKB) = (PIMPL*PSFSVP(:,:,JSV) + PEXPL*PSFSVM(:,:,JSV)) &
- * PDIRCOSZW(:,:)
- ELSE
- ZFLXZ(:,:,IKB) = (PIMPL*PSFSVP(:,:,JSV) + PEXPL*PSFSVM(:,:,JSV)) &
- / PDIRCOSZW(:,:)
- END IF
- ! extrapolates the flux under the ground so that the vertical average with
- ! the IKB flux gives the ground value
- ZFLXZ(:,:,KKA) = ZFLXZ(:,:,IKB)
- DO JK=IKTB+1,IKTE-1
- PWSV(:,:,JK,JSV)=0.5*(ZFLXZ(:,:,JK)+ZFLXZ(:,:,JK+KKL))
- END DO
- PWSV(:,:,IKB,JSV)=0.5*(ZFLXZ(:,:,IKB)+ZFLXZ(:,:,IKB+KKL))
- PWSV(:,:,IKE,JSV)=PWSV(:,:,IKE-KKL,JSV)
- END IF
- !
- IF (OTURB_FLX .AND. TPFILE%LOPENED) THEN
- ! stores the JSVth vertical flux
- WRITE(TZFIELD%CMNHNAME,'("WSV_FLX_",I3.3)') JSV
- TZFIELD%CSTDNAME = ''
- TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
- !PW: TODO: use the correct units of the JSV variable (and multiply it by m s-1)
- TZFIELD%CUNITS = 'SVUNIT m s-1'
- TZFIELD%CDIR = 'XY'
- TZFIELD%CCOMMENT = 'X_Y_Z_'//TRIM(TZFIELD%CMNHNAME)
- TZFIELD%NGRID = 4
- TZFIELD%NTYPE = TYPEREAL
- TZFIELD%NDIMS = 3
- TZFIELD%LTIMEDEP = .TRUE.
- !
- CALL IO_Field_write(TPFILE,TZFIELD,ZFLXZ)
- END IF
- !
- ! Storage in the LES configuration
- !
- IF (LLES_CALL) THEN
- CALL SECOND_MNH(ZTIME1)
- CALL LES_MEAN_SUBGRID( MZF(ZFLXZ), X_LES_SUBGRID_WSv(:,:,:,JSV) )
- CALL LES_MEAN_SUBGRID( GZ_W_M(PWM,PDZZ)*MZF(ZFLXZ), &
- X_LES_RES_ddxa_W_SBG_UaSv(:,:,:,JSV) )
- CALL LES_MEAN_SUBGRID( MZF(GZ_M_W(KKA,KKU,KKL,PSVM(:,:,:,JSV),PDZZ)*ZFLXZ), &
- X_LES_RES_ddxa_Sv_SBG_UaSv(:,:,:,JSV) )
- CALL LES_MEAN_SUBGRID( -ZCSVP*SQRT(PTKEM)/PLM*MZF(ZFLXZ), X_LES_SUBGRID_SvPz(:,:,:,JSV) )
- CALL LES_MEAN_SUBGRID( MZF(PWM*ZFLXZ), X_LES_RES_W_SBG_WSv(:,:,:,JSV) )
- CALL SECOND_MNH(ZTIME2)
- XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
- END IF
- !
-END DO ! end of scalar loop
-!
-!----------------------------------------------------------------------------
-!
-IF (LHOOK) CALL DR_HOOK('TURB_VER_SV_FLUX',1,ZHOOK_HANDLE)
-END SUBROUTINE TURB_VER_SV_FLUX
diff --git a/src/mesonh/turb/turb_ver_thermo_corr.f90 b/src/mesonh/turb/turb_ver_thermo_corr.f90
deleted file mode 100644
index 6edf5c724..000000000
--- a/src/mesonh/turb/turb_ver_thermo_corr.f90
+++ /dev/null
@@ -1,756 +0,0 @@
-!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier
-!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!MNH_LIC for details. version 1.
-!-----------------------------------------------------------------
-! ####################
- MODULE MODI_TURB_VER_THERMO_CORR
-! ####################
-!
-INTERFACE
-!
- SUBROUTINE TURB_VER_THERMO_CORR(KKA,KKU,KKL,KRR,KRRL,KRRI, &
- OTURB_FLX,HTURBDIM,HTOM, &
- PIMPL,PEXPL, &
- TPFILE, &
- PDXX,PDYY,PDZZ,PDZX,PDZY,PDIRCOSZW, &
- PRHODJ,PTHVREF, &
- PSFTHM,PSFRM,PSFTHP,PSFRP, &
- PWM,PTHLM,PRM,PSVM, &
- PTKEM,PLM,PLEPS, &
- PLOCPEXNM,PATHETA,PAMOIST,PSRCM, &
- PBETA, PSQRT_TKE, PDTH_DZ, PDR_DZ, PRED2TH3, &
- PRED2R3, PRED2THR3, PBLL_O_E, PETHETA, &
- PEMOIST, PREDTH1, PREDR1, PPHI3, PPSI3, PD, &
- PFWTH,PFWR,PFTH2,PFR2,PFTHR, &
- PTHLP,PRP,MFMOIST,PSIGS )
-! ###############################################################
-!
-!
-!!**** *TURB_VER_THERMO_FLUX* -compute the source terms due to the vertical turbulent
-!! fluxes.
-!!
-!! PURPOSE
-!! -------
-! The purpose of this routine is to compute the vertical turbulent
-! fluxes of the evolutive variables and give back the source
-! terms to the main program. In the case of large horizontal meshes,
-! the divergence of these vertical turbulent fluxes represent the whole
-! effect of the turbulence but when the three-dimensionnal version of
-! the turbulence scheme is activated (CTURBDIM="3DIM"), these divergences
-! are completed in the next routine TURB_HOR.
-! An arbitrary degree of implicitness has been implemented for the
-! temporal treatment of these diffusion terms.
-! The vertical boundary conditions are as follows:
-! * at the bottom, the surface fluxes are prescribed at the same
-! as the other turbulent fluxes
-! * at the top, the turbulent fluxes are set to 0.
-! It should be noted that the condensation has been implicitely included
-! in this turbulence scheme by using conservative variables and computing
-! the subgrid variance of a statistical variable s indicating the presence
-! or not of condensation in a given mesh.
-!
-!!** METHOD
-!! ------
-!! 1D type calculations are made;
-!! The vertical turbulent fluxes are computed in an off-centered
-!! implicit scheme (a Crank-Nicholson type with coefficients different
-!! than 0.5), which allows to vary the degree of implicitness of the
-!! formulation.
-!! The different prognostic variables are treated one by one.
-!! The contributions of each turbulent fluxes are cumulated into the
-!! tendency PRvarS, and into the dynamic and thermal production of
-!! TKE if necessary.
-!!
-!! In section 2 and 3, the thermodynamical fields are considered.
-!! Only the turbulent fluxes of the conservative variables
-!! (Thetal and Rnp stored in PRx(:,:,:,1)) are computed.
-!! Note that the turbulent fluxes at the vertical
-!! boundaries are given either by the soil scheme for the surface one
-!! ( at the same instant as the others fluxes) and equal to 0 at the
-!! top of the model. The thermal production is computed by vertically
-!! averaging the turbulent flux and multiply this flux at the mass point by
-!! a function ETHETA or EMOIST, which preform the transformation from the
-!! conservative variables to the virtual potential temperature.
-!!
-!! In section 4, the variance of the statistical variable
-!! s indicating presence or not of condensation, is determined in function
-!! of the turbulent moments of the conservative variables and its
-!! squarred root is stored in PSIGS. This information will be completed in
-!! the horizontal turbulence if the turbulence dimensionality is not
-!! equal to "1DIM".
-!!
-!! In section 5, the x component of the stress tensor is computed.
-!! The surface flux <u'w'> is computed from the value of the surface
-!! fluxes computed in axes linked to the orography ( i", j" , k"):
-!! i" is parallel to the surface and in the direction of the maximum
-!! slope
-!! j" is also parallel to the surface and in the normal direction of
-!! the maximum slope
-!! k" is the normal to the surface
-!! In order to prevent numerical instability, the implicit scheme has
-!! been extended to the surface flux regarding to its dependence in
-!! function of U. The dependence in function of the other components
-!! introduced by the different rotations is only explicit.
-!! The turbulent fluxes are used to compute the dynamic production of
-!! TKE. For the last TKE level ( located at PDZZ(:,:,IKB)/2 from the
-!! ground), an harmonic extrapolation from the dynamic production at
-!! PDZZ(:,:,IKB) is used to avoid an evaluation of the gradient of U
-!! in the surface layer.
-!!
-!! In section 6, the same steps are repeated but for the y direction
-!! and in section 7, a diagnostic computation of the W variance is
-!! performed.
-!!
-!! In section 8, the turbulent fluxes for the scalar variables are
-!! computed by the same way as the conservative thermodynamical variables
-!!
-!!
-!! EXTERNAL
-!! --------
-!! GX_U_M, GY_V_M, GZ_W_M : cartesian gradient operators
-!! GX_U_UW,GY_V_VW (X,Y,Z) represent the direction of the gradient
-!! _(M,U,...)_ represent the localization of the
-!! field to be derivated
-!! _(M,UW,...) represent the localization of the
-!! field derivated
-!!
-!!
-!! MXM,MXF,MYM,MYF,MZM,MZF
-!! : Shuman functions (mean operators)
-!! DXF,DYF,DZF,DZM
-!! : Shuman functions (difference operators)
-!!
-!! SUBROUTINE TRIDIAG : to compute the split implicit evolution
-!! of a variable located at a mass point
-!!
-!! SUBROUTINE TRIDIAG_WIND: to compute the split implicit evolution
-!! of a variable located at a wind point
-!!
-!! FUNCTIONs ETHETA and EMOIST :
-!! allows to compute:
-!! - the coefficients for the turbulent correlation between
-!! any variable and the virtual potential temperature, of its
-!! correlations with the conservative potential temperature and
-!! the humidity conservative variable:
-!! ------- ------- -------
-!! A' Thv' = ETHETA A' Thl' + EMOIST A' Rnp'
-!!
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!! Module MODD_CST : contains physical constants
-!!
-!! XG : gravity constant
-!!
-!! Module MODD_CTURB: contains the set of constants for
-!! the turbulence scheme
-!!
-!! XCMFS,XCMFB : cts for the momentum flux
-!! XCSHF : ct for the sensible heat flux
-!! XCHF : ct for the moisture flux
-!! XCTV,XCHV : cts for the T and moisture variances
-!!
-!! Module MODD_PARAMETERS
-!!
-!! JPVEXT_TURB : number of vertical external points
-!! JPHEXT : number of horizontal external points
-!!
-!!
-!! REFERENCE
-!! ---------
-!! Book 1 of documentation (Chapter: Turbulence)
-!!
-!! AUTHOR
-!! ------
-!! Joan Cuxart * INM and Meteo-France *
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original August 19, 1994
-!! Modifications: February 14, 1995 (J.Cuxart and J.Stein)
-!! Doctorization and Optimization
-!! Modifications: March 21, 1995 (J.M. Carriere)
-!! Introduction of cloud water
-!! Modifications: June 14, 1995 (J.Cuxart and J. Stein)
-!! Phi3 and Psi3 at w-point + bug in the all
-!! or nothing condens.
-!! Modifications: Sept 15, 1995 (J.Cuxart and J. Stein)
-!! Change the DP computation at the ground
-!! Modifications: October 10, 1995 (J.Cuxart and J. Stein)
-!! Psi for scal var and LES tools
-!! Modifications: November 10, 1995 (J. Stein)
-!! change the surface relations
-!! Modifications: February 20, 1995 (J. Stein) optimization
-!! Modifications: May 21, 1996 (J. Stein)
-!! bug in the vertical flux of the V wind
-!! component for explicit computation
-!! Modifications: May 21, 1996 (N. wood)
-!! modify the computation of the vertical
-!! part or the surface tangential flux
-!! Modifications: May 21, 1996 (P. Jabouille)
-!! same modification in the Y direction
-!!
-!! Modifications: Sept 17, 1996 (J. Stein) change the moist case by using
-!! Pi instead of Piref + use Atheta and Amoist
-!!
-!! Modifications: Nov 24, 1997 (V. Masson) removes the DO loops
-!! Modifications: Mar 31, 1998 (V. Masson) splits the routine TURB_VER_THERMO_FLUX
-!! Modifications: Oct 18, 2000 (V. Masson) LES computations
-!! Modifications: Dec 01, 2000 (V. Masson) conservation of energy from
-!! surface flux in 1DIM case
-!! when slopes are present
-!! Nov 06, 2002 (V. Masson) LES budgets
-!! October 2009 (G. Tanguy) add ILENCH=LEN(YCOMMENT) after
-!! change of YCOMMENT
-!! 2012-02 (Y. Seity) add possibility to run with reversed
-!! vertical levels
-!! Modifications July 2015 (Wim de Rooy) LHARAT switch
-!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
-!!--------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE PARKIND1, ONLY : JPRB
-USE YOMHOOK , ONLY : LHOOK, DR_HOOK
-USE MODD_CST
-USE MODD_CTURB
-USE MODD_FIELD, ONLY: TFIELDDATA, TYPEREAL
-USE MODD_IO, ONLY: TFILEDATA
-USE MODD_PARAMETERS
-USE MODD_CONF
-USE MODD_LES
-!
-USE MODI_GRADIENT_U
-USE MODI_GRADIENT_V
-USE MODI_GRADIENT_W
-USE MODI_GRADIENT_M
-USE MODI_SHUMAN , ONLY : DZM, MZM, MZF
-USE MODI_TRIDIAG
-USE MODI_LES_MEAN_SUBGRID
-USE MODI_PRANDTL
-USE MODI_TRIDIAG_THERMO
-!
-USE MODE_IO_FIELD_WRITE, only: IO_Field_write
-USE MODE_PRANDTL
-!
-USE MODI_SECOND_MNH
-!
-IMPLICIT NONE
-!
-!* 0.1 declarations of arguments
-!
-!
-!
-INTEGER, INTENT(IN) :: KKA !near ground array index
-INTEGER, INTENT(IN) :: KKU !uppest atmosphere array index
-INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=ARO
-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.
-LOGICAL, INTENT(IN) :: OTURB_FLX ! switch to write the
- ! turbulent fluxes in the syncronous FM-file
-CHARACTER(len=4), INTENT(IN) :: HTURBDIM ! dimensionality of the
- ! turbulence scheme
-CHARACTER(len=4), INTENT(IN) :: HTOM ! type of Third Order Moment
-REAL, INTENT(IN) :: PIMPL, PEXPL ! Coef. for temporal disc.
-TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ, PDXX, PDYY, PDZX, PDZY
- ! Metric coefficients
-REAL, DIMENSION(:,:), INTENT(IN) :: PDIRCOSZW ! Director Cosinus of the
- ! normal to the ground surface
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! dry density * grid volum
-REAL, DIMENSION(:,:,:), INTENT(IN) :: MFMOIST ! moist mass flux dual scheme
-
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHVREF ! ref. state Virtual
- ! Potential Temperature
-!
-REAL, DIMENSION(:,:), INTENT(IN) :: PSFTHM,PSFRM ! surface fluxes at time
-! ! t - deltat
-!
-REAL, DIMENSION(:,:), INTENT(IN) :: PSFTHP,PSFRP ! surface fluxes at time
-! ! t + deltat
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PWM
-! Vertical wind
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHLM
-! potential temperature at t-Delta t
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRM ! Mixing ratios
- ! at t-Delta t
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVM ! Mixing ratios
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKEM ! TKE at time t
-! In case LHARATU=TRUE, PLM already includes all stability corrections
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLM ! Turb. mixing length
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLEPS ! dissipative length
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLOCPEXNM ! Lv(T)/Cp/Exnref at time t-1
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PATHETA ! coefficients between
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PAMOIST ! s and Thetal and Rnp
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRCM ! normalized
-! 2nd-order flux s'r'c/2Sigma_s2 at t-1 multiplied by Lambda_3
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PBETA ! buoyancy coefficient
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSQRT_TKE ! sqrt(e)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDTH_DZ ! d(th)/dz
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDR_DZ ! d(rt)/dz
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRED2TH3 ! 3D Redeslperger number R*2_th
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRED2R3 ! 3D Redeslperger number R*2_r
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRED2THR3 ! 3D Redeslperger number R*2_thr
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PBLL_O_E ! beta * Lk * Leps / tke
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PETHETA ! Coefficient for theta in theta_v computation
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PEMOIST ! Coefficient for r in theta_v computation
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1 ! 1D Redelsperger number for Th
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1 ! 1D Redelsperger number for r
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPHI3 ! Prandtl number for temperature
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPSI3 ! Prandtl number for vapor
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PD ! Denominator in Prandtl numbers
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PFWTH ! d(w'2th' )/dz (at flux point)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PFWR ! d(w'2r' )/dz (at flux point)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PFTH2 ! d(w'th'2 )/dz (at mass point)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PFR2 ! d(w'r'2 )/dz (at mass point)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PFTHR ! d(w'th'r')/dz (at mass point)
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHLP ! guess of thl at t+ deltat
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRP ! guess of r at t+ deltat
-!
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSIGS ! Vert. part of Sigma_s at t
-!
-!
-!
-!* 0.2 declaration of local variables
-!
-!
-REAL, DIMENSION(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) :: &
- ZA, & ! work variable for wrc
- ZFLXZ, & ! vertical flux of the treated variable
- ZSOURCE, & ! source of evolution for the treated variable
- ZKEFF, & ! effectif diffusion coeff = LT * SQRT( TKE )
- ZF, & ! Flux in dTh/dt =-dF/dz (evaluated at t-1)(or rt instead of Th)
- ZDFDDTDZ, & ! dF/d(dTh/dz)
- ZDFDDRDZ, & ! dF/d(dr/dz)
- Z3RDMOMENT ! 3 order term in flux or variance equation
-INTEGER :: IKB,IKE ! I index values for the Beginning and End
- ! mass points of the domain in the 3 direct.
-INTEGER :: I1,I2 ! For ZCOEFF allocation
-REAL, DIMENSION(:,:,:),ALLOCATABLE :: ZCOEFF
- ! coefficients for the uncentred gradient
- ! computation near the ground
-!
-REAL :: ZTIME1, ZTIME2
-!
-LOGICAL :: GUSERV ! flag to use water
-LOGICAL :: GFTH2 ! flag to use w'th'2
-LOGICAL :: GFWTH ! flag to use w'2th'
-LOGICAL :: GFR2 ! flag to use w'r'2
-LOGICAL :: GFWR ! flag to use w'2r'
-LOGICAL :: GFTHR ! flag to use w'th'r'
-TYPE(TFIELDDATA) :: TZFIELD
-!----------------------------------------------------------------------------
-!
-!* 1. PRELIMINARIES
-! -------------
-!
-IKB=KKA+JPVEXT_TURB*KKL
-IKE=KKU-JPVEXT_TURB*KKL
-I1=MIN(KKA+JPVEXT_TURB*KKL,KKA+JPVEXT_TURB*KKL+2*KKL)
-I2=MAX(KKA+JPVEXT_TURB*KKL,KKA+JPVEXT_TURB*KKL+2*KKL)
-
-ALLOCATE(ZCOEFF(SIZE(PDZZ,1),SIZE(PDZZ,2),I1:I2))
-!
-GUSERV = (KRR/=0)
-!
-! compute the coefficients for the uncentred gradient computation near the
-! ground
-ZCOEFF(:,:,IKB+2*KKL)= - PDZZ(:,:,IKB+KKL) / &
- ( (PDZZ(:,:,IKB+2*KKL)+PDZZ(:,:,IKB+KKL)) * PDZZ(:,:,IKB+2*KKL) )
-ZCOEFF(:,:,IKB+KKL)= (PDZZ(:,:,IKB+2*KKL)+PDZZ(:,:,IKB+KKL)) / &
- ( PDZZ(:,:,IKB+KKL) * PDZZ(:,:,IKB+2*KKL) )
-ZCOEFF(:,:,IKB)= - (PDZZ(:,:,IKB+2*KKL)+2.*PDZZ(:,:,IKB+KKL)) / &
- ( (PDZZ(:,:,IKB+2*KKL)+PDZZ(:,:,IKB+KKL)) * PDZZ(:,:,IKB+KKL) )
-!
-ZKEFF(:,:,:) = MZM( PLM(:,:,:) * SQRT(PTKEM(:,:,:)) )
-!
-! Flags for 3rd order quantities
-!
-GFTH2 = .FALSE.
-GFR2 = .FALSE.
-GFTHR = .FALSE.
-GFWTH = .FALSE.
-GFWR = .FALSE.
-!
-IF (HTOM/='NONE') THEN
- GFTH2 = ANY(PFTH2/=0.)
- GFR2 = ANY(PFR2 /=0.) .AND. GUSERV
- GFTHR = ANY(PFTHR/=0.) .AND. GUSERV
- GFWTH = ANY(PFWTH/=0.)
- GFWR = ANY(PFWR /=0.) .AND. GUSERV
-END IF
-!----------------------------------------------------------------------------
-!
-!
-!* 4. TURBULENT CORRELATIONS : <THl THl>, <THl Rnp>, <Rnp Rnp>
-! --------------------------------------------------------
-!
-!
-!* 4.2 <THl THl>
-!
-! Compute the turbulent variance F and F' at time t-dt.
- ZF (:,:,:) = XCTV*PLM*PLEPS*MZF(PPHI3*PDTH_DZ**2)
- ZDFDDTDZ(:,:,:) = 0. ! this term, because of discretization, is treated separately
- !
- ! Effect of 3rd order terms in temperature flux (at mass point)
- !
- ! d(w'th'2)/dz
- IF (GFTH2) THEN
- ZF = ZF + M3_TH2_WTH2(PREDTH1,PREDR1,PD,PLEPS,&
- & PSQRT_TKE) * PFTH2
- ZDFDDTDZ = ZDFDDTDZ + D_M3_TH2_WTH2_O_DDTDZ(PREDTH1,PREDR1,&
- & PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA) * PFTH2
- END IF
- !
- ! d(w'2th')/dz
- IF (GFWTH) THEN
- ZF = ZF + M3_TH2_W2TH(PREDTH1,PREDR1,PD,PDTH_DZ,&
- & PLM,PLEPS,PTKEM) * MZF(PFWTH)
- ZDFDDTDZ = ZDFDDTDZ + D_M3_TH2_W2TH_O_DDTDZ(PREDTH1,PREDR1,PD,&
- & PLM,PLEPS,PTKEM,GUSERV) * MZF(PFWTH)
- END IF
- !
- IF (KRR/=0) THEN
- ! d(w'r'2)/dz
- IF (GFR2) THEN
- ZF = ZF + M3_TH2_WR2(PD,PLEPS,PSQRT_TKE,PBLL_O_E,&
- & PEMOIST,PDTH_DZ) * PFR2
- ZDFDDTDZ = ZDFDDTDZ + D_M3_TH2_WR2_O_DDTDZ(PREDTH1,PREDR1,PD,&
- & PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PDTH_DZ) * PFR2
- END IF
- !
- ! d(w'2r')/dz
- IF (GFWR) THEN
- ZF = ZF + M3_TH2_W2R(PD,PLM,PLEPS,PTKEM,PBLL_O_E,&
- & PEMOIST,PDTH_DZ) * MZF(PFWR)
- ZDFDDTDZ = ZDFDDTDZ + D_M3_TH2_W2R_O_DDTDZ(PREDTH1,PREDR1,PD,&
- & PLM,PLEPS,PTKEM,PBLL_O_E,PEMOIST,PDTH_DZ) * MZF(PFWR)
- END IF
- !
- ! d(w'th'r')/dz
- IF (GFTHR) THEN
- ZF = ZF + M3_TH2_WTHR(PREDR1,PD,PLEPS,PSQRT_TKE,&
- & PBLL_O_E,PEMOIST,PDTH_DZ) * PFTHR
- ZDFDDTDZ = ZDFDDTDZ + D_M3_TH2_WTHR_O_DDTDZ(PREDTH1,PREDR1,&
- & PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PDTH_DZ) * PFTHR
- END IF
-
- END IF
- !
- ZFLXZ(:,:,:) = ZF &
- ! + PIMPL * XCTV*PLM*PLEPS &
- ! *MZF(D_PHI3DTDZ2_O_DDTDZ(PPHI3,PREDTH1,PREDR1,PRED2TH3,PRED2THR3,PDTH_DZ,HTURBDIM,GUSERV) &
- ! *DZM(PTHLP - PTHLM) / PDZZ ) &
- + PIMPL * ZDFDDTDZ * MZF(DZM(PTHLP - PTHLM) / PDZZ )
- !
- ! special case near the ground ( uncentred gradient )
- ZFLXZ(:,:,IKB) = XCTV * PPHI3(:,:,IKB+KKL) * PLM(:,:,IKB) &
- * PLEPS(:,:,IKB) &
- *( PEXPL * &
- ( ZCOEFF(:,:,IKB+2*KKL)*PTHLM(:,:,IKB+2*KKL) &
- +ZCOEFF(:,:,IKB+KKL )*PTHLM(:,:,IKB+KKL ) &
- +ZCOEFF(:,:,IKB )*PTHLM(:,:,IKB ) )**2 &
- +PIMPL * &
- ( ZCOEFF(:,:,IKB+2*KKL)*PTHLP(:,:,IKB+2*KKL) &
- +ZCOEFF(:,:,IKB+KKL )*PTHLP(:,:,IKB+KKL ) &
- +ZCOEFF(:,:,IKB )*PTHLP(:,:,IKB ) )**2 &
- )
- !
- ZFLXZ(:,:,KKA) = ZFLXZ(:,:,IKB)
- !
- ZFLXZ = MAX(0., ZFLXZ)
- !
- IF (KRRL > 0) THEN
- PSIGS(:,:,:) = ZFLXZ(:,:,:) * PATHETA(:,:,:)**2
- END IF
- !
- !
- ! stores <THl THl>
- IF ( OTURB_FLX .AND. TPFILE%LOPENED ) THEN
- TZFIELD%CMNHNAME = 'THL_VVAR'
- TZFIELD%CSTDNAME = ''
- TZFIELD%CLONGNAME = 'THL_VVAR'
- TZFIELD%CUNITS = 'K2'
- TZFIELD%CDIR = 'XY'
- TZFIELD%CCOMMENT = 'X_Y_Z_THL_VVAR'
- TZFIELD%NGRID = 1
- TZFIELD%NTYPE = TYPEREAL
- TZFIELD%NDIMS = 3
- TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_Field_write(TPFILE,TZFIELD,ZFLXZ)
- END IF
-!
-! and we store in LES configuration
-!
- IF (LLES_CALL) THEN
- CALL SECOND_MNH(ZTIME1)
- CALL LES_MEAN_SUBGRID( ZFLXZ, X_LES_SUBGRID_Thl2 )
- CALL LES_MEAN_SUBGRID( MZF(PWM)*ZFLXZ, X_LES_RES_W_SBG_Thl2 )
- CALL LES_MEAN_SUBGRID( -2.*XCTD*PSQRT_TKE*ZFLXZ/PLEPS, X_LES_SUBGRID_DISS_Thl2 )
- CALL LES_MEAN_SUBGRID( PETHETA*ZFLXZ, X_LES_SUBGRID_ThlThv )
- CALL LES_MEAN_SUBGRID( -XA3*PBETA*PETHETA*ZFLXZ, X_LES_SUBGRID_ThlPz, .TRUE. )
- CALL SECOND_MNH(ZTIME2)
- XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
- END IF
-!
- IF ( KRR /= 0 ) THEN
-!
-!* 4.3 <THl Rnp>
-!
-!
- ! Compute the turbulent variance F and F' at time t-dt.
- ZF (:,:,:) = XCTV*PLM*PLEPS*MZF(0.5*(PPHI3+PPSI3)*PDTH_DZ*PDR_DZ)
- ZDFDDTDZ(:,:,:) = 0. ! this term, because of discretization, is treated separately
- ZDFDDRDZ(:,:,:) = 0. ! this term, because of discretization, is treated separately
- !
- ! Effect of 3rd order terms in temperature flux (at mass point)
- !
- ! d(w'th'2)/dz
- IF (GFTH2) THEN
- ZF = ZF + M3_THR_WTH2(PREDR1,PD,PLEPS,PSQRT_TKE,&
- & PBLL_O_E,PETHETA,PDR_DZ) * PFTH2
- ZDFDDTDZ = ZDFDDTDZ + D_M3_THR_WTH2_O_DDTDZ(PREDTH1,PREDR1,&
- & PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDR_DZ) * PFTH2
- ZDFDDRDZ = ZDFDDRDZ + D_M3_THR_WTH2_O_DDRDZ(PREDTH1,PREDR1,&
- & PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA) * PFTH2
- END IF
- !
- ! d(w'2th')/dz
- IF (GFWTH) THEN
- ZF = ZF + M3_THR_W2TH(PREDR1,PD,PLM,PLEPS,PTKEM,&
- & PDR_DZ) * MZF(PFWTH)
- ZDFDDTDZ = ZDFDDTDZ + D_M3_THR_W2TH_O_DDTDZ(PREDTH1,PREDR1,&
- & PD,PLM,PLEPS,PTKEM,PBLL_O_E,PDR_DZ,PETHETA) * MZF(PFWTH)
- ZDFDDRDZ = ZDFDDRDZ + D_M3_THR_W2TH_O_DDRDZ(PREDTH1,PREDR1,&
- & PD,PLM,PLEPS,PTKEM) * MZF(PFWTH)
- END IF
- !
- ! d(w'r'2)/dz
- IF (GFR2) THEN
- ZF = ZF + M3_THR_WR2(PREDTH1,PD,PLEPS,PSQRT_TKE,&
- & PBLL_O_E,PEMOIST,PDTH_DZ) * PFR2
- ZDFDDTDZ = ZDFDDTDZ + D_M3_THR_WR2_O_DDTDZ(PREDR1,PREDTH1,PD,&
- & PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST) * PFR2
- ZDFDDRDZ = ZDFDDRDZ + D_M3_THR_WR2_O_DDRDZ(PREDR1,PREDTH1,PD,&
- & PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PDTH_DZ) * PFR2
- END IF
- !
- ! d(w'2r')/dz
- IF (GFWR) THEN
- ZF = ZF + M3_THR_W2R(PREDTH1,PD,PLM,PLEPS,PTKEM,&
- & PDTH_DZ) * MZF(PFWR)
- ZDFDDTDZ = ZDFDDTDZ + D_M3_THR_W2R_O_DDTDZ(PREDR1,PREDTH1,PD,&
- & PLM,PLEPS,PTKEM) * MZF(PFWR)
- ZDFDDRDZ = ZDFDDRDZ + D_M3_THR_W2R_O_DDRDZ(PREDR1,PREDTH1,PD,&
- & PLM,PLEPS,PTKEM,PBLL_O_E,PDTH_DZ,PEMOIST) * MZF(PFWR)
- END IF
- !
- ! d(w'th'r')/dz
- IF (GFTHR) THEN
- ZF = ZF + M3_THR_WTHR(PREDTH1,PREDR1,PD,PLEPS,&
- & PSQRT_TKE) * PFTHR
- ZDFDDTDZ = ZDFDDTDZ + D_M3_THR_WTHR_O_DDTDZ(PREDTH1,PREDR1,&
- & PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA) * PFTHR
- ZDFDDRDZ = ZDFDDRDZ + D_M3_THR_WTHR_O_DDRDZ(PREDR1,PREDTH1,&
- & PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST) * PFTHR
- END IF
- !
- ZFLXZ(:,:,:) = ZF &
- + PIMPL * XCTV*PLM*PLEPS*0.5 &
- * MZF( ( D_PHI3DTDZ_O_DDTDZ(PPHI3,PREDTH1,PREDR1,PRED2TH3,PRED2THR3,HTURBDIM,GUSERV) & ! d(phi3*dthdz)/ddthdz term
- +D_PSI3DTDZ_O_DDTDZ(PPSI3,PREDR1,PREDTH1,PRED2R3,PRED2THR3,HTURBDIM,GUSERV) & ! d(psi3*dthdz)/ddthdz term
- ) *PDR_DZ *DZM(PTHLP - PTHLM ) / PDZZ &
- +( D_PHI3DRDZ_O_DDRDZ(PPHI3,PREDTH1,PREDR1,PRED2TH3,PRED2THR3,HTURBDIM,GUSERV) & ! d(phi3*drdz )/ddrdz term
- +D_PSI3DRDZ_O_DDRDZ(PPSI3,PREDR1,PREDTH1,PRED2R3,PRED2THR3,HTURBDIM,GUSERV) & ! d(psi3*drdz )/ddrdz term
- ) *PDTH_DZ *DZM(PRP - PRM(:,:,:,1)) / PDZZ &
- ) &
- + PIMPL * ZDFDDTDZ * MZF(DZM(PTHLP - PTHLM(:,:,:)) / PDZZ ) &
- + PIMPL * ZDFDDRDZ * MZF(DZM(PRP - PRM(:,:,:,1)) / PDZZ )
- !
- ! special case near the ground ( uncentred gradient )
- ZFLXZ(:,:,IKB) = &
- (XCHT1 * PPHI3(:,:,IKB+KKL) + XCHT2 * PPSI3(:,:,IKB+KKL)) &
- *( PEXPL * &
- ( ZCOEFF(:,:,IKB+2*KKL)*PTHLM(:,:,IKB+2*KKL) &
- +ZCOEFF(:,:,IKB+KKL )*PTHLM(:,:,IKB+KKL ) &
- +ZCOEFF(:,:,IKB )*PTHLM(:,:,IKB )) &
- *( ZCOEFF(:,:,IKB+2*KKL)*PRM(:,:,IKB+2*KKL,1) &
- +ZCOEFF(:,:,IKB+KKL )*PRM(:,:,IKB+KKL,1 ) &
- +ZCOEFF(:,:,IKB )*PRM(:,:,IKB ,1 )) &
- +PIMPL * &
- ( ZCOEFF(:,:,IKB+2*KKL)*PTHLP(:,:,IKB+2*KKL) &
- +ZCOEFF(:,:,IKB+KKL )*PTHLP(:,:,IKB+KKL ) &
- +ZCOEFF(:,:,IKB )*PTHLP(:,:,IKB )) &
- *( ZCOEFF(:,:,IKB+2*KKL)*PRP(:,:,IKB+2*KKL ) &
- +ZCOEFF(:,:,IKB+KKL )*PRP(:,:,IKB+KKL ) &
- +ZCOEFF(:,:,IKB )*PRP(:,:,IKB )) &
- )
- !
- ZFLXZ(:,:,KKA) = ZFLXZ(:,:,IKB)
- !
- IF ( KRRL > 0 ) THEN
- PSIGS(:,:,:) = PSIGS(:,:,:) + &
- 2. * PATHETA(:,:,:) * PAMOIST(:,:,:) * ZFLXZ(:,:,:)
- END IF
- ! stores <THl Rnp>
- IF ( OTURB_FLX .AND. TPFILE%LOPENED ) THEN
- TZFIELD%CMNHNAME = 'THLRCONS_VCOR'
- TZFIELD%CSTDNAME = ''
- TZFIELD%CLONGNAME = 'THLRCONS_VCOR'
- TZFIELD%CUNITS = 'K kg kg-1'
- TZFIELD%CDIR = 'XY'
- TZFIELD%CCOMMENT = 'X_Y_Z_THLRCONS_VCOR'
- TZFIELD%NGRID = 1
- TZFIELD%NTYPE = TYPEREAL
- TZFIELD%NDIMS = 3
- TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_Field_write(TPFILE,TZFIELD,ZFLXZ)
- END IF
-!
-! and we store in LES configuration
-!
- IF (LLES_CALL) THEN
- CALL SECOND_MNH(ZTIME1)
- CALL LES_MEAN_SUBGRID( ZFLXZ, X_LES_SUBGRID_THlRt )
- CALL LES_MEAN_SUBGRID( MZF(PWM)*ZFLXZ, X_LES_RES_W_SBG_ThlRt )
- CALL LES_MEAN_SUBGRID( -2.*XCTD*PSQRT_TKE*ZFLXZ/PLEPS, X_LES_SUBGRID_DISS_ThlRt )
- CALL LES_MEAN_SUBGRID( PETHETA*ZFLXZ, X_LES_SUBGRID_RtThv )
- CALL LES_MEAN_SUBGRID( -XA3*PBETA*PETHETA*ZFLXZ, X_LES_SUBGRID_RtPz, .TRUE. )
- CALL LES_MEAN_SUBGRID( PEMOIST*ZFLXZ, X_LES_SUBGRID_ThlThv , .TRUE. )
- CALL LES_MEAN_SUBGRID( -XA3*PBETA*PEMOIST*ZFLXZ, X_LES_SUBGRID_ThlPz, .TRUE. )
- CALL SECOND_MNH(ZTIME2)
- XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
- END IF
-!
-!
-!* 4.4 <Rnp Rnp>
-!
-!
- ! Compute the turbulent variance F and F' at time t-dt.
- ZF (:,:,:) = XCTV*PLM*PLEPS*MZF(PPSI3*PDR_DZ**2)
- ZDFDDRDZ(:,:,:) = 0. ! this term, because of discretization, is treated separately
- !
- ! Effect of 3rd order terms in temperature flux (at mass point)
- !
- ! d(w'r'2)/dz
- IF (GFR2) THEN
- ZF = ZF + M3_R2_WR2(PREDR1,PREDTH1,PD,PLEPS,&
- & PSQRT_TKE) * PFR2
- ZDFDDRDZ = ZDFDDRDZ + D_M3_R2_WR2_O_DDRDZ(PREDR1,PREDTH1,&
- & PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST) * PFR2
- END IF
- !
- ! d(w'2r')/dz
- IF (GFWR) THEN
- ZF = ZF + M3_R2_W2R(PREDR1,PREDTH1,PD,PDR_DZ,&
- & PLM,PLEPS,PTKEM) * MZF(PFWR)
- ZDFDDRDZ = ZDFDDRDZ + D_M3_R2_W2R_O_DDRDZ(PREDR1,PREDTH1,&
- & PD,PLM,PLEPS,PTKEM,GUSERV) * MZF(PFWR)
- END IF
- !
- IF (KRR/=0) THEN
- ! d(w'r'2)/dz
- IF (GFTH2) THEN
- ZF = ZF + M3_R2_WTH2(PD,PLEPS,PSQRT_TKE,&
- & PBLL_O_E,PETHETA,PDR_DZ) * PFTH2
- ZDFDDRDZ = ZDFDDRDZ + D_M3_R2_WTH2_O_DDRDZ(PREDR1,&
- & PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDR_DZ) * PFTH2
- END IF
- !
- ! d(w'2r')/dz
- IF (GFWTH) THEN
- ZF = ZF + M3_R2_W2TH(PD,PLM,PLEPS,PTKEM,&
- & PBLL_O_E,PETHETA,PDR_DZ) * MZF(PFWTH)
- ZDFDDRDZ = ZDFDDRDZ + D_M3_R2_W2TH_O_DDRDZ(PREDR1,PREDTH1,&
- & PD,PLM,PLEPS,PTKEM,PBLL_O_E,PETHETA,PDR_DZ) * MZF(PFWTH)
- END IF
- !
- ! d(w'th'r')/dz
- IF (GFTHR) THEN
- ZF = ZF + M3_R2_WTHR(PREDTH1,PD,PLEPS,&
- & PSQRT_TKE,PBLL_O_E,PETHETA,PDR_DZ) * PFTHR
- ZDFDDRDZ = ZDFDDRDZ + D_M3_R2_WTHR_O_DDRDZ(PREDR1,PREDTH1,&
- & PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDR_DZ) * PFTHR
- END IF
-
- END IF
- !
- ZFLXZ(:,:,:) = ZF &
- + PIMPL * XCTV*PLM*PLEPS &
- *MZF(D_PSI3DRDZ2_O_DDRDZ(PPSI3,PREDR1,PREDTH1,PRED2R3,PRED2THR3,PDR_DZ,HTURBDIM,GUSERV) &
- *DZM(PRP - PRM(:,:,:,1)) / PDZZ ) &
- + PIMPL * ZDFDDRDZ * MZF(DZM(PRP - PRM(:,:,:,1)) / PDZZ )
- !
- ! special case near the ground ( uncentred gradient )
- ZFLXZ(:,:,IKB) = XCHV * PPSI3(:,:,IKB+KKL) * PLM(:,:,IKB) &
- * PLEPS(:,:,IKB) &
- *( PEXPL * &
- ( ZCOEFF(:,:,IKB+2*KKL)*PRM(:,:,IKB+2*KKL,1) &
- +ZCOEFF(:,:,IKB+KKL )*PRM(:,:,IKB+KKL,1 ) &
- +ZCOEFF(:,:,IKB )*PRM(:,:,IKB ,1 ))**2 &
- +PIMPL * &
- ( ZCOEFF(:,:,IKB+2*KKL)*PRP(:,:,IKB+2*KKL) &
- +ZCOEFF(:,:,IKB+KKL )*PRP(:,:,IKB+KKL ) &
- +ZCOEFF(:,:,IKB )*PRP(:,:,IKB ))**2 &
- )
- !
- ZFLXZ(:,:,KKA) = ZFLXZ(:,:,IKB)
- !
- IF ( KRRL > 0 ) THEN
- PSIGS(:,:,:) = PSIGS(:,:,:) + PAMOIST(:,:,:) **2 * ZFLXZ(:,:,:)
- END IF
- ! stores <Rnp Rnp>
- IF ( OTURB_FLX .AND. TPFILE%LOPENED ) THEN
- TZFIELD%CMNHNAME = 'RTOT_VVAR'
- TZFIELD%CSTDNAME = ''
- TZFIELD%CLONGNAME = 'RTOT_VVAR'
- TZFIELD%CUNITS = 'kg2 kg-2'
- TZFIELD%CDIR = 'XY'
- TZFIELD%CCOMMENT = 'X_Y_Z_RTOT_VVAR'
- TZFIELD%NGRID = 1
- TZFIELD%NTYPE = TYPEREAL
- TZFIELD%NDIMS = 3
- TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_Field_write(TPFILE,TZFIELD,ZFLXZ)
- END IF
- !
- ! and we store in LES configuration
- !
- IF (LLES_CALL) THEN
- CALL SECOND_MNH(ZTIME1)
- CALL LES_MEAN_SUBGRID( ZFLXZ, X_LES_SUBGRID_Rt2 )
- CALL LES_MEAN_SUBGRID( MZF(PWM)*ZFLXZ, X_LES_RES_W_SBG_Rt2 )
- CALL LES_MEAN_SUBGRID( PEMOIST*ZFLXZ, X_LES_SUBGRID_RtThv , .TRUE. )
- CALL LES_MEAN_SUBGRID( -XA3*PBETA*PEMOIST*ZFLXZ, X_LES_SUBGRID_RtPz, .TRUE. )
- CALL LES_MEAN_SUBGRID( -2.*XCTD*PSQRT_TKE*ZFLXZ/PLEPS, X_LES_SUBGRID_DISS_Rt2 )
- CALL SECOND_MNH(ZTIME2)
- XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
- END IF
- !
- END IF ! end if KRR ne 0
-!
-!
-! 4.5 Vertical part of Sigma_s
-!
- IF ( KRRL > 0 ) THEN
- ! Extrapolate PSIGS at the ground and at the top
- PSIGS(:,:,KKA) = PSIGS(:,:,IKB)
- PSIGS(:,:,KKU) = PSIGS(:,:,IKE)
- PSIGS(:,:,:) = SQRT( MAX (PSIGS(:,:,:) , 1.E-12) )
- END IF
-
-!
-! 4.6 Deallocate
-!
- DEALLOCATE(ZCOEFF)
-!----------------------------------------------------------------------------
-IF (LHOOK) CALL DR_HOOK('TURB_VER_THERMO_CORR',1,ZHOOK_HANDLE)
-END SUBROUTINE TURB_VER_THERMO_CORR
diff --git a/src/mesonh/turb/turb_ver_thermo_flux.f90 b/src/mesonh/turb/turb_ver_thermo_flux.f90
deleted file mode 100644
index 698bcfa76..000000000
--- a/src/mesonh/turb/turb_ver_thermo_flux.f90
+++ /dev/null
@@ -1,1117 +0,0 @@
-!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier
-!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!MNH_LIC for details. version 1.
-!-----------------------------------------------------------------
-! ####################
- MODULE MODI_TURB_VER_THERMO_FLUX
-! ####################
-!
-INTERFACE
-!
- SUBROUTINE TURB_VER_THERMO_FLUX(KKA,KKU,KKL,KRR,KRRL,KRRI, &
- OTURB_FLX,HTURBDIM,HTOM, &
- PIMPL,PEXPL, &
- PTSTEP, &
- TPFILE, &
- PDXX,PDYY,PDZZ,PDZX,PDZY,PDIRCOSZW,PZZ, &
- PRHODJ,PTHVREF, &
- PSFTHM,PSFRM,PSFTHP,PSFRP, &
- PWM,PTHLM,PRM,PSVM, &
- PTKEM,PLM,PLEPS, &
- PLOCPEXNM,PATHETA,PAMOIST,PSRCM,PFRAC_ICE, &
- PBETA, PSQRT_TKE, PDTH_DZ, PDR_DZ, PRED2TH3, &
- PRED2R3, PRED2THR3, PBLL_O_E, PETHETA, &
- PEMOIST, PREDTH1, PREDR1, PPHI3, PPSI3, PD, &
- PFWTH,PFWR,PFTH2,PFR2,PFTHR,MFMOIST,PBL_DEPTH,&
- PWTHV,PRTHLS,PRRS,PTHLP,PRP,PTP,PWTH,PWRC )
-!
-USE MODD_IO, ONLY: TFILEDATA
-!
-INTEGER, INTENT(IN) :: KKA !near ground array index
-INTEGER, INTENT(IN) :: KKU !uppest atmosphere array index
-INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=AR O
-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.
-LOGICAL, INTENT(IN) :: OTURB_FLX ! switch to write the
- ! turbulent fluxes in the syncronous FM-file
-CHARACTER(len=4), INTENT(IN) :: HTURBDIM ! dimensionality of the
- ! turbulence scheme
-CHARACTER(len=4), INTENT(IN) :: HTOM ! type of Third Order Moment
-REAL, INTENT(IN) :: PIMPL, PEXPL ! Coef. for temporal disc.
-REAL, INTENT(IN) :: PTSTEP ! Double Time Step
-TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ, PDXX, PDYY, PDZX, PDZY
- ! Metric coefficients
-REAL, DIMENSION(:,:), INTENT(IN) :: PDIRCOSZW ! Director Cosinus of the
- ! normal to the ground surface
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! altitudes
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! dry density * grid volum
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHVREF ! ref. state Virtual
- ! Potential Temperature
-!
-REAL, DIMENSION(:,:), INTENT(IN) :: PSFTHM,PSFRM ! surface fluxes at time
-! ! t - deltat
-!
-REAL, DIMENSION(:,:), INTENT(IN) :: PSFTHP,PSFRP ! surface fluxes at time
-! ! t + deltat
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PWM
-! Vertical wind
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHLM
-! potential temperature at t-Delta t
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRM ! Mixing ratios
- ! at t-Delta t
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVM ! Mixing ratios
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKEM ! TKE at time t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLM ! Turb. mixing length
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLEPS ! dissipative length
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLOCPEXNM ! Lv(T)/Cp/Exnref at time t-1
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PATHETA ! coefficients between
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PAMOIST ! s and Thetal and Rnp
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRCM ! normalized
- ! 2nd-order flux s'r'c/2Sigma_s2 at t-1 multiplied by Lambda_3
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PFRAC_ICE ! ri fraction of rc+ri
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PBETA ! buoyancy coefficient
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSQRT_TKE ! sqrt(e)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDTH_DZ ! d(th)/dz
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDR_DZ ! d(rt)/dz
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRED2TH3 ! 3D Redeslperger number R*2_th
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRED2R3 ! 3D Redeslperger number R*2_r
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRED2THR3 ! 3D Redeslperger number R*2_thr
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PBLL_O_E ! beta * Lk * Leps / tke
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PETHETA ! Coefficient for theta in theta_v computation
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PEMOIST ! Coefficient for r in theta_v computation
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1 ! 1D Redelsperger number for Th
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1 ! 1D Redelsperger number for r
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPHI3 ! Prandtl number for temperature
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPSI3 ! Prandtl number for vapor
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PD ! Denominator in Prandtl numbers
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PFWTH ! d(w'2th' )/dz (at flux point)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PFWR ! d(w'2r' )/dz (at flux point)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PFTH2 ! d(w'th'2 )/dz (at mass point)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PFR2 ! d(w'r'2 )/dz (at mass point)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PFTHR ! d(w'th'r')/dz (at mass point)
-REAL, DIMENSION(:,:), INTENT(INOUT):: PBL_DEPTH ! BL depth
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PWTHV ! buoyancy flux
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRTHLS ! cumulated source for theta
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRRS ! cumulated source for rt
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PTHLP ! guess of thl at t+ deltat
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRP ! guess of r at t+ deltat
-!
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PTP ! Dynamic and thermal
- ! TKE production terms
-!
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PWTH ! heat flux
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PWRC ! cloud water flux
-!
-!
-END SUBROUTINE TURB_VER_THERMO_FLUX
-!
-END INTERFACE
-!
-END MODULE MODI_TURB_VER_THERMO_FLUX
-!
-!
-! ###############################################################
- SUBROUTINE TURB_VER_THERMO_FLUX(KKA,KKU,KKL,KRR, KRRL, KRRI, &
- OTURB_FLX,HTURBDIM,HTOM, &
- PIMPL,PEXPL, &
- PTSTEP, &
- TPFILE, &
- PDXX,PDYY,PDZZ,PDZX,PDZY,PDIRCOSZW,PZZ, &
- PRHODJ,PTHVREF, &
- PSFTHM,PSFRM,PSFTHP,PSFRP, &
- PWM,PTHLM,PRM,PSVM, &
- PTKEM,PLM,PLEPS, &
- PLOCPEXNM,PATHETA,PAMOIST,PSRCM,PFRAC_ICE, &
- PBETA, PSQRT_TKE, PDTH_DZ, PDR_DZ, PRED2TH3, &
- PRED2R3, PRED2THR3, PBLL_O_E, PETHETA, &
- PEMOIST, PREDTH1, PREDR1, PPHI3, PPSI3, PD, &
- PFWTH,PFWR,PFTH2,PFR2,PFTHR,PBL_DEPTH, &
- PWTHV,PRTHLS,PRRS,PTHLP,PRP,PTP,PWTH,PWRC )
-! ###############################################################
-!
-!
-!!**** *TURB_VER_THERMO_FLUX* -compute the source terms due to the vertical turbulent
-!! fluxes.
-!!
-!! PURPOSE
-!! -------
-! The purpose of this routine is to compute the vertical turbulent
-! fluxes of the evolutive variables and give back the source
-! terms to the main program. In the case of large horizontal meshes,
-! the divergence of these vertical turbulent fluxes represent the whole
-! effect of the turbulence but when the three-dimensionnal version of
-! the turbulence scheme is activated (CTURBDIM="3DIM"), these divergences
-! are completed in the next routine TURB_HOR.
-! An arbitrary degree of implicitness has been implemented for the
-! temporal treatment of these diffusion terms.
-! The vertical boundary conditions are as follows:
-! * at the bottom, the surface fluxes are prescribed at the same
-! as the other turbulent fluxes
-! * at the top, the turbulent fluxes are set to 0.
-! It should be noted that the condensation has been implicitely included
-! in this turbulence scheme by using conservative variables and computing
-! the subgrid variance of a statistical variable s indicating the presence
-! or not of condensation in a given mesh.
-!
-!!** METHOD
-!! ------
-!! 1D type calculations are made;
-!! The vertical turbulent fluxes are computed in an off-centered
-!! implicit scheme (a Crank-Nicholson type with coefficients different
-!! than 0.5), which allows to vary the degree of implicitness of the
-!! formulation.
-!! The different prognostic variables are treated one by one.
-!! The contributions of each turbulent fluxes are cumulated into the
-!! tendency PRvarS, and into the dynamic and thermal production of
-!! TKE if necessary.
-!!
-!! In section 2 and 3, the thermodynamical fields are considered.
-!! Only the turbulent fluxes of the conservative variables
-!! (Thetal and Rnp stored in PRx(:,:,:,1)) are computed.
-!! Note that the turbulent fluxes at the vertical
-!! boundaries are given either by the soil scheme for the surface one
-!! ( at the same instant as the others fluxes) and equal to 0 at the
-!! top of the model. The thermal production is computed by vertically
-!! averaging the turbulent flux and multiply this flux at the mass point by
-!! a function ETHETA or EMOIST, which preform the transformation from the
-!! conservative variables to the virtual potential temperature.
-!!
-!! In section 4, the variance of the statistical variable
-!! s indicating presence or not of condensation, is determined in function
-!! of the turbulent moments of the conservative variables and its
-!! squarred root is stored in PSIGS. This information will be completed in
-!! the horizontal turbulence if the turbulence dimensionality is not
-!! equal to "1DIM".
-!!
-!! In section 5, the x component of the stress tensor is computed.
-!! The surface flux <u'w'> is computed from the value of the surface
-!! fluxes computed in axes linked to the orography ( i", j" , k"):
-!! i" is parallel to the surface and in the direction of the maximum
-!! slope
-!! j" is also parallel to the surface and in the normal direction of
-!! the maximum slope
-!! k" is the normal to the surface
-!! In order to prevent numerical instability, the implicit scheme has
-!! been extended to the surface flux regarding to its dependence in
-!! function of U. The dependence in function of the other components
-!! introduced by the different rotations is only explicit.
-!! The turbulent fluxes are used to compute the dynamic production of
-!! TKE. For the last TKE level ( located at PDZZ(:,:,IKB)/2 from the
-!! ground), an harmonic extrapolation from the dynamic production at
-!! PDZZ(:,:,IKB) is used to avoid an evaluation of the gradient of U
-!! in the surface layer.
-!!
-!! In section 6, the same steps are repeated but for the y direction
-!! and in section 7, a diagnostic computation of the W variance is
-!! performed.
-!!
-!! In section 8, the turbulent fluxes for the scalar variables are
-!! computed by the same way as the conservative thermodynamical variables
-!!
-!!
-!! EXTERNAL
-!! --------
-!! GX_U_M, GY_V_M, GZ_W_M : cartesian gradient operators
-!! GX_U_UW,GY_V_VW (X,Y,Z) represent the direction of the gradient
-!! _(M,U,...)_ represent the localization of the
-!! field to be derivated
-!! _(M,UW,...) represent the localization of the
-!! field derivated
-!!
-!!
-!! MXM,MXF,MYM,MYF,MZM,MZF
-!! : Shuman functions (mean operators)
-!! DXF,DYF,DZF,DZM
-!! : Shuman functions (difference operators)
-!!
-!! SUBROUTINE TRIDIAG : to compute the split implicit evolution
-!! of a variable located at a mass point
-!!
-!! SUBROUTINE TRIDIAG_WIND: to compute the split implicit evolution
-!! of a variable located at a wind point
-!!
-!! FUNCTIONs ETHETA and EMOIST :
-!! allows to compute:
-!! - the coefficients for the turbulent correlation between
-!! any variable and the virtual potential temperature, of its
-!! correlations with the conservative potential temperature and
-!! the humidity conservative variable:
-!! ------- ------- -------
-!! A' Thv' = ETHETA A' Thl' + EMOIST A' Rnp'
-!!
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!! Module MODD_CST : contains physical constants
-!!
-!! XG : gravity constant
-!!
-!! Module MODD_CTURB: contains the set of constants for
-!! the turbulence scheme
-!!
-!! XCMFS,XCMFB : cts for the momentum flux
-!! XCSHF : ct for the sensible heat flux
-!! XCHF : ct for the moisture flux
-!! XCTV,XCHV : cts for the T and moisture variances
-!!
-!! Module MODD_PARAMETERS
-!!
-!! JPVEXT_TURB : number of vertical external points
-!! JPHEXT : number of horizontal external points
-!!
-!!
-!! REFERENCE
-!! ---------
-!! Book 1 of documentation (Chapter: Turbulence)
-!!
-!! AUTHOR
-!! ------
-!! Joan Cuxart * INM and Meteo-France *
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original August 19, 1994
-!! Modifications: February 14, 1995 (J.Cuxart and J.Stein)
-!! Doctorization and Optimization
-!! Modifications: March 21, 1995 (J.M. Carriere)
-!! Introduction of cloud water
-!! Modifications: June 14, 1995 (J.Cuxart and J. Stein)
-!! Phi3 and Psi3 at w-point + bug in the all
-!! or nothing condens.
-!! Modifications: Sept 15, 1995 (J.Cuxart and J. Stein)
-!! Change the DP computation at the ground
-!! Modifications: October 10, 1995 (J.Cuxart and J. Stein)
-!! Psi for scal var and LES tools
-!! Modifications: November 10, 1995 (J. Stein)
-!! change the surface relations
-!! Modifications: February 20, 1995 (J. Stein) optimization
-!! Modifications: May 21, 1996 (J. Stein)
-!! bug in the vertical flux of the V wind
-!! component for explicit computation
-!! Modifications: May 21, 1996 (N. wood)
-!! modify the computation of the vertical
-!! part or the surface tangential flux
-!! Modifications: May 21, 1996 (P. Jabouille)
-!! same modification in the Y direction
-!!
-!! Modifications: Sept 17, 1996 (J. Stein) change the moist case by using
-!! Pi instead of Piref + use Atheta and Amoist
-!!
-!! Modifications: Nov 24, 1997 (V. Masson) removes the DO loops
-!! Modifications: Mar 31, 1998 (V. Masson) splits the routine TURB_VER_THERMO_FLUX
-!! Modifications: Oct 18, 2000 (V. Masson) LES computations
-!! Modifications: Dec 01, 2000 (V. Masson) conservation of energy from
-!! surface flux in 1DIM case
-!! when slopes are present
-!! Nov 06, 2002 (V. Masson) LES budgets
-!! Feb 20, 2003 (JP Pinty) Add PFRAC_ICE
-!! May 20, 2003 (JP Pinty) Correction of ETHETA
-!! and EMOIST calls
-!! July 2005 (S. Tomas, V. Masson)
-!! Add 3rd order moments
-!! and implicitation of PHI3 and PSI3
-!! October 2009 (G. Tanguy) add ILENCH=LEN(YCOMMENT) after
-!! change of YCOMMENT
-!! 2012-02 (Y. Seity) add possibility to run with reversed
-!! vertical levels
-!! Modifications July 2015 (Wim de Rooy) LHARAT switch
-!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
-!! 2021 (D. Ricard) last version of HGRAD turbulence scheme
-!! Leronard terms instead of Reynolds terms
-!! applied to vertical fluxes of r_np and Thl
-!! for implicit version of turbulence scheme
-!! corrections and cleaning
-!! June 2020 (B. Vie) Patch preventing negative rc and ri in 2.3 and 3.3
-!! JL Redelsperger : 03/2021: Ocean and Autocoupling O-A LES Cases
-!! Sfc flux shape for LDEEPOC Case
-!!--------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE PARKIND1, ONLY : JPRB
-USE YOMHOOK , ONLY : LHOOK, DR_HOOK
-!
-USE MODD_CST
-USE MODD_CTURB
-USE MODD_FIELD, ONLY: TFIELDDATA, TYPEREAL
-USE MODD_GRID_n, ONLY: XZS, XXHAT, XYHAT
-USE MODD_IO, ONLY: TFILEDATA
-USE MODD_METRICS_n, ONLY: XDXX, XDYY, XDZX, XDZY, XDZZ
-USE MODD_PARAMETERS
-USE MODD_TURB_n, ONLY: LHGRAD, XCOEFHGRADTHL, XCOEFHGRADRM, XALTHGRAD, XCLDTHOLD
-USE MODD_CONF
-USE MODD_LES
-USE MODD_DIM_n
-USE MODD_DYN_n, ONLY: LOCEAN
-USE MODD_OCEANH
-USE MODD_REF, ONLY: LCOUPLES
-USE MODD_TURB_n
-USE MODD_FRC
-!
-USE MODI_GRADIENT_U
-USE MODI_GRADIENT_V
-USE MODI_GRADIENT_W
-USE MODI_GRADIENT_M
-USE MODI_GRADIENT_UV
-USE MODI_GRADIENT_UW
-USE MODI_GRADIENT_VW
-USE MODI_SHUMAN
-USE MODI_TRIDIAG
-USE MODI_LES_MEAN_SUBGRID
-USE MODI_PRANDTL
-USE MODI_TRIDIAG_THERMO
-USE MODI_TM06_H
-!
-USE MODE_IO_FIELD_WRITE, ONLY: IO_FIELD_WRITE
-USE MODE_PRANDTL
-!
-USE MODI_SECOND_MNH
-USE MODE_ll
-USE MODE_GATHER_ll
-!
-IMPLICIT NONE
-!
-!* 0.1 declarations of arguments
-!
-!
-!
-INTEGER, INTENT(IN) :: KKA !near ground array index
-INTEGER, INTENT(IN) :: KKU !uppest atmosphere array index
-INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=ARO
-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.
-LOGICAL, INTENT(IN) :: OTURB_FLX ! switch to write the
- ! turbulent fluxes in the syncronous FM-file
-CHARACTER(len=4), INTENT(IN) :: HTURBDIM ! dimensionality of the
- ! turbulence scheme
-CHARACTER(len=4), INTENT(IN) :: HTOM ! type of Third Order Moment
-REAL, INTENT(IN) :: PIMPL, PEXPL ! Coef. for temporal disc.
-REAL, INTENT(IN) :: PTSTEP ! Double Time Step
-TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ, PDXX, PDYY, PDZX, PDZY
- ! Metric coefficients
-REAL, DIMENSION(:,:), INTENT(IN) :: PDIRCOSZW ! Director Cosinus of the
- ! normal to the ground surface
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! altitudes
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! dry density * grid volum
-REAL, DIMENSION(:,:,:), INTENT(IN) :: MFMOIST ! moist mass flux dual scheme
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHVREF ! ref. state Virtual
- ! Potential Temperature
-!
-REAL, DIMENSION(:,:), INTENT(IN) :: PSFTHM,PSFRM ! surface fluxes at time
-! ! t - deltat
-!
-REAL, DIMENSION(:,:), INTENT(IN) :: PSFTHP,PSFRP ! surface fluxes at time
-! ! t + deltat
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PWM
-! Vertical wind
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHLM
-! potential temperature at t-Delta t
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRM ! Mixing ratios
- ! at t-Delta t
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVM ! Mixing ratios
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKEM ! TKE at time t
-!
-! In case LHARAT=TRUE, PLM already includes all stability corrections
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLM ! Turb. mixing length
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLEPS ! dissipative length
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLOCPEXNM ! Lv(T)/Cp/Exnref at time t-1
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PATHETA ! coefficients between
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PAMOIST ! s and Thetal and Rnp
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRCM ! normalized
-! 2nd-order flux s'r'c/2Sigma_s2 at t-1 multiplied by Lambda_3
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PFRAC_ICE ! ri fraction of rc+ri
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PBETA ! buoyancy coefficient
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSQRT_TKE ! sqrt(e)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDTH_DZ ! d(th)/dz
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDR_DZ ! d(rt)/dz
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRED2TH3 ! 3D Redeslperger number R*2_th
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRED2R3 ! 3D Redeslperger number R*2_r
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRED2THR3 ! 3D Redeslperger number R*2_thr
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PBLL_O_E ! beta * Lk * Leps / tke
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PETHETA ! Coefficient for theta in theta_v computation
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PEMOIST ! Coefficient for r in theta_v computation
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1 ! 1D Redelsperger number for Th
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1 ! 1D Redelsperger number for r
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPHI3 ! Prandtl number for temperature
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPSI3 ! Prandtl number for vapor
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PD ! Denominator in Prandtl numbers
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PFWTH ! d(w'2th' )/dz (at flux point)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PFWR ! d(w'2r' )/dz (at flux point)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PFTH2 ! d(w'th'2 )/dz (at mass point)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PFR2 ! d(w'r'2 )/dz (at mass point)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PFTHR ! d(w'th'r')/dz (at mass point)
-REAL, DIMENSION(:,:), INTENT(INOUT):: PBL_DEPTH ! BL depth
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PWTHV ! buoyancy flux
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRTHLS ! cumulated source for theta
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRRS ! cumulated source for rt
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PTHLP ! guess of thl at t+ deltat
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRP ! guess of r at t+ deltat
-!
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PTP ! Dynamic and thermal
- ! TKE production terms
-!
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PWTH ! heat flux
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PWRC ! cloud water flux
-!
-!
-!* 0.2 declaration of local variables
-!
-!
-REAL, DIMENSION(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) :: &
- ZA, & ! work variable for wrc or LES computation
- ZFLXZ, & ! vertical flux of the treated variable
- ZSOURCE, & ! source of evolution for the treated variable
- ZKEFF, & ! effectif diffusion coeff = LT * SQRT( TKE )
- ZF, & ! Flux in dTh/dt =-dF/dz (evaluated at t-1)(or rt instead of Th)
- ZDFDDTDZ, & ! dF/d(dTh/dz)
- ZDFDDRDZ, & ! dF/d(dr/dz)
- Z3RDMOMENT,& ! 3 order term in flux or variance equation
- ZF_NEW, &
- ZRWTHL, &
- ZRWRNP, &
- ZCLD_THOLD
-!
-REAL,DIMENSION(SIZE(XZS,1),SIZE(XZS,2),KKU) :: ZALT
-!
-INTEGER :: IKB,IKE ! I index values for the Beginning and End
- ! mass points of the domain in the 3 direct.
-INTEGER :: IKT ! array size in k direction
-INTEGER :: IKTB,IKTE ! start, end of k loops in physical domain
-INTEGER :: JI, JJ ! loop indexes
-!
-!
-INTEGER :: IIB,IJB ! Lower bounds of the physical
- ! sub-domain in x and y directions
-INTEGER :: IIE,IJE ! Upper bounds of the physical
- ! sub-domain in x and y directions
-!
-REAL, DIMENSION(:), ALLOCATABLE :: ZXHAT_ll ! Position x in the conformal
- ! plane (array on the complete domain)
-REAL, DIMENSION(:), ALLOCATABLE :: ZYHAT_ll ! Position y in the conformal
- ! plane (array on the complete domain)
-!
-!
-CHARACTER (LEN=100) :: YCOMMENT ! comment string in LFIFM file
-CHARACTER (LEN=LEN_HREC) :: YRECFM ! Name of the desired field in LFIFM file
-!
-REAL :: ZTIME1, ZTIME2
-REAL :: ZDELTAX
-REAL :: ZXBEG,ZXEND,ZYBEG,ZYEND ! Forcing size for ocean deep convection
-REAL, DIMENSION(SIZE(XXHAT),SIZE(XYHAT)) :: ZDIST ! distance
- ! from the center of the cooling
-REAL :: ZFLPROV
-INTEGER :: JKM ! vertical index loop
-INTEGER :: JSW
-REAL :: ZSWA ! index for time flux interpolation
-!
-INTEGER :: IIU, IJU
-INTEGER :: IRESP
-INTEGER :: JK
-LOGICAL :: GUSERV ! flag to use water
-LOGICAL :: GFTH2 ! flag to use w'th'2
-LOGICAL :: GFWTH ! flag to use w'2th'
-LOGICAL :: GFR2 ! flag to use w'r'2
-LOGICAL :: GFWR ! flag to use w'2r'
-LOGICAL :: GFTHR ! flag to use w'th'r'
-TYPE(TFIELDDATA) :: TZFIELD
-!----------------------------------------------------------------------------
-!
-!* 1. PRELIMINARIES
-! -------------
-! Size for a given proc & a given model
-IIU=SIZE(PTHLM,1)
-IJU=SIZE(PTHLM,2)
-!
-!! Compute Shape of sfc flux for Oceanic Deep Conv Case
-!
-IF (LOCEAN .AND. LDEEPOC) THEN
- !* COMPUTES THE PHYSICAL SUBDOMAIN BOUNDS
- ALLOCATE(ZXHAT_ll(NIMAX_ll+2*JPHEXT),ZYHAT_ll(NJMAX_ll+2*JPHEXT))
- !compute ZXHAT_ll = position in the (0:Lx) domain 1 (Lx=Size of domain1 )
- !compute XXHAT_ll = position in the (L0_subproc,Lx_subproc) domain for the current subproc
- ! L0_subproc as referenced in the full domain 1
- CALL GATHERALL_FIELD_ll('XX',XXHAT,ZXHAT_ll,IRESP)
- CALL GATHERALL_FIELD_ll('YY',XYHAT,ZYHAT_ll,IRESP)
- CALL GET_DIM_EXT_ll('B',IIU,IJU)
- CALL GET_INDICE_ll(IIB,IJB,IIE,IJE)
- DO JJ = IJB,IJE
- DO JI = IIB,IIE
- ZDIST(JI,JJ) = SQRT( &
- (( (XXHAT(JI)+XXHAT(JI+1))*0.5 - XCENTX_OC ) / XRADX_OC)**2 + &
- (( (XYHAT(JJ)+XYHAT(JJ+1))*0.5 - XCENTY_OC ) / XRADY_OC)**2 &
- )
- END DO
- END DO
- DO JJ=IJB,IJE
- DO JI=IIB,IIE
- IF ( ZDIST(JI,JJ) > 1.) XSSTFL(JI,JJ)=0.
- END DO
- END DO
-END IF !END DEEP OCEAN CONV CASE
-!
-IKT =SIZE(PTHLM,3)
-IKTE =IKT-JPVEXT_TURB
-IKTB =1+JPVEXT_TURB
-IKB=KKA+JPVEXT_TURB*KKL
-IKE=KKU-JPVEXT_TURB*KKL
-!
-GUSERV = (KRR/=0)
-!
-! compute the coefficients for the uncentred gradient computation near the
-! ground
-!
-ZKEFF(:,:,:) = MZM( PLM(:,:,:) * SQRT(PTKEM(:,:,:)) )
-!
-! define a cloud mask with ri and rc (used after with a threshold) for Leonard terms
-!
-IF(LHGRAD) THEN
- IF ( KRRL >= 1 ) THEN
- IF ( KRRI >= 1 ) THEN
- ZCLD_THOLD(:,:,:) = PRM(:,:,:,2) + PRM(:,:,:,4)
- ELSE
- ZCLD_THOLD(:,:,:) = PRM(:,:,:,2)
- END IF
- END IF
-END IF
-!
-! Flags for 3rd order quantities
-!
-GFTH2 = .FALSE.
-GFR2 = .FALSE.
-GFTHR = .FALSE.
-GFWTH = .FALSE.
-GFWR = .FALSE.
-!
-IF (HTOM/='NONE') THEN
- GFTH2 = ANY(PFTH2/=0.)
- GFR2 = ANY(PFR2 /=0.) .AND. GUSERV
- GFTHR = ANY(PFTHR/=0.) .AND. GUSERV
- GFWTH = ANY(PFWTH/=0.)
- GFWR = ANY(PFWR /=0.) .AND. GUSERV
-END IF
-!----------------------------------------------------------------------------
-!
-!* 2. SOURCES OF CONSERVATIVE POTENTIAL TEMPERATURE AND
-! PARTIAL THERMAL PRODUCTION
-! ---------------------------------------------------------------
-!
-!* 2.1 Splitted value for cons. potential temperature at t+deltat
-!
-! Compute the turbulent flux F and F' at time t-dt.
-!
-ZF (:,:,:) = -XCSHF*PPHI3*ZKEFF*DZM(PTHLM)/PDZZ
-ZDFDDTDZ(:,:,:) = -XCSHF*ZKEFF*D_PHI3DTDZ_O_DDTDZ(PPHI3,PREDTH1,PREDR1,PRED2TH3,PRED2THR3,HTURBDIM,GUSERV)
-!
-IF (LHGRAD) THEN
- ! Compute the Leonard terms for thl
- ZDELTAX= XXHAT(3) - XXHAT(2)
- ZF_NEW (:,:,:)= XCOEFHGRADTHL*ZDELTAX*ZDELTAX/12.0*( &
- MXF(GX_W_UW(PWM(:,:,:), XDXX, XDZZ, XDZX))&
- *MZM(GX_M_M(PTHLM(:,:,:),XDXX,XDZZ,XDZX)) &
- + MYF(GY_W_VW(PWM(:,:,:), XDYY,XDZZ,XDZY)) &
- *MZM(GY_M_M(PTHLM(:,:,:),XDYY,XDZZ,XDZY)) )
-END IF
-!
-! Effect of 3rd order terms in temperature flux (at flux point)
-!
-! d(w'2th')/dz
-IF (GFWTH) THEN
- Z3RDMOMENT= M3_WTH_W2TH(PREDTH1,PREDR1,PD,ZKEFF,PTKEM)
-!
- ZF = ZF + Z3RDMOMENT * PFWTH
- ZDFDDTDZ = ZDFDDTDZ + D_M3_WTH_W2TH_O_DDTDZ(PREDTH1,PREDR1,&
- & PD,PBLL_O_E,PETHETA,ZKEFF,PTKEM) * PFWTH
-END IF
-!
-! d(w'th'2)/dz
-IF (GFTH2) THEN
- Z3RDMOMENT= M3_WTH_WTH2(PREDTH1,PREDR1,PD,PBLL_O_E,PETHETA)
-!
- ZF = ZF + Z3RDMOMENT * MZM(PFTH2)
- ZDFDDTDZ = ZDFDDTDZ + D_M3_WTH_WTH2_O_DDTDZ(Z3RDMOMENT,PREDTH1,PREDR1,&
- & PD,PBLL_O_E,PETHETA) * MZM(PFTH2)
-END IF
-!
-! d(w'2r')/dz
-IF (GFWR) THEN
- ZF = ZF + M3_WTH_W2R(PD,ZKEFF,&
- & PTKEM,PBLL_O_E,PEMOIST,PDTH_DZ) * PFWR
- ZDFDDTDZ = ZDFDDTDZ + D_M3_WTH_W2R_O_DDTDZ(PREDTH1,PREDR1,&
- & PD,ZKEFF,PTKEM,PBLL_O_E,PEMOIST) * PFWR
-END IF
-!
-! d(w'r'2)/dz
-IF (GFR2) THEN
- ZF = ZF + M3_WTH_WR2(PD,ZKEFF,PTKEM,&
- & PSQRT_TKE,PBLL_O_E,PBETA,PLEPS,PEMOIST,PDTH_DZ) * MZM(PFR2)
- ZDFDDTDZ = ZDFDDTDZ + D_M3_WTH_WR2_O_DDTDZ(PREDTH1,PREDR1,PD,&
- & ZKEFF,PTKEM,PSQRT_TKE,PBLL_O_E,PBETA,PLEPS,PEMOIST) * MZM(PFR2)
-END IF
-!
-! d(w'th'r')/dz
-IF (GFTHR) THEN
- Z3RDMOMENT= M3_WTH_WTHR(PREDR1,PD,ZKEFF,PTKEM,PSQRT_TKE,PBETA,&
- & PLEPS,PEMOIST)
-!
- ZF = ZF + Z3RDMOMENT * MZM(PFTHR)
- ZDFDDTDZ = ZDFDDTDZ + D_M3_WTH_WTHR_O_DDTDZ(Z3RDMOMENT,PREDTH1,&
- & PREDR1,PD,PBLL_O_E,PETHETA) * MZM(PFTHR)
-END IF
-! compute interface flux
-IF (LCOUPLES) THEN ! Autocoupling O-A LES
- IF (LOCEAN) THEN ! ocean model in coupled case
- ZF(:,:,IKE) = (XSSTFL_C(:,:,1)+XSSRFL_C(:,:,1)) &
- *0.5* ( 1. + PRHODJ(:,:,KKU)/PRHODJ(:,:,IKE) )
- ELSE ! atmosph model in coupled case
- ZF(:,:,IKB) = XSSTFL_C(:,:,1) &
- *0.5* ( 1. + PRHODJ(:,:,KKA)/PRHODJ(:,:,IKB) )
- ENDIF
-!
-ELSE ! No coupling O and A cases
- ! atmosp bottom
- !*In 3D, a part of the flux goes vertically,
- ! and another goes horizontally (in presence of slopes)
- !*In 1D, part of energy released in horizontal flux is taken into account in the vertical part
- IF (HTURBDIM=='3DIM') THEN
- ZF(:,:,IKB) = ( PIMPL*PSFTHP(:,:) + PEXPL*PSFTHM(:,:) ) &
- * PDIRCOSZW(:,:) &
- * 0.5 * (1. + PRHODJ(:,:,KKA) / PRHODJ(:,:,IKB))
- ELSE
- ZF(:,:,IKB) = ( PIMPL*PSFTHP(:,:) + PEXPL*PSFTHM(:,:) ) &
- / PDIRCOSZW(:,:) &
- * 0.5 * (1. + PRHODJ(:,:,KKA) / PRHODJ(:,:,IKB))
- END IF
-!
- IF (LOCEAN) THEN
- ZF(:,:,IKE) = XSSTFL(:,:) *0.5*(1. + PRHODJ(:,:,KKU) / PRHODJ(:,:,IKE))
- ELSE !end ocean case (in nocoupled case)
- ! atmos top
- ZF(:,:,IKE)=0.
- END IF
-END IF !end no coupled cases
-!
-! Compute the split conservative potential temperature at t+deltat
-CALL TRIDIAG_THERMO(KKA,KKU,KKL,PTHLM,ZF,ZDFDDTDZ,PTSTEP,PIMPL,PDZZ,&
- PRHODJ,PTHLP)
-!
-! Compute the equivalent tendency for the conservative potential temperature
-!
-ZRWTHL(:,:,:)= PRHODJ(:,:,:)*(PTHLP(:,:,:)-PTHLM(:,:,:))/PTSTEP
-! replace the flux by the Leonard terms above ZALT and ZCLD_THOLD
-IF (LHGRAD) THEN
- DO JK=1,KKU
- ZALT(:,:,JK) = PZZ(:,:,JK)-XZS(:,:)
- END DO
- WHERE ( (ZCLD_THOLD(:,:,:) >= XCLDTHOLD) .AND. ( ZALT(:,:,:) >= XALTHGRAD) )
- ZRWTHL(:,:,:) = -GZ_W_M(MZM(PRHODJ(:,:,:))*ZF_NEW(:,:,:),XDZZ)
- END WHERE
-END IF
-!
-PRTHLS(:,:,:)= PRTHLS(:,:,:) + ZRWTHL(:,:,:)
-!
-!* 2.2 Partial Thermal Production
-!
-! Conservative potential temperature flux :
-!
-ZFLXZ(:,:,:) = ZF &
- + PIMPL * ZDFDDTDZ * DZM(PTHLP - PTHLM) / PDZZ
-! replace the flux by the Leonard terms
-IF (LHGRAD) THEN
- WHERE ( (ZCLD_THOLD(:,:,:) >= XCLDTHOLD) .AND. ( ZALT(:,:,:) >= XALTHGRAD) )
- ZFLXZ(:,:,:) = ZF_NEW(:,:,:)
- END WHERE
-END IF
-!
-ZFLXZ(:,:,KKA) = ZFLXZ(:,:,IKB)
-IF (LOCEAN) THEN
- ZFLXZ(:,:,KKU) = ZFLXZ(:,:,IKE)
-END IF
-!
-DO JK=IKTB+1,IKTE-1
- PWTH(:,:,JK)=0.5*(ZFLXZ(:,:,JK)+ZFLXZ(:,:,JK+KKL))
-END DO
-!
-PWTH(:,:,IKB)=0.5*(ZFLXZ(:,:,IKB)+ZFLXZ(:,:,IKB+KKL))
-!
-IF (LOCEAN) THEN
- PWTH(:,:,IKE)=0.5*(ZFLXZ(:,:,IKE)+ZFLXZ(:,:,IKE+KKL))
- PWTH(:,:,KKA)=0.
- PWTH(:,:,KKU)=ZFLXZ(:,:,KKU)
-ELSE
- PWTH(:,:,IKE)=PWTH(:,:,IKE-KKL)
- PWTH(:,:,KKA)=0.5*(ZFLXZ(:,:,KKA)+ZFLXZ(:,:,KKA+KKL))
-END IF
-!
-IF ( OTURB_FLX .AND. TPFILE%LOPENED ) THEN
- ! stores the conservative potential temperature vertical flux
- TZFIELD%CMNHNAME = 'THW_FLX'
- TZFIELD%CSTDNAME = ''
- TZFIELD%CLONGNAME = 'THW_FLX'
- TZFIELD%CUNITS = 'K m s-1'
- TZFIELD%CDIR = 'XY'
- TZFIELD%CCOMMENT = 'Conservative potential temperature vertical flux'
- TZFIELD%NGRID = 4
- TZFIELD%NTYPE = TYPEREAL
- TZFIELD%NDIMS = 3
- TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_Field_write(TPFILE,TZFIELD,ZFLXZ)
-END IF
-!
-! Contribution of the conservative temperature flux to the buoyancy flux
-IF (LOCEAN) THEN
- PTP(:,:,:)= XG*XALPHAOC * MZF(ZFLXZ )
-ELSE
- IF (KRR /= 0) THEN
- PTP(:,:,:) = PBETA * MZF( MZM(PETHETA) * ZFLXZ )
- PTP(:,:,IKB)= PBETA(:,:,IKB) * PETHETA(:,:,IKB) * &
- 0.5 * ( ZFLXZ (:,:,IKB) + ZFLXZ (:,:,IKB+KKL) )
- ELSE
- PTP(:,:,:)= PBETA * MZF( ZFLXZ )
- END IF
-END IF
-!
-! Buoyancy flux at flux points
-!
-PWTHV = MZM(PETHETA) * ZFLXZ
-PWTHV(:,:,IKB) = PETHETA(:,:,IKB) * ZFLXZ(:,:,IKB)
-!
-IF (LOCEAN) THEN
- ! temperature contribution to Buy flux
- PWTHV(:,:,IKE) = PETHETA(:,:,IKE) * ZFLXZ(:,:,IKE)
-END IF
-!* 2.3 Partial vertical divergence of the < Rc w > flux
-!
-IF ( KRRL >= 1 ) THEN
- IF ( KRRI >= 1 ) THEN
- PRRS(:,:,:,2) = PRRS(:,:,:,2) - &
- PRHODJ*PATHETA*2.*PSRCM*DZF(ZFLXZ/PDZZ) &
- *(1.0-PFRAC_ICE(:,:,:))
- PRRS(:,:,:,4) = PRRS(:,:,:,4) - &
- PRHODJ*PATHETA*2.*PSRCM*DZF(ZFLXZ/PDZZ) &
- *PFRAC_ICE(:,:,:)
- ELSE
- PRRS(:,:,:,2) = PRRS(:,:,:,2) - &
- PRHODJ*PATHETA*2.*PSRCM*DZF(ZFLXZ/PDZZ)
- END IF
-END IF
-!
-!* 2.4 Storage in LES configuration
-!
-IF (LLES_CALL) THEN
- CALL SECOND_MNH(ZTIME1)
- CALL LES_MEAN_SUBGRID( MZF(ZFLXZ), X_LES_SUBGRID_WThl )
- CALL LES_MEAN_SUBGRID( MZF(PWM*ZFLXZ), X_LES_RES_W_SBG_WThl )
- CALL LES_MEAN_SUBGRID( GZ_W_M(PWM,PDZZ)*MZF(ZFLXZ),&
- & X_LES_RES_ddxa_W_SBG_UaThl )
- CALL LES_MEAN_SUBGRID( MZF(PDTH_DZ*ZFLXZ), X_LES_RES_ddxa_Thl_SBG_UaThl )
- CALL LES_MEAN_SUBGRID( -XCTP*PSQRT_TKE/PLM*MZF(ZFLXZ), X_LES_SUBGRID_ThlPz )
- CALL LES_MEAN_SUBGRID( MZF(MZM(PETHETA)*ZFLXZ), X_LES_SUBGRID_WThv )
- IF (KRR>=1) THEN
- CALL LES_MEAN_SUBGRID( MZF(PDR_DZ*ZFLXZ), X_LES_RES_ddxa_Rt_SBG_UaThl )
- END IF
- !* diagnostic of mixing coefficient for heat
- ZA = DZM(PTHLP)
- WHERE (ZA==0.) ZA=1.E-6
- ZA = - ZFLXZ / ZA * PDZZ
- ZA(:,:,IKB) = XCSHF*PPHI3(:,:,IKB)*ZKEFF(:,:,IKB)
- ZA = MZF( ZA )
- ZA = MIN(MAX(ZA,-1000.),1000.)
- CALL LES_MEAN_SUBGRID( ZA, X_LES_SUBGRID_Kh )
- !
- CALL SECOND_MNH(ZTIME2)
- XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
-END IF
-!
-!* 2.5 New boundary layer depth for TOMs
-!
-IF (HTOM=='TM06') CALL TM06_H(IKB,IKTB,IKTE,PTSTEP,PZZ,ZFLXZ,PBL_DEPTH)
-!
-!----------------------------------------------------------------------------
-!
-!
-!* 3. SOURCES OF CONSERVATIVE AND CLOUD MIXING RATIO AND
-! COMPLETE THERMAL PRODUCTION
-! ------------------------------------------------------
-!
-!* 3.1 Splitted value for cons. mixing ratio at t+deltat
-!
-!
-IF (KRR /= 0) THEN
- ! Compute the turbulent flux F and F' at time t-dt.
- !
- ZF (:,:,:) = -XCSHF*PPSI3*ZKEFF*DZM(PRM(:,:,:,1))/PDZZ
- ZDFDDRDZ(:,:,:) = -XCSHF*ZKEFF*D_PSI3DRDZ_O_DDRDZ(PPSI3,PREDR1,PREDTH1,PRED2R3,PRED2THR3,HTURBDIM,GUSERV)
- !
- ! Compute Leonard Terms for Cloud mixing ratio
- IF (LHGRAD) THEN
- ZDELTAX= XXHAT(3) - XXHAT(2)
- ZF_NEW (:,:,:)= XCOEFHGRADRM*ZDELTAX*ZDELTAX/12.0*( &
- MXF(GX_W_UW(PWM(:,:,:), XDXX, XDZZ, XDZX)) &
- *MZM(GX_M_M(PRM(:,:,:,1),XDXX,XDZZ,XDZX)) &
- +MYF(GY_W_VW(PWM(:,:,:), XDYY,XDZZ,XDZY)) &
- *MZM(GY_M_M(PRM(:,:,:,1),XDYY,XDZZ,XDZY)) )
- END IF
- !
- ! Effect of 3rd order terms in temperature flux (at flux point)
- !
- ! d(w'2r')/dz
- IF (GFWR) THEN
- Z3RDMOMENT= M3_WR_W2R(PREDR1,PREDTH1,PD,ZKEFF,PTKEM)
- !
- ZF = ZF + Z3RDMOMENT * PFWR
- ZDFDDRDZ = ZDFDDRDZ + D_M3_WR_W2R_O_DDRDZ(PREDR1,PREDTH1,PD,&
- & PBLL_O_E,PEMOIST,ZKEFF,PTKEM) * PFWR
- END IF
- !
- ! d(w'r'2)/dz
- IF (GFR2) THEN
- Z3RDMOMENT= M3_WR_WR2(PREDR1,PREDTH1,PD,PBLL_O_E,PEMOIST)
- !
- ZF = ZF + Z3RDMOMENT * MZM(PFR2)
- ZDFDDRDZ = ZDFDDRDZ + D_M3_WR_WR2_O_DDRDZ(Z3RDMOMENT,PREDR1,&
- & PREDTH1,PD,PBLL_O_E,PEMOIST) * MZM(PFR2)
- END IF
- !
- ! d(w'2th')/dz
- IF (GFWTH) THEN
- ZF = ZF + M3_WR_W2TH(PD,ZKEFF,&
- & PTKEM,PBLL_O_E,PETHETA,PDR_DZ) * PFWTH
- ZDFDDRDZ = ZDFDDRDZ + D_M3_WR_W2TH_O_DDRDZ(PREDR1,PREDTH1,&
- & PD,ZKEFF,PTKEM,PBLL_O_E,PETHETA) * PFWTH
- END IF
- !
- ! d(w'th'2)/dz
- IF (GFTH2) THEN
- ZF = ZF + M3_WR_WTH2(PD,ZKEFF,PTKEM,&
- & PSQRT_TKE,PBLL_O_E,PBETA,PLEPS,PETHETA,PDR_DZ) * MZM(PFTH2)
- ZDFDDRDZ = ZDFDDRDZ + D_M3_WR_WTH2_O_DDRDZ(PREDR1,PREDTH1,PD,&
- &ZKEFF,PTKEM,PSQRT_TKE,PBLL_O_E,PBETA,PLEPS,PETHETA) * MZM(PFTH2)
- END IF
- !
- ! d(w'th'r')/dz
- IF (GFTHR) THEN
- Z3RDMOMENT= M3_WR_WTHR(PREDTH1,PD,ZKEFF,PTKEM,PSQRT_TKE,PBETA,&
- & PLEPS,PETHETA)
- !
- ZF = ZF + Z3RDMOMENT * MZM(PFTHR)
- ZDFDDRDZ = ZDFDDRDZ + D_M3_WR_WTHR_O_DDRDZ(Z3RDMOMENT,PREDR1, &
- & PREDTH1,PD,PBLL_O_E,PEMOIST) * MZM(PFTHR)
- END IF
- !
- ! compute interface flux
- IF (LCOUPLES) THEN ! coupling NH O-A
- IF (LOCEAN) THEN ! ocean model in coupled case
- ! evap effect on salinity to be added later !!!
- ZF(:,:,IKE) = 0.
- ELSE ! atmosph model in coupled case
- ZF(:,:,IKB) = 0.
- ! AJOUTER FLUX EVAP SUR MODELE ATMOS
- ENDIF
- !
- ELSE ! No coupling NH OA case
- ! atmosp bottom
- !* in 3DIM case, a part of the flux goes vertically, and another goes horizontally
- ! (in presence of slopes)
- !* in 1DIM case, the part of energy released in horizontal flux
- ! is taken into account in the vertical part
- !
- IF (HTURBDIM=='3DIM') THEN
- ZF(:,:,IKB) = ( PIMPL*PSFRP(:,:) + PEXPL*PSFRM(:,:) ) &
- * PDIRCOSZW(:,:) &
- * 0.5 * (1. + PRHODJ(:,:,KKA) / PRHODJ(:,:,IKB))
- ELSE
- ZF(:,:,IKB) = ( PIMPL*PSFRP(:,:) + PEXPL*PSFRM(:,:) ) &
- / PDIRCOSZW(:,:) &
- * 0.5 * (1. + PRHODJ(:,:,KKA) / PRHODJ(:,:,IKB))
- END IF
- !
- IF (LOCEAN) THEN
- ! General ocean case
- ! salinity/evap effect to be added later !!!!!
- ZF(:,:,IKE) = 0.
- ELSE !end ocean case (in nocoupled case)
- ! atmos top
- ZF(:,:,IKE)=0.
- END IF
- END IF!end no coupled cases
- ! Compute the split conservative potential temperature at t+deltat
- CALL TRIDIAG_THERMO(KKA,KKU,KKL,PRM(:,:,:,1),ZF,ZDFDDRDZ,PTSTEP,PIMPL,&
- PDZZ,PRHODJ,PRP)
- !
- ! Compute the equivalent tendency for the conservative mixing ratio
- !
- ZRWRNP (:,:,:) = PRHODJ(:,:,:)*(PRP(:,:,:)-PRM(:,:,:,1))/PTSTEP
- !
- ! replace the flux by the Leonard terms above ZALT and ZCLD_THOLD
- IF (LHGRAD) THEN
- DO JK=1,KKU
- ZALT(:,:,JK) = PZZ(:,:,JK)-XZS(:,:)
- END DO
- WHERE ( (ZCLD_THOLD(:,:,:) >= XCLDTHOLD ) .AND. ( ZALT(:,:,:) >= XALTHGRAD ) )
- ZRWRNP (:,:,:) = -GZ_W_M(MZM(PRHODJ(:,:,:))*ZF_NEW(:,:,:),XDZZ)
- END WHERE
- END IF
- !
- PRRS(:,:,:,1) = PRRS(:,:,:,1) + ZRWRNP (:,:,:)
- !
- !* 3.2 Complete thermal production
- !
- ! cons. mixing ratio flux :
- !
- ZFLXZ(:,:,:) = ZF &
- + PIMPL * ZDFDDRDZ * DZM(PRP - PRM(:,:,:,1)) / PDZZ
- !
- ! replace the flux by the Leonard terms above ZALT and ZCLD_THOLD
- IF (LHGRAD) THEN
- WHERE ( (ZCLD_THOLD(:,:,:) >= XCLDTHOLD ) .AND. ( ZALT(:,:,:) >= XALTHGRAD ) )
- ZFLXZ(:,:,:) = ZF_NEW(:,:,:)
- END WHERE
- END IF
- !
- ZFLXZ(:,:,KKA) = ZFLXZ(:,:,IKB)
- !
- DO JK=IKTB+1,IKTE-1
- PWRC(:,:,JK)=0.5*(ZFLXZ(:,:,JK)+ZFLXZ(:,:,JK+KKL))
- END DO
- PWRC(:,:,IKB)=0.5*(ZFLXZ(:,:,IKB)+ZFLXZ(:,:,IKB+KKL))
- PWRC(:,:,KKA)=0.5*(ZFLXZ(:,:,KKA)+ZFLXZ(:,:,KKA+KKL))
- PWRC(:,:,IKE)=PWRC(:,:,IKE-KKL)
- !
- !
- IF ( OTURB_FLX .AND. TPFILE%LOPENED ) THEN
- ! stores the conservative mixing ratio vertical flux
- TZFIELD%CMNHNAME = 'RCONSW_FLX'
- TZFIELD%CSTDNAME = ''
- TZFIELD%CLONGNAME = 'RCONSW_FLX'
- TZFIELD%CUNITS = 'kg m s-1 kg-1'
- TZFIELD%CDIR = 'XY'
- TZFIELD%CCOMMENT = 'Conservative mixing ratio vertical flux'
- TZFIELD%NGRID = 4
- TZFIELD%NTYPE = TYPEREAL
- TZFIELD%NDIMS = 3
- TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_Field_write(TPFILE,TZFIELD,ZFLXZ)
- END IF
- !
- ! Contribution of the conservative water flux to the Buoyancy flux
- IF (LOCEAN) THEN
- ZA(:,:,:)= -XG*XBETAOC * MZF(ZFLXZ )
- ELSE
- ZA(:,:,:) = PBETA * MZF( MZM(PEMOIST) * ZFLXZ )
- ZA(:,:,IKB) = PBETA(:,:,IKB) * PEMOIST(:,:,IKB) * &
- 0.5 * ( ZFLXZ (:,:,IKB) + ZFLXZ (:,:,IKB+KKL) )
- PTP(:,:,:) = PTP(:,:,:) + ZA(:,:,:)
- END IF
- !
- ! Buoyancy flux at flux points
- !
- PWTHV = PWTHV + MZM(PEMOIST) * ZFLXZ
- PWTHV(:,:,IKB) = PWTHV(:,:,IKB) + PEMOIST(:,:,IKB) * ZFLXZ(:,:,IKB)
- IF (LOCEAN) THEN
- PWTHV(:,:,IKE) = PWTHV(:,:,IKE) + PEMOIST(:,:,IKE)* ZFLXZ(:,:,IKE)
- END IF
-!
-!* 3.3 Complete vertical divergence of the < Rc w > flux
-!
- IF ( KRRL >= 1 ) THEN
- IF ( KRRI >= 1 ) THEN
- PRRS(:,:,:,2) = PRRS(:,:,:,2) - &
- PRHODJ*PAMOIST*2.*PSRCM*DZF(ZFLXZ/PDZZ ) &
- *(1.0-PFRAC_ICE(:,:,:))
- PRRS(:,:,:,4) = PRRS(:,:,:,4) - &
- PRHODJ*PAMOIST*2.*PSRCM*DZF(ZFLXZ/PDZZ ) &
- *PFRAC_ICE(:,:,:)
- ELSE
- PRRS(:,:,:,2) = PRRS(:,:,:,2) - &
- PRHODJ*PAMOIST*2.*PSRCM*DZF(ZFLXZ/PDZZ )
- END IF
- END IF
-!
-!* 3.4 Storage in LES configuration
-!
- IF (LLES_CALL) THEN
- CALL SECOND_MNH(ZTIME1)
- CALL LES_MEAN_SUBGRID( MZF(ZFLXZ), X_LES_SUBGRID_WRt )
- CALL LES_MEAN_SUBGRID( MZF(PWM*ZFLXZ), X_LES_RES_W_SBG_WRt )
- CALL LES_MEAN_SUBGRID( GZ_W_M(PWM,PDZZ)*MZF(ZFLXZ),&
- & X_LES_RES_ddxa_W_SBG_UaRt )
- CALL LES_MEAN_SUBGRID( MZF(PDTH_DZ*ZFLXZ), X_LES_RES_ddxa_Thl_SBG_UaRt )
- CALL LES_MEAN_SUBGRID( MZF(PDR_DZ*ZFLXZ), X_LES_RES_ddxa_Rt_SBG_UaRt )
- CALL LES_MEAN_SUBGRID( MZF(MZM(PEMOIST)*ZFLXZ), X_LES_SUBGRID_WThv , .TRUE. )
- CALL LES_MEAN_SUBGRID( -XCTP*PSQRT_TKE/PLM*MZF(ZFLXZ), X_LES_SUBGRID_RtPz )
- CALL SECOND_MNH(ZTIME2)
- XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
- END IF
-!
-END IF
-!
-!----------------------------------------------------------------------------
-!
-!
-!* 4. TURBULENT CORRELATIONS : <w Rc>
-! -------------------------------
-!
-!
-!* 4.1 <w Rc>
-!
-IF ( ((OTURB_FLX .AND. TPFILE%LOPENED) .OR. LLES_CALL) .AND. (KRRL > 0) ) THEN
- !
- ! recover the Conservative potential temperature flux :
- ZA(:,:,:) = DZM(PIMPL * PTHLP + PEXPL * PTHLM) / PDZZ * &
- (-PPHI3*MZM(PLM*PSQRT_TKE)) * XCSHF
- ZA(:,:,IKB) = ( PIMPL*PSFTHP(:,:) + PEXPL*PSFTHM(:,:) ) &
- * PDIRCOSZW(:,:)
- !
- ! compute <w Rc>
- ZFLXZ(:,:,:) = MZM( PAMOIST * 2.* PSRCM ) * ZFLXZ(:,:,:) + &
- MZM( PATHETA * 2.* PSRCM ) * ZA(:,:,:)
- ZFLXZ(:,:,KKA) = ZFLXZ(:,:,IKB)
- !
- ! store the liquid water mixing ratio vertical flux
- IF ( OTURB_FLX .AND. TPFILE%LOPENED ) THEN
- TZFIELD%CMNHNAME = 'RCW_FLX'
- TZFIELD%CSTDNAME = ''
- TZFIELD%CLONGNAME = 'RCW_FLX'
- TZFIELD%CUNITS = 'kg m s-1 kg-1'
- TZFIELD%CDIR = 'XY'
- TZFIELD%CCOMMENT = 'Liquid water mixing ratio vertical flux'
- TZFIELD%NGRID = 4
- TZFIELD%NTYPE = TYPEREAL
- TZFIELD%NDIMS = 3
- TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_Field_write(TPFILE,TZFIELD,ZFLXZ)
- END IF
- !
-! and we store in LES configuration this subgrid flux <w'rc'>
-!
- IF (LLES_CALL) THEN
- CALL SECOND_MNH(ZTIME1)
- CALL LES_MEAN_SUBGRID( MZF(ZFLXZ), X_LES_SUBGRID_WRc )
- CALL SECOND_MNH(ZTIME2)
- XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
- END IF
-!
-END IF !end of <w Rc>
-IF (LOCEAN.AND.LDEEPOC) THEN
- DEALLOCATE(ZXHAT_ll,ZYHAT_ll)
-END IF
-!
-!----------------------------------------------------------------------------
-IF (LHOOK) CALL DR_HOOK('TURB_VER_THERMO_FLUX',1,ZHOOK_HANDLE)
-END SUBROUTINE TURB_VER_THERMO_FLUX
--
GitLab